1 {-# OPTIONS_HADDOCK prune #-}
3 -- |Manipulation of WWW authorization.
4 module Network.HTTP.Lucu.Authorization
11 , authCredentialP -- private
15 import qualified Codec.Binary.Base64 as B64
17 import Network.HTTP.Lucu.Parser
18 import Network.HTTP.Lucu.Parser.Http
19 import Network.HTTP.Lucu.Utils
21 -- |Authorization challenge to be sent to client with
22 -- \"WWW-Authenticate\" header. See
23 -- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'.
25 = BasicAuthChallenge Realm
28 -- |'Realm' is just a string which must not contain any non-ASCII letters.
31 -- |Authorization credential to be sent by client with
32 -- \"Authorization\" header. See
33 -- 'Network.HTTP.Lucu.Resource.getAuthorization'.
35 = BasicAuthCredential UserID Password
38 -- |'UserID' is just a string which must not contain colon and any
42 -- |'Password' is just a string which must not contain any non-ASCII
44 type Password = String
47 instance Show AuthChallenge where
48 show (BasicAuthChallenge realm)
49 = "Basic realm=" ++ quoteStr realm
52 authCredentialP :: Parser AuthCredential
53 authCredentialP = allowEOF $!
54 do _ <- string "Basic"
57 $ satisfy (\ c -> (c >= 'a' && c <= 'z') ||
58 (c >= 'A' && c <= 'Z') ||
59 (c >= '0' && c <= '9') ||
63 let decoded = map (toEnum . fromEnum) (fromJust $ B64.decode b64)
64 case break (== ':') decoded of
66 -> return (BasicAuthCredential uid password)