wai-middleware-bearer (empty) → 1.0.3

raw patch · 6 files changed

+264/−0 lines, 6 filesdep +basedep +bytestringdep +hspecsetup-changed

Dependencies added: base, bytestring, hspec, hspec-wai, http-types, wai, wai-middleware-bearer, word8

Files

• LICENSE +20/−0
• README.md +46/−0
• Setup.hs +3/−0
• src/Network/Wai/Middleware/BearerTokenAuth.hs +103/−0
• test/Spec.hs +33/−0
• wai-middleware-bearer.cabal +59/−0

@@ -0,0 +1,20 @@+Copyright (c) 2022 Martin Bednar++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,46 @@+# wai-middleware-bearer++WAI middleware providing [bearer token authentication](https://swagger.io/docs/specification/authentication/bearer-authentication/).+## Usage example++The following code shows a secure **Hello World** application:++```haskell+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Network.Wai.Middleware.BearerTokenAuth+import Network.Wai+import Network.HTTP.Types.Status (status200)+import Network.Wai.Handler.Warp (run)++myApp :: Application+myApp req rsp = rsp $ responseLBS status200 [] "Hello World"++secureApp :: Application+secureApp = tokenListAuth ["abc", "123"] myApp++main :: IO ()+main = run 3000 secureApp+```++Valid token request example (200 OK):+```sh+$ curl -H "Authorization: bearer abc" 'localhost:3000'++Hello World⏎+```++Invalid token request example (401 Unauthorized):+```sh+$ curl -H "Authorization: bearer otherToken" 'localhost:3000'++Bearer token authentication is required⏎ +```++Missing token request example (401 Unauthorized):+```sh+curl 'localhost:3000'++Bearer token authentication is required⏎+```

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,103 @@+{-|+Module      : Network.Wai.Middleware.BearerTokenAuth+Description : Implements HTTP Bearer Token Authentication.+Copyright   : (c) Martin Bednar, 2022+License     : MIT+Maintainer  : bednam17@fit.cvut.cz+Stability   : experimental+Portability : POSIX++Implements Bearer Token Authentication as a WAI 'Middleware'.++This module is based on 'Network.Wai.Middleware.HttpAuth'.++-}+{-# LANGUAGE OverloadedStrings #-}++-- The implementation is based on 'Network.Wai.Middleware.HttpAuth'.++module Network.Wai.Middleware.BearerTokenAuth+  ( -- * Middleware+    --+    -- | You can choose from three functions to use this middleware:+    --+    -- 1. 'tokenListAuth' is the simplest to use and accepts a list of valid tokens;+    --+    -- 2. 'tokenAuth' can be used to perform a more sophisticated validation of the accepted token (such as database lookup);+    --+    -- 3. 'tokenAuth'' is similar to 'tokenAuth', but it also passes the 'Request' to the validation function.+    tokenListAuth+  , tokenAuth+  , tokenAuth'+    -- * Token validation+  , TokenValidator+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as S+import Data.Word8 (isSpace, toLower)+import Network.HTTP.Types (hAuthorization, hContentType, status401)+import Network.Wai (Middleware, Request(requestHeaders), Response, responseLBS)++-- | Type synonym for validating a token +type TokenValidator = ByteString -> IO Bool++-- | Perform token authentication+-- based on a list of allowed tokens.+--+-- > tokenListAuth ["secret1", "secret2"]+tokenListAuth :: [ByteString] -> Middleware+tokenListAuth tokens = tokenAuth (\tok -> return $ tok `elem` tokens)++-- | Performs token authentication.+--+-- If the token is accepted, leaves the Application unchanged.+-- Otherwise, sends a @401 Unauthorized@ HTTP response.+--+-- > tokenAuth (\tok -> return $ tok == "abcd" )+tokenAuth +  :: TokenValidator -- ^ Function that determines whether the token is valid +  -> Middleware+tokenAuth checker = tokenAuth' (const checker)++-- | Like 'tokenAuth', but also passes the 'Request' to the validator function.+--+tokenAuth' +  :: (Request -> TokenValidator) -- ^ Function that determines whether the token is valid+  -> Middleware+tokenAuth' checkByReq app req sendRes = do+  let checker = checkByReq req+  let pass = app req sendRes+  authorized <- check checker req+  if authorized+    then pass -- Pass the Application on successful auth+    else sendRes rspUnauthorized -- Send a @401 Unauthorized@ response on failed auth++check :: TokenValidator -> Request -> IO Bool+check checkCreds req =+  case extractBearerFromRequest req of+    Nothing -> return False+    Just token -> checkCreds token++rspUnauthorized :: Response+rspUnauthorized =+  responseLBS+    status401+    [(hContentType, "text/plain"), ("WWW-Authenticate", "Bearer")]+    "Bearer token authentication is required"++extractBearerFromRequest :: Request -> Maybe ByteString+extractBearerFromRequest req = do+  authHeader <- lookup hAuthorization (requestHeaders req)+  extractBearerAuth authHeader++-- | Extract bearer authentication data from __Authorization__ header+-- value. Returns bearer token+--+-- Source: https://hackage.haskell.org/package/wai-extra-3.1.11/docs/Network-Wai-Middleware-HttpAuth.html+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

@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Network.Wai.Middleware.BearerTokenAuth+import Test.Hspec+import Test.Hspec.Wai+import Network.Wai+import Network.HTTP.Types.Status (status200)++myApp :: Application+myApp req rsp = rsp $ responseLBS status200 [] "Hello World"++secureApp :: Application+secureApp = tokenListAuth ["abc", "123"] myApp++main :: IO ()+main = hspec $ do+  with (return secureApp) $ do+      describe "GET /" $ do+        it "accepts valid token" $ do+          let validHeader1 = ("Authorization", "Bearer abc")+          request "GET" "/" [validHeader1] "" `shouldRespondWith`+            200+          let validHeader2 = ("Authorization", "Bearer 123")+          request "GET" "/" [validHeader2] "" `shouldRespondWith`+            200+        it "rejects invalid token" $ do+          let invalidHeader = ("Authorization", "Bearer abcd")+          request "GET" "/" [invalidHeader] "" `shouldRespondWith`+            401+        it "rejects missing token" $ do+          get "/" `shouldRespondWith` 401+

@@ -0,0 +1,59 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           wai-middleware-bearer+version:        1.0.3+synopsis:       WAI Middleware for Bearer Token Authentication+description:    Please see the README on GitHub at <https://github.com/martin-bednar/wai-middleware-bearer#readme>+category:       Authentication, Web+homepage:       https://github.com/martin-bednar/wai-middleware-bearer#readme+bug-reports:    https://github.com/martin-bednar/wai-middleware-bearer/issues+author:         Martin Bednar+maintainer:     bednam17@fit.cvut.cz+copyright:      2022 Martin Bednar+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/martin-bednar/wai-middleware-bearer++library+  exposed-modules:+      Network.Wai.Middleware.BearerTokenAuth+  other-modules:+      Paths_wai_middleware_bearer+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10.12.1 && <1+    , http-types >=0.12.3 && <1+    , wai >=3.2.3 && <4+    , word8 >=0.1.3 && <1+  default-language: Haskell2010++test-suite wai-middleware-bearer-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_wai_middleware_bearer+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , bytestring >=0.10.12.1 && <1+    , hspec+    , hspec-wai+    , http-types >=0.12.3 && <1+    , wai >=3.2.3 && <4+    , wai-middleware-bearer+    , word8 >=0.1.3 && <1+  default-language: Haskell2010