wai-extra 3.0.4.6 → 3.0.5
raw patch · 3 files changed
+53/−23 lines, 3 files
Files
- ChangeLog.md +4/−0
- Network/Wai/Middleware/HttpAuth.hs +48/−22
- wai-extra.cabal +1/−1
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: