, MultiParamTypeClasses
, OverloadedStrings
, TemplateHaskell
+ , TypeSynonymInstances
, UnicodeSyntax
#-}
-- |An internal module for HTTP authentication.
import Data.Ascii (Ascii, AsciiBuilder)
import Data.Attempt
import Data.Attoparsec.Char8
-import Data.Attoparsec.Parsable
import qualified Data.ByteString.Base64 as B64
-import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
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 |])
]
-instance Parsable ByteString AuthCredential where
- parser = 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)
+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+/="