wai-extra 1.3.3.2 → 1.3.4

raw patch · 2 files changed

+102/−1 lines, 2 filesdep +base64-bytestringdep +word8

Dependencies added: base64-bytestring, word8

Files

• Network/Wai/Middleware/HttpAuth.hs +98/−0
• wai-extra.cabal +4/−1

@@ -0,0 +1,98 @@+{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+-- | Implements HTTP Basic Authentication.+--+-- This module may add digest authentication in the future.+module Network.Wai.Middleware.HttpAuth+    ( basicAuth+    , CheckCreds+    , AuthSettings+    , authRealm+    , authOnNoAuth+    , authIsProtected+    ) where++import Network.Wai+import Network.HTTP.Types (status401)+import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Data.String (IsString (..))+import Control.Monad.Trans.Resource (ResourceT)+import Data.Word8 (isSpace, _colon, toLower)+import Data.ByteString.Base64 (decodeLenient)++-- | Check if a given username and password is valid.+type CheckCreds = ByteString+               -> ByteString+               -> ResourceT IO Bool++-- | Perform basic authentication.+--+-- > basicAuth (\u p -> return $ u == "michael" && p == "mypass") "My Realm"+--+-- Since 1.3.4+basicAuth :: CheckCreds+          -> AuthSettings+          -> Middleware+basicAuth checkCreds AuthSettings {..} app req = do+    isProtected <- authIsProtected req+    allowed <- if isProtected then check else return True+    if allowed+        then app req+        else authOnNoAuth authRealm req+  where+    check =+        case lookup "Authorization" $ requestHeaders req of+            Nothing -> return False+            Just bs ->+                let (x, y) = S.break isSpace bs+                 in if S.map toLower x == "basic"+                        then checkB64 $ S.dropWhile isSpace y+                        else return False+    checkB64 encoded =+        case S.uncons password' of+            Just (_, password) -> checkCreds username password+            Nothing -> return False+      where+        raw = decodeLenient encoded+        (username, password') = S.breakByte _colon raw++-- | Authentication settings. This value is an instance of @IsString@, so the+-- recommended approach to create a value is to provide a string literal (which+-- will be the realm) and then overriding individual fields.+--+-- > "My Realm" { authIsProtected = someFunc } :: AuthSettings+--+-- Since 1.3.4+data AuthSettings = AuthSettings+    { authRealm :: !ByteString+    -- ^+    --+    -- Since 1.3.4+    , authOnNoAuth :: !(ByteString -> Application)+    -- ^ Takes the realm and returns an appropriate 401 response when+    -- authentication is not provided.+    --+    -- Since 1.3.4+    , authIsProtected :: !(Request -> ResourceT IO Bool)+    -- ^ Determine if access to the requested resource is restricted.+    --+    -- Default: always returns @True@.+    --+    -- Since 1.3.4+    }++instance IsString AuthSettings where+    fromString s = AuthSettings+        { authRealm = fromString s+        , authOnNoAuth = \realm _req -> return $ responseLBS+            status401+            [ ("Content-Type", "text/plain")+            , ("WWW-Authenticate", S.concat+                [ "Basic realm=\""+                , realm+                , "\""+                ])+            ]+            "Basic authentication is required"+        , authIsProtected = const $ return True+        }

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             1.3.3.2+Version:             1.3.4 Synopsis:            Provides some basic WAI handlers and middleware. Description:         The goal here is to provide common features without many dependencies. License:             MIT@@ -44,6 +44,8 @@                    , void                      >= 0.5                    , stringsearch              >= 0.3      && < 0.4                    , containers+                   , base64-bytestring+                   , word8    Exposed-modules:   Network.Wai.Handler.CGI                      Network.Wai.Middleware.AcceptOverride@@ -56,6 +58,7 @@                      Network.Wai.Middleware.MethodOverridePost                      Network.Wai.Middleware.Rewrite                      Network.Wai.Middleware.Vhost+                     Network.Wai.Middleware.HttpAuth                      Network.Wai.Parse   ghc-options:       -Wall