3 , MultiParamTypeClasses
9 -- |An internal module for HTTP authentication.
10 module Network.HTTP.Lucu.Authentication
19 import Data.Ascii (Ascii, AsciiBuilder)
21 import Data.Attoparsec.Char8
22 import qualified Data.ByteString.Base64 as B64
23 import qualified Data.ByteString.Char8 as C8
24 import Data.Convertible.Base
25 import Data.Convertible.Instances.Ascii ()
26 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 Default (Parser AuthCredential) where
69 def = 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"