5 {-# OPTIONS_HADDOCK prune #-}
7 -- |Manipulation of WWW authorization.
8 module Network.HTTP.Lucu.Authorization
16 , authCredentialP -- private
19 import Data.Ascii (Ascii)
20 import qualified Data.Ascii as A
21 import Data.Attoparsec.Char8
22 import qualified Data.ByteString.Base64 as B64
23 import qualified Data.ByteString.Char8 as C8
24 import Data.Monoid.Unicode
25 import Network.HTTP.Lucu.Parser.Http
26 import Network.HTTP.Lucu.Utils
27 import Prelude.Unicode
29 -- |Authorization challenge to be sent to client with
30 -- \"WWW-Authenticate\" header. See
31 -- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'.
33 = BasicAuthChallenge Realm
36 -- |'Realm' is just a string which must not contain any non-ASCII letters.
39 -- |Authorization credential to be sent by client with
40 -- \"Authorization\" header. See
41 -- 'Network.HTTP.Lucu.Resource.getAuthorization'.
43 = BasicAuthCredential UserID Password
46 -- |'UserID' is just a string which must not contain colon and any
50 -- |'Password' is just a string which must not contain any non-ASCII
54 -- |Convert an 'AuthChallenge' to 'Ascii'.
55 printAuthChallenge ∷ AuthChallenge → Ascii
56 printAuthChallenge (BasicAuthChallenge realm)
57 = A.fromAsciiBuilder $
58 A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm
60 authCredentialP ∷ Parser AuthCredential
65 b64 ← takeWhile1 base64
66 case C8.break (≡ ':') (B64.decodeLenient b64) of
69 → fail "no colons in the basic auth credential"
72 p ← asc (C8.tail cPassword)
73 return (BasicAuthCredential u p)
76 base64 = inClass "a-zA-Z0-9+/="
78 asc ∷ C8.ByteString → Parser Ascii
79 asc bs = case A.fromByteString bs of
81 Nothing → fail "Non-ascii character in auth credential"