, MultiParamTypeClasses
, OverloadedStrings
, TemplateHaskell
+ , TypeSynonymInstances
, UnicodeSyntax
#-}
-- |An internal module for HTTP authentication.
, Realm
, UserID
, Password
- , authCredential
)
where
import Control.Monad
import Data.Convertible.Base
import Data.Convertible.Instances.Ascii ()
import Data.Convertible.Utils
+import Data.Default
import Data.Monoid.Unicode
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
, ([t| AuthChallenge |], [t| AsciiBuilder |])
]
--- |'Parser' for an 'AuthCredential'.
-authCredential ∷ Parser AuthCredential
-authCredential
- = do void $ string "Basic"
- skipMany1 lws
- b64 ← takeWhile1 base64
- case C8.break (≡ ':') (B64.decodeLenient b64) of
- (user, cPassword)
- | C8.null cPassword
- → fail "no colons in the basic auth credential"
- | otherwise
- → do u ← asc user
- p ← asc (C8.tail cPassword)
- return (BasicAuthCredential u p)
- where
- base64 ∷ Char → Bool
- base64 = inClass "a-zA-Z0-9+/="
+instance Default (Parser AuthCredential) where
+ def = do void $ string "Basic"
+ skipMany1 lws
+ b64 ← takeWhile1 base64
+ case C8.break (≡ ':') (B64.decodeLenient b64) of
+ (user, cPassword)
+ | C8.null cPassword
+ → fail "no colons in the basic auth credential"
+ | otherwise
+ → do u ← asc user
+ p ← asc (C8.tail cPassword)
+ return (BasicAuthCredential u p)
+ where
+ base64 ∷ Char → Bool
+ base64 = inClass "a-zA-Z0-9+/="
- asc ∷ C8.ByteString → Parser Ascii
- asc bs = case ca bs of
- Success as → return as
- Failure _ → fail "Non-ascii character in auth credential"
+ asc ∷ C8.ByteString → Parser Ascii
+ asc bs
+ = case ca bs of
+ Success as → return as
+ Failure _ → fail "Non-ascii character in auth credential"