3 , MultiParamTypeClasses
8 -- |An internal module for HTTP authentication.
9 module Network.HTTP.Lucu.Authentication
18 import Data.Ascii (Ascii, AsciiBuilder)
20 import Data.Attoparsec.Char8
21 import Data.Attoparsec.Parsable
22 import qualified Data.ByteString.Base64 as B64
23 import Data.ByteString (ByteString)
24 import qualified Data.ByteString.Char8 as C8
25 import Data.Convertible.Base
26 import Data.Convertible.Instances.Ascii ()
27 import Data.Convertible.Utils
28 import Data.Monoid.Unicode
29 import Network.HTTP.Lucu.Parser.Http
30 import Network.HTTP.Lucu.Utils
31 import Prelude.Unicode
33 -- |Authentication challenge to be sent to clients with
34 -- \"WWW-Authenticate\" header field. See
35 -- 'Network.HTTP.Lucu.setWWWAuthenticate'.
37 = BasicAuthChallenge !Realm
40 -- |'Realm' is just an 'Ascii' string.
43 -- |Authorization credential to be sent by client with
44 -- \"Authorization\" header. See 'Network.HTTP.Lucu.getAuthorization'.
46 = BasicAuthCredential !UserID !Password
49 -- |'UserID' is just an 'Ascii' string containing no colons (\':\').
52 -- |'Password' is just an 'Ascii' string.
55 instance ConvertSuccess AuthChallenge Ascii where
56 {-# INLINE convertSuccess #-}
57 convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
59 instance ConvertSuccess AuthChallenge AsciiBuilder where
60 {-# INLINE convertSuccess #-}
61 convertSuccess (BasicAuthChallenge realm)
62 = cs ("Basic realm=" ∷ Ascii) ⊕ quoteStr realm
64 deriveAttempts [ ([t| AuthChallenge |], [t| Ascii |])
65 , ([t| AuthChallenge |], [t| AsciiBuilder |])
68 instance Parsable ByteString AuthCredential where
69 parser = do void $ string "Basic"
71 b64 ← takeWhile1 base64
72 case C8.break (≡ ':') (B64.decodeLenient b64) of
75 → fail "no colons in the basic auth credential"
78 p ← asc (C8.tail cPassword)
79 return (BasicAuthCredential u p)
82 base64 = inClass "a-zA-Z0-9+/="
84 asc ∷ C8.ByteString → Parser Ascii
87 Success as → return as
88 Failure _ → fail "Non-ascii character in auth credential"