3 , MultiParamTypeClasses
8 -- |An internal module for HTTP authentication.
9 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
27 import Data.Monoid.Unicode
28 import Network.HTTP.Lucu.Parser.Http
29 import Network.HTTP.Lucu.Utils
30 import Prelude.Unicode
32 -- |Authentication challenge to be sent to clients with
33 -- \"WWW-Authenticate\" header field. See
34 -- 'Network.HTTP.Lucu.setWWWAuthenticate'.
36 = BasicAuthChallenge !Realm
39 -- |'Realm' is just an 'Ascii' string.
42 -- |Authorization credential to be sent by client with
43 -- \"Authorization\" header. See 'Network.HTTP.Lucu.getAuthorization'.
45 = BasicAuthCredential !UserID !Password
48 -- |'UserID' is just an 'Ascii' string containing no colons (\':\').
51 -- |'Password' is just an 'Ascii' string.
54 instance ConvertSuccess AuthChallenge Ascii where
55 {-# INLINE convertSuccess #-}
56 convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
58 instance ConvertSuccess AuthChallenge AsciiBuilder where
59 {-# INLINE convertSuccess #-}
60 convertSuccess (BasicAuthChallenge realm)
61 = cs ("Basic realm=" ∷ Ascii) ⊕ quoteStr realm
63 deriveAttempts [ ([t| AuthChallenge |], [t| Ascii |])
64 , ([t| AuthChallenge |], [t| AsciiBuilder |])
67 -- |'Parser' for an 'AuthCredential'.
68 authCredential ∷ Parser AuthCredential
70 = do void $ string "Basic"
72 b64 ← takeWhile1 base64
73 case C8.break (≡ ':') (B64.decodeLenient b64) of
76 → fail "no colons in the basic auth credential"
79 p ← asc (C8.tail cPassword)
80 return (BasicAuthCredential u p)
83 base64 = inClass "a-zA-Z0-9+/="
85 asc ∷ C8.ByteString → Parser Ascii
86 asc bs = case ca bs of
87 Success as → return as
88 Failure _ → fail "Non-ascii character in auth credential"