Code clean-up using convertible-text

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

diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs
index 29ae0e92bc1b9752850a7ce8dd342df78fa6203a..69223f2e1bb82c878c2f1174cc007a44a850f90e 100644 (file)
--- a/Network/HTTP/Lucu/Authentication.hs
+++ b/Network/HTTP/Lucu/Authentication.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE
-    OverloadedStrings
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TemplateHaskell
   , UnicodeSyntax
   #-}
 -- |An internal module for HTTP authentication.
@@ -9,17 +12,18 @@ module Network.HTTP.Lucu.Authentication
     , Realm
     , UserID
     , Password
-
-    , printAuthChallenge
     , authCredential
     )
     where
 import Control.Monad
-import Data.Ascii (Ascii)
-import qualified Data.Ascii as A
+import Data.Ascii (Ascii, AsciiBuilder)
+import Data.Attempt
 import Data.Attoparsec.Char8
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C8
+import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Utils
 import Data.Monoid.Unicode
 import Network.HTTP.Lucu.Parser.Http
 import Network.HTTP.Lucu.Utils
@@ -47,11 +51,18 @@ type UserID = Ascii
 -- |'Password' is just an 'Ascii' string.
 type Password = Ascii
 
--- |Convert an 'AuthChallenge' to 'Ascii'.
-printAuthChallenge ∷ AuthChallenge → Ascii
-printAuthChallenge (BasicAuthChallenge realm)
-    = A.fromAsciiBuilder $
-      A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm
+instance ConvertSuccess AuthChallenge Ascii where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = convertSuccessVia ((⊥) ∷ AsciiBuilder)
+
+instance ConvertSuccess AuthChallenge AsciiBuilder where
+    {-# INLINE convertSuccess #-}
+    convertSuccess (BasicAuthChallenge realm)
+        = cs ("Basic realm=" ∷ Ascii) ⊕ quoteStr realm
+
+deriveAttempts [ ([t| AuthChallenge |], [t| Ascii        |])
+               , ([t| AuthChallenge |], [t| AsciiBuilder |])
+               ]
 
 -- |'Parser' for an 'AuthCredential'.
 authCredential ∷ Parser AuthCredential
@@ -72,6 +83,6 @@ authCredential
       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"
+      asc bs = case ca bs of
+                 Success as → return as
+                 Failure _  → fail "Non-ascii character in auth credential"