packages feed

wai-extra 3.0.4.6 → 3.0.5

raw patch · 3 files changed

+53/−23 lines, 3 files

Files

ChangeLog.md view
@@ -1,3 +1,7 @@+## 3.0.5++* add functions to extract authentication data from Authorization header [#352](add functions to extract authentication data from Authorization header #352)+ ## 3.0.4.6  * Access log sequence not valid [#336](https://github.com/yesodweb/wai/issues/336)
Network/Wai/Middleware/HttpAuth.hs view
@@ -1,24 +1,31 @@-{-# LANGUAGE RecordWildCards, OverloadedStrings #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings, TupleSections #-} -- | Implements HTTP Basic Authentication. -- -- This module may add digest authentication in the future. module Network.Wai.Middleware.HttpAuth-    ( basicAuth+    ( -- * Middleware+      basicAuth     , CheckCreds     , AuthSettings     , authRealm     , authOnNoAuth     , authIsProtected+      -- * Helping functions+    , extractBasicAuth+    , extractBearerAuth     ) where -import Network.Wai-import Network.HTTP.Types (status401)+import Control.Applicative import Data.ByteString (ByteString)-import qualified Data.ByteString as S+import Data.ByteString.Base64 (decodeLenient) import Data.String (IsString (..)) import Data.Word8 (isSpace, _colon, toLower)-import Data.ByteString.Base64 (decodeLenient)+import Network.HTTP.Types (status401)+import Network.Wai +import qualified Data.ByteString as S++ -- | Check if a given username and password is valid. type CheckCreds = ByteString                -> ByteString@@ -40,24 +47,16 @@         else authOnNoAuth authRealm req sendResponse   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+        case (lookup "Authorization" $ requestHeaders req)+             >>= extractBasicAuth of             Nothing -> return False-      where-        raw = decodeLenient encoded-        (username, password') = S.breakByte _colon raw+            Just (username, password) -> checkCreds username password --- | 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.++-- | Basic 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 --@@ -95,3 +94,30 @@             "Basic authentication is required"         , authIsProtected = const $ return True         }++-- | Extract basic authentication data from usually __Authorization__+-- header value. Returns username and password+--+-- Since 3.0.5+extractBasicAuth :: ByteString -> Maybe (ByteString, ByteString)+extractBasicAuth bs =+    let (x, y) = S.break isSpace bs+    in if S.map toLower x == "basic"+       then extract $ S.dropWhile isSpace y+       else Nothing+  where+    extract encoded =+        let raw = decodeLenient encoded+            (username, password') = S.breakByte _colon raw+        in ((username,) . snd) <$> S.uncons password'++-- | Extract bearer authentication data from __Authorization__ header+-- value. Returns bearer token+--+-- Since 3.0.5+extractBearerAuth :: ByteString -> Maybe ByteString+extractBearerAuth bs =+    let (x, y) = S.break isSpace bs+    in if S.map toLower x == "bearer"+        then Just $ S.dropWhile isSpace y+        else Nothing
wai-extra.cabal view
@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.4.6+Version:             3.0.5 Synopsis:            Provides some basic WAI handlers and middleware. description:   Provides basic WAI handler and middleware functionality: