]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Authentication.hs
Destroy Data.Attoparsec.Parsable; use Data.Default instead
[Lucu.git] / Network / HTTP / Lucu / Authentication.hs
index c91aa7ea54dfae12364f2dde106aa4c3b4e89dca..a63419cea4b6b03e814120f82afeede81869d8cc 100644 (file)
@@ -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+/="