X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FAuthentication.hs;fp=Network%2FHTTP%2FLucu%2FAuthentication.hs;h=a63419cea4b6b03e814120f82afeede81869d8cc;hp=c91aa7ea54dfae12364f2dde106aa4c3b4e89dca;hb=90fca0675b1694e69b8e431c989343855cbd125d;hpb=742b0cae221f12eafbf1379b91c473b059efa7d8 diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs index c91aa7e..a63419c 100644 --- a/Network/HTTP/Lucu/Authentication.hs +++ b/Network/HTTP/Lucu/Authentication.hs @@ -3,6 +3,7 @@ , MultiParamTypeClasses , OverloadedStrings , TemplateHaskell + , TypeSynonymInstances , UnicodeSyntax #-} -- |An internal module for HTTP authentication. @@ -18,13 +19,12 @@ import Control.Monad 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 @@ -65,18 +65,18 @@ deriveAttempts [ ([t| AuthChallenge |], [t| Ascii |]) , ([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+/="