5 -- |An internal module for HTTP authentication.
6 module Network.HTTP.Lucu.Authentication
18 import Data.Ascii (Ascii)
19 import qualified Data.Ascii as A
20 import Data.Attoparsec.Char8
21 import qualified Data.ByteString.Base64 as B64
22 import qualified Data.ByteString.Char8 as C8
23 import Data.Monoid.Unicode
24 import Network.HTTP.Lucu.Parser.Http
25 import Network.HTTP.Lucu.Utils
26 import Prelude.Unicode
28 -- |Authentication challenge to be sent to clients with
29 -- \"WWW-Authenticate\" header field. See
30 -- 'Network.HTTP.Lucu.setWWWAuthenticate'.
32 = BasicAuthChallenge !Realm
35 -- |'Realm' is just an 'Ascii' string.
38 -- |Authorization credential to be sent by client with
39 -- \"Authorization\" header. See 'Network.HTTP.Lucu.getAuthorization'.
41 = BasicAuthCredential !UserID !Password
44 -- |'UserID' is just an 'Ascii' string containing no colons (\':\').
47 -- |'Password' is just an 'Ascii' string.
50 -- |Convert an 'AuthChallenge' to 'Ascii'.
51 printAuthChallenge ∷ AuthChallenge → Ascii
52 printAuthChallenge (BasicAuthChallenge realm)
53 = A.fromAsciiBuilder $
54 A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm
56 -- |'Parser' for an 'AuthCredential'.
57 authCredential ∷ Parser AuthCredential
59 = do void $ string "Basic"
61 b64 ← takeWhile1 base64
62 case C8.break (≡ ':') (B64.decodeLenient b64) of
65 → fail "no colons in the basic auth credential"
68 p ← asc (C8.tail cPassword)
69 return (BasicAuthCredential u p)
72 base64 = inClass "a-zA-Z0-9+/="
74 asc ∷ C8.ByteString → Parser Ascii
75 asc bs = case A.fromByteString bs of
77 Nothing → fail "Non-ascii character in auth credential"