Doc fix

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

diff --git a/Network/HTTP/Lucu/Authentication.hs b/Network/HTTP/Lucu/Authentication.hs
new file mode 100644 (file)
index 0000000..7479188
--- /dev/null
+++ b/Network/HTTP/Lucu/Authentication.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE
+    OverloadedStrings
+  , UnicodeSyntax
+  #-}
+-- |Manipulation of WWW authentication.
+module Network.HTTP.Lucu.Authentication
+    ( AuthChallenge(..)
+    , AuthCredential(..)
+    , Realm
+    , UserID
+    , Password
+
+    , printAuthChallenge
+    , authCredentialP
+    )
+    where
+import Data.Ascii (Ascii)
+import qualified Data.Ascii as A
+import Data.Attoparsec.Char8
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
+import Data.Monoid.Unicode
+import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
+
+-- |Authorization challenge to be sent to client with
+-- \"WWW-Authenticate\" header. See
+-- 'Network.HTTP.Lucu.Resource.setWWWAuthenticate'.
+data AuthChallenge
+    = BasicAuthChallenge !Realm
+      deriving (Eq)
+
+-- |'Realm' is just a string which must not contain any non-ASCII letters.
+type Realm = Ascii
+
+-- |Authorization credential to be sent by client with
+-- \"Authorization\" header. See
+-- 'Network.HTTP.Lucu.Resource.getAuthorization'.
+data AuthCredential
+    = BasicAuthCredential !UserID !Password
+      deriving (Show, Eq)
+
+-- |'UserID' is just a string which must not contain colon and any
+-- non-ASCII letters.
+type UserID   = Ascii
+
+-- |'Password' is just a string which must not contain any non-ASCII
+-- letters.
+type Password = Ascii
+
+-- |Convert an 'AuthChallenge' to 'Ascii'.
+printAuthChallenge ∷ AuthChallenge → Ascii
+printAuthChallenge (BasicAuthChallenge realm)
+    = A.fromAsciiBuilder $
+      A.toAsciiBuilder "Basic realm=" ⊕ quoteStr realm
+
+authCredentialP ∷ Parser AuthCredential
+authCredentialP
+    = do _ ← 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 A.fromByteString bs of
+                 Just as → return as
+                 Nothing → fail "Non-ascii character in auth credential"