Merge branch 'parsable'

[Lucu.git] / Network / HTTP / Lucu / Authentication.hs

diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs
index 69223f2e1bb82c878c2f1174cc007a44a850f90e..c91aa7ea54dfae12364f2dde106aa4c3b4e89dca 100644 (file)
--- a/Network/HTTP/Lucu/Authentication.hs
+++ b/Network/HTTP/Lucu/Authentication.hs
@@ -12,14 +12,15 @@ module Network.HTTP.Lucu.Authentication
     , Realm
     , UserID
     , Password
-    , authCredential
     )
     where
 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 ()
@@ -64,25 +65,24 @@ deriveAttempts [ ([t| AuthChallenge |], [t| Ascii        |])
                , ([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 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)
+        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"