module Network.HTTP.Lucu.Authorization
( AuthChallenge(..)
, AuthCredential(..)
, Realm
, UserID
, Password
, authCredentialP
)
where
import qualified Codec.Binary.Base64 as B64
import Data.Maybe
import Network.HTTP.Lucu.Parser
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
data AuthChallenge
= BasicAuthChallenge Realm
deriving (Eq)
type Realm = String
data AuthCredential
= BasicAuthCredential UserID Password
deriving (Show, Eq)
type UserID = String
type Password = String
instance Show AuthChallenge where
show (BasicAuthChallenge realm)
= "Basic realm=" ++ quoteStr realm
authCredentialP :: Parser AuthCredential
authCredentialP = allowEOF $!
do string "Basic"
many1 lws
b64 <- many1
$ satisfy (\ c -> (c >= 'a' && c <= 'z') ||
(c >= 'A' && c <= 'Z') ||
(c >= '0' && c <= '9') ||
c == '+' ||
c == '/' ||
c == '=')
let decoded = map (toEnum . fromEnum) (fromJust $ B64.decode b64)
case break (== ':') decoded of
(uid, ':' : password)
-> return (BasicAuthCredential uid password)
_ -> failP