OverloadedStrings
, UnicodeSyntax
#-}
-{-# OPTIONS_HADDOCK prune #-}
-- |Manipulation of WWW authorization.
module Network.HTTP.Lucu.Authorization
, Password
, printAuthChallenge
- , authCredentialP -- private
+ , authCredentialP
)
where
import Data.Ascii (Ascii)
import Data.Attoparsec.Char8
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C8
-import Data.Maybe
import Data.Monoid.Unicode
import Network.HTTP.Lucu.Parser.Http
import Network.HTTP.Lucu.Utils
-- \"WWW-Authenticate\" header. See
-- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'.
data AuthChallenge
- = BasicAuthChallenge Realm
+ = BasicAuthChallenge !Realm
deriving (Eq)
-- |'Realm' is just a string which must not contain any non-ASCII letters.
-- \"Authorization\" header. See
-- 'Network.HTTP.Lucu.Resource.getAuthorization'.
data AuthCredential
- = BasicAuthCredential UserID Password
+ = BasicAuthCredential !UserID !Password
deriving (Show, Eq)
-- |'UserID' is just a string which must not contain colon and any
authCredentialP ∷ Parser AuthCredential
authCredentialP
- = try $
- do _ ← string "Basic"
+ = do _ ← string "Basic"
skipMany1 lws
b64 ← takeWhile1 base64
case C8.break (≡ ':') (B64.decodeLenient b64) of
| C8.null cPassword
→ fail "no colons in the basic auth credential"
| otherwise
- → let u = fromJust $ A.fromByteString user
- p = fromJust $ A.fromByteString (C8.tail cPassword)
- in
- return (BasicAuthCredential u p)
+ → 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 A.fromByteString bs of
+ Just as → return as
+ Nothing → fail "Non-ascii character in auth credential"