biscuit-wai (empty) → 0.1.0.0
raw patch · 5 files changed
+575/−0 lines, 5 filesdep +basedep +biscuit-haskelldep +biscuit-waisetup-changed
Dependencies added: base, biscuit-haskell, biscuit-wai, bytestring, hspec, http-client, http-types, text, vault, wai, warp
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- biscuit-wai.cabal +60/−0
- src/Network/Wai/Middleware/Biscuit.hs +331/−0
- test/Spec.hs +152/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Clément Delafargue (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ biscuit-wai.cabal view
@@ -0,0 +1,60 @@+cabal-version: 3.0++name: biscuit-wai+version: 0.1.0.0+category: Security+synopsis: WAI middleware for the Biscuit security token+description: Please see the README on GitHub at <https://github.com/biscuit-auth/biscuit-haskell#readme>+homepage: https://github.com/biscuit-auth/biscuit-haskell#readme+bug-reports: https://github.com/biscuit-auth/biscuit-haskell/issues+author: Clément Delafargue+maintainer: clement@delafargue.name+copyright: 2021 Clément Delafargue+license: BSD-3-Clause+license-file: LICENSE+build-type: Simple+tested-with: GHC ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1+extra-source-files:++source-repository head+ type: git+ location: https://github.com/biscuit-auth/biscuit-haskell++library+ exposed-modules:+ Network.Wai.Middleware.Biscuit+ other-modules:+ Paths_biscuit_wai+ autogen-modules:+ Paths_biscuit_wai+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >= 4.7 && <5,+ biscuit-haskell >= 0.5 && < 0.6,+ bytestring >= 0.10 && <0.13,+ http-types ^>= 0.12,+ vault ^>= 0.3,+ wai ^>= 3.2+ default-language: Haskell2010++test-suite biscuit-wai-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ build-depends:+ base >=4.7 && <5+ , biscuit-haskell+ , biscuit-wai+ , bytestring+ , hspec+ , http-client+ , http-types+ , text+ , wai+ , warp+ default-language: Haskell2010
+ src/Network/Wai/Middleware/Biscuit.hs view
@@ -0,0 +1,331 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+ Module : Network.Wai.Middleware.Biscuit+ Copyright : © Clément Delafargue, 2025+ License : BSD-3-Clause+ Maintainer : clement@delafargue.name+ WAI support for biscuit tokens++ This module provides WAI middlewares as well as builder functions for WAI middlewares, that allow protecting an HTTP application with biscuit tokens.++ The middlewares use the request vault to store either a verified biscuit token (see 'parseBiscuit', 'parseOptionalBiscuit', and 'parseBiscuitWith'),+ letting the application perform authorization, or the result of the authorization for cases where authorization is the same for all requests and can be performed directly in the middleware (see 'authorizeBiscuit'' and 'authorizeBiscuitWith')+-}+module Network.Wai.Middleware.Biscuit+ (+ -- * Biscuit parsing+ parseBiscuit+ , parseOptionalBiscuit+ , getBiscuit+ , parseBiscuitWith+ , ExtractionConfig (..)+ , defaultExtractionConfig+ , defaultOptionalExtractionConfig+ -- * Biscuit authorization+ , authorizeBiscuit'+ , getAuthorizedBiscuit+ , authorizeBiscuitWith+ , AuthorizationConfig (..)+ , defaultAuthorizationConfig+ -- * Helpers+ , defaultExtractToken+ , defaultHandleError+ , BiscuitError (..)+ ) where++import Auth.Biscuit (AuthorizedBiscuit, Authorizer, Biscuit,+ ExecutionError, OpenOrSealed, ParseError,+ PublicKey, Verified, authorizeBiscuit,+ parseB64)+import Control.Monad ((<=<))+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.List as List+import qualified Data.Vault.Lazy as Vault+import GHC.IO (unsafePerformIO)+import Network.HTTP.Types (forbidden403, hAuthorization,+ unauthorized401)+import Network.Wai (Middleware, Request (..), Response,+ responseLBS)++-- | Key where the verified biscuit is stored in the request context. The+-- 'Data.Vault.Lazy' module is designed to make keys opaque and unique, hence the use of+-- 'IO' for key generation. Here we don’t care about unicity, we want the token+-- to be easily accessible. Hence the call to 'unsafePerformIO'.+{-# NOINLINE biscuitKey #-}+biscuitKey :: Vault.Key (Biscuit OpenOrSealed Verified)+biscuitKey = unsafePerformIO Vault.newKey++-- | Key where the authorized biscuit is stored in the request context. The+-- 'Data.Vault.Lazy' module is designed to make keys opaque and unique, hence the use of+-- 'IO' for key generation. Here we don’t care about unicity, we want the token+-- to be easily accessible. Hence the call to 'unsafePerformIO'.+{-# NOINLINE authorizedBiscuitKey #-}+authorizedBiscuitKey :: Vault.Key (AuthorizedBiscuit OpenOrSealed)+authorizedBiscuitKey = unsafePerformIO Vault.newKey++-- | Retrieve the parsed token from the request context. It is meant to be used+-- in conjunction with the 'parseBiscuit' (or 'parseBiscuitWith') middleware.+-- It will not be set by the 'authorizeBiscuit'' (or 'authorizeBiscuitWith')+-- middleware.+--+-- @since 0.1.0.0+getBiscuit :: Request -> Maybe (Biscuit OpenOrSealed Verified)+getBiscuit = Vault.lookup biscuitKey . vault++-- | Retrieve the result of the successful authorization from the request+-- context. It is meant to be used in conjunction with the 'authorizeBiscuit''+-- (or the 'authorizeBiscuitWith') middleware.+--+-- @since 0.1.0.0+getAuthorizedBiscuit :: Request -> Maybe (AuthorizedBiscuit OpenOrSealed)+getAuthorizedBiscuit = Vault.lookup authorizedBiscuitKey . vault++-- | Given a public key, generate a middleware that will extract a biscuit+-- token from incoming requests, parse it, and verify its signature. Requests+-- without a verified biscuit are rejected, and the verified biscuit is added+-- to the request context.+-- __The token is not authorized, only parsed and has its signature verified__.+-- Authorization is meant to be carried out in the application itself. If you+-- want to carry out authorization in the middleware, have a look at+-- 'authorizeBiscuit'' (or 'authorizeBiscuitWith').+--+-- The token is expected as a base64-encoded string, provided as a bearer token+-- in the @Authorization@ header. A missing header results in a bodyless 401+-- HTTP response. An invalid token results in a bodyless 403 HTTP response.+-- Errors are logged to stdout.+--+-- If you need custom extraction, parsing or error handling, have a look at+-- 'parseBiscuitWith'.+--+-- @since 0.1.0.0+parseBiscuit :: PublicKey -> Middleware+parseBiscuit = parseBiscuitWith . defaultExtractionConfig++-- | Given a public key, generate a middleware that will extract a biscuit+-- token from incoming requests, parse it, and verify its signature.+--+-- Requests without a verified biscuit are __not__ rejected.+-- The verified biscuit is added to the request context (if available).+-- Requests with a token that fails parsing or verification are rejected.+-- __The token is not authorized, only parsed and has its signature verified__.+-- Authorization is meant to be carried out in the application itself. If you+-- want to carry out authorization in the middleware, have a look at+-- 'authorizeBiscuit'' (or 'authorizeBiscuitWith').+--+-- The token is expected as a base64-encoded string, provided as a bearer token+-- in the @Authorization@ header. A missing header results in a bodyless 401+-- HTTP response. An invalid token results in a bodyless 403 HTTP response.+-- Errors are logged to stdout.+--+-- If you need custom extraction, parsing or error handling, have a look at+-- 'parseBiscuitWith'.+--+-- @since 0.1.0.0+parseOptionalBiscuit :: PublicKey -> Middleware+parseOptionalBiscuit = parseBiscuitWith . defaultOptionalExtractionConfig++-- | Given a way to extract a token from a request, parse it, and handle errors,+-- generate a middleware that will extract a biscuit token from incoming+-- requests, parse it, and verify its signature. Requests without a verified+-- biscuit are rejected, and the verified biscuit is added to the request+-- context.+-- __The token is not authorized, only parsed and has its signature verified__.+-- Authorization is meant to be carried out in the application itself. If you+-- want to carry out authorization in the middleware, have a look at+-- 'authorizeBiscuit'' (or 'authorizeBiscuitWith').+--+-- If you don’t need custom extraction, parsing or error handling logic, have a+-- look at 'parseBiscuit'.+--+-- @since 0.1.0.0+parseBiscuitWith :: ExtractionConfig e -> Middleware+parseBiscuitWith config app req sendResponse = do+ let ExtractionConfig{extractToken,parseToken,handleError, onMissingBiscuit} = config+ noBiscuit = pure $ Nothing <$ onMissingBiscuit+ parse = fmap (fmap Just) . parseToken+ onError = sendResponse <=< handleError+ forward t = do+ let oldVault = vault req+ newVault = maybe id (Vault.insert biscuitKey) t $ oldVault+ app req { vault = newVault } sendResponse+ emBiscuit <- either (pure . Left) (maybe noBiscuit parse) =<< extractToken req+ either onError forward emBiscuit++-- | Given a public key and a way to generate an authorizer from a request,+-- generate a middleware that will extract a biscuit token from incoming+-- requests, parse it, verify its signature and authorize it. Requests without+-- an authorized biscuit are rejected, and the authorized biscuit is added to+-- the request context.+-- __The underlying application will only receive requests where the whole authorization process succeeded.__+-- If you want to only parse tokens and delegate actual authorization to the+-- underlying application, have a look at 'parseBiscuit'+-- (or 'parseBiscuitWith').+--+-- The token is expected as a base64-encoded string, provided as a bearer token+-- in the @Authorization@ header. A missing header results in a bodyless 401+-- HTTP response. An invalid token results in a bodyless 403 HTTP response. A+-- failed authorization process results in a bodyless 403 HTTP response.+-- Errors are logged to stdout.+--+-- If you need custom extraction, parsing, authorization or error handling,+-- have a look at 'authorizeBiscuitWith'.+--+-- @since 0.1.0.0+authorizeBiscuit' :: PublicKey -> (Request -> IO Authorizer) -> Middleware+authorizeBiscuit' publicKey = authorizeBiscuitWith . defaultAuthorizationConfig publicKey++-- | Given a way to extract a token from a request, parse it, authorized it and+-- handle errors, generate a middleware that will extract a biscuit token from+-- incoming requests, parse it, verify its signature and authorize it.+-- Requests without an authorized biscuit are rejected, and the authorized+-- biscuit is added to the request context.+-- __The underlying application will only receive requests where the whole authorization process succeeded__.+-- If you want to only parse tokens and delegate actual authorization to the+-- underlying application, have a look at 'parseBiscuit' (or+-- 'parseBiscuitWith').+--+-- If you don’t need custom extraction, parsing, authorization, or error+-- handling logic, have a look at 'authorizeBiscuit''.+--+-- @since 0.1.0.0+authorizeBiscuitWith :: AuthorizationConfig e -> Middleware+authorizeBiscuitWith config app req sendResponse = do+ let AuthorizationConfig{extractToken,parseToken,authorizeToken,handleError} = config+ onError = sendResponse <=< handleError+ forward t = do+ let newVault = Vault.insert authorizedBiscuitKey t (vault req)+ app req { vault = newVault } sendResponse+ eBiscuit <- either (pure . Left) parseToken =<< extractToken req+ eResult <- either (pure . Left) (authorizeToken req) eBiscuit+ either onError forward eResult++-- | Configuration for 'parseBiscuitWith'.+--+-- @since 0.1.0.0+data ExtractionConfig e+ = ExtractionConfig+ -- | How to extract a token from a request+ { extractToken :: Request -> IO (Either e (Maybe ByteString))+ -- | How to parse a token from the extracted serialized bytestring+ , parseToken :: ByteString -> IO (Either e (Biscuit OpenOrSealed Verified))+ -- | How to handle errors (this does not allow recovery)+ , handleError :: e -> IO Response+ -- | How to handle requests with no biscuits+ , onMissingBiscuit :: Either e ()+ }++-- | Configuration for 'authorizeBiscuitWith'.+--+-- @since 0.1.0.0+data AuthorizationConfig e+ = AuthorizationConfig+ -- | How to extract a token from a request+ { extractToken :: Request -> IO (Either e ByteString)+ -- | How to parse a token from the extracted serialized bytestring+ , parseToken :: ByteString -> IO (Either e (Biscuit OpenOrSealed Verified))+ -- | How to authorize a token+ , authorizeToken :: Request -> Biscuit OpenOrSealed Verified -> IO (Either e (AuthorizedBiscuit OpenOrSealed))+ -- | How to handle errors (this does not allow recovery)+ , handleError :: e -> IO Response+ }++-- | Errors that can happen during token authorization+--+-- @since 0.1.0.0+data BiscuitError+ -- | No token was provided+ = NoToken+ -- | The provided token could not be parsed or verified+ | ParseError ParseError+ -- | The provided token was successfully parsed, but authorization failed+ | AuthorizationError ExecutionError++-- | Default behaviour for token extraction and parsing.+--+-- - Extract the token as a bearer token from the @Authorization@ header;+-- - Parse the token as URL-safe base64 strings, using the provided public+-- key;+-- - Errors are logged to stdout;+-- - Missing tokens are rejected with a bodyless 401 HTTP response;+-- - Parsing errors are rejected with a bodyless 403 HTTP response.+--+-- @since 0.1.0.0+defaultExtractionConfig :: PublicKey -> ExtractionConfig BiscuitError+defaultExtractionConfig publicKey = ExtractionConfig+ { extractToken = pure . Right . defaultExtractToken+ , parseToken = pure . Data.Bifunctor.first ParseError . parseB64 publicKey+ , handleError = defaultHandleError+ , onMissingBiscuit = Left NoToken+ }++-- | Default behaviour for optional token extraction and parsing.+--+-- - Extract the token as a bearer token from the @Authorization@ header;+-- - Parse the token as URL-safe base64 strings, using the provided public+-- key;+-- - Errors are logged to stdout;+-- - Missing tokens are not rejected;+-- - Parsing errors are rejected with a bodyless 403 HTTP response.+--+-- @since 0.1.0.0+defaultOptionalExtractionConfig :: PublicKey -> ExtractionConfig BiscuitError+defaultOptionalExtractionConfig publicKey = ExtractionConfig+ { extractToken = pure . Right . defaultExtractToken+ , parseToken = pure . Data.Bifunctor.first ParseError . parseB64 publicKey+ , handleError = defaultHandleError+ , onMissingBiscuit = Right ()+ }++-- | Default behaviour for token extraction, parsing and authorization.+--+-- - Extract the token as a bearer token from the @Authorization@ header;+-- - Parse the token as URL-safe base64 strings, using the provided public+-- key;+-- - Authorize the request with the generated authorizer;+-- - Errors are logged to stdout;+-- - Missing tokens are rejected with a bodyless 401 HTTP response;+-- - Parsing errors are rejected with a bodyless 403 HTTP response.+-- - Authorization errors are rejected with a bodyless 403 HTTP response.+--+-- @since 0.1.0.0+defaultAuthorizationConfig :: PublicKey -> (Request -> IO Authorizer) -> AuthorizationConfig BiscuitError+defaultAuthorizationConfig publicKey mkAuthorizer = AuthorizationConfig+ { extractToken = pure . maybe (Left NoToken) Right . defaultExtractToken+ , parseToken = pure . Data.Bifunctor.first ParseError . parseB64 publicKey+ , authorizeToken = \req token -> first AuthorizationError <$> (authorizeBiscuit token =<< mkAuthorizer req)+ , handleError = defaultHandleError+ }++-- | Extract a token from the @Authorization@ header, stripping the @Bearer @+-- prefix.+--+-- @since 0.1.0.0+defaultExtractToken :: Request -> Maybe ByteString+defaultExtractToken req = do+ (_, authHeader) <- List.find ((== hAuthorization) . fst) $ requestHeaders req+ BS.stripPrefix "Bearer " authHeader++-- | Generate HTTP responses based on authorization errors. Errors are logged+-- to stdout.+--+-- - Missing tokens result in a 401 bodyless response;+-- - Parsing errors result in a 403 bodyless response;+-- - Authorization errors result in a 403 bodyless response.+--+-- @since 0.1.0.0+defaultHandleError :: BiscuitError -> IO Response+defaultHandleError = \case+ NoToken -> do+ putStrLn "Missing biscuit token"+ pure $ responseLBS unauthorized401 mempty mempty+ ParseError e -> do+ putStrLn $ "Parsing or verification error: " <> show e+ pure $ responseLBS forbidden403 mempty mempty+ AuthorizationError e -> do+ putStrLn $ "Authorization error: " <> show e+ pure $ responseLBS forbidden403 mempty mempty
+ test/Spec.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+module Main (main) where++import Auth.Biscuit (SecretKey, authorizer, block,+ mkBiscuit, parseSecretKeyHex,+ serializeB64, toPublic)+import Data.Maybe (fromMaybe)+import Data.Text.Encoding (decodeUtf8)+import Network.HTTP.Client (Response (responseStatus),+ applyBearerAuth,+ defaultManagerSettings,+ httpLbs, newManager,+ parseRequest)+import Network.HTTP.Types (Status (..), badRequest400,+ notFound404, ok200)+import Network.Wai (Application,+ Request (pathInfo, rawPathInfo),+ ifRequest, responseLBS)+import qualified Network.Wai.Handler.Warp as Warp+import Network.Wai.Middleware.Biscuit (authorizeBiscuit',+ getAuthorizedBiscuit,+ getBiscuit, parseBiscuit,+ parseOptionalBiscuit)+import Test.Hspec (around, describe, hspec, it,+ shouldBe)++secretKey :: SecretKey+secretKey = fromMaybe (error "Failed parsing secret key") $ parseSecretKeyHex "ac40d48ac474b6d41a58cbb91facc6317e32afdc21edfe23b9967e9d07c039be"++otherSecretKey :: SecretKey+otherSecretKey = fromMaybe (error "Failed parsing secret key") $ parseSecretKeyHex "1b53545e9ca6d1368bb222cb4c2183aac3304d8a3d0fea53173bca82f57b95a8"++app :: Application+app =+ let endpoint req sendResponse = case pathInfo req of+ ["protected", "optional"] ->+ case getBiscuit req of+ Just _ -> sendResponse $ responseLBS ok200 mempty mempty+ Nothing -> sendResponse $ responseLBS ok200 mempty mempty+ ["protected", "parsed"] ->+ case getBiscuit req of+ Just _ -> sendResponse $ responseLBS ok200 mempty mempty+ Nothing -> sendResponse $ responseLBS badRequest400 mempty mempty+ ["protected", "authed"] ->+ case getAuthorizedBiscuit req of+ Just _ -> sendResponse $ responseLBS ok200 mempty mempty+ Nothing -> sendResponse $ responseLBS badRequest400 mempty mempty+ [] -> sendResponse $ responseLBS ok200 mempty mempty+ _ -> sendResponse $ responseLBS notFound404 mempty mempty+ checkBiscuit = parseOptionalBiscuit (toPublic secretKey)+ checkBiscuit' = parseBiscuit (toPublic secretKey)+ checkBiscuit'' = authorizeBiscuit' (toPublic secretKey) $ \req ->+ let path = decodeUtf8 $ rawPathInfo req+ in pure [authorizer|allow if right({path});|]+ isProtectedOptional = (== ["protected", "optional"]) . take 2 . pathInfo+ isProtectedParsed = (== ["protected", "parsed"]) . take 2 . pathInfo+ isProtectedAuthed = (== ["protected", "authed"]) . take 2 . pathInfo+ in ifRequest isProtectedOptional checkBiscuit $+ ifRequest isProtectedParsed checkBiscuit' $+ ifRequest isProtectedAuthed checkBiscuit'' endpoint++withApp :: (Warp.Port -> IO ()) -> IO ()+withApp =+ --testWithApplication makes sure the action is executed after the server has+ -- started and is being properly shutdown.+ -- exceptions thrown by the app are bubbled up to the test suite.+ Warp.testWithApplication (pure app)++main :: IO ()+main = do+ manager <- newManager defaultManagerSettings+ hspec $+ around withApp $+ describe "biscuit wai middleware" $ do+ describe "on open endpoints" $ do+ it "accepts unauthenticated calls" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port+ res <- httpLbs req manager+ statusCode (responseStatus res) `shouldBe` 200+ describe "on protected endpoints (optional)" $ do+ it "accepts unauthenticated calls" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port+ res <- httpLbs req manager+ statusCode (responseStatus res) `shouldBe` 200+ it "rejects gibberish tokens" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ let withAuth = applyBearerAuth "whatevs" req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "rejects tokens signed by the wrong keypair" $ \port -> do+ badToken <- mkBiscuit otherSecretKey mempty+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ let withAuth = applyBearerAuth (serializeB64 badToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "accepts properly signed tokens" $ \port -> do+ goodToken <- mkBiscuit secretKey mempty+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ let withAuth = applyBearerAuth (serializeB64 goodToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 200+ describe "on protected endpoints (parsing)" $ do+ it "rejects unauthenticated calls" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ res <- httpLbs req manager+ statusCode (responseStatus res) `shouldBe` 401+ it "rejects gibberish tokens" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ let withAuth = applyBearerAuth "whatevs" req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "rejects tokens signed by the wrong keypair" $ \port -> do+ badToken <- mkBiscuit otherSecretKey mempty+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ let withAuth = applyBearerAuth (serializeB64 badToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "accepts properly signed tokens" $ \port -> do+ goodToken <- mkBiscuit secretKey mempty+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/parsed"+ let withAuth = applyBearerAuth (serializeB64 goodToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 200+ describe "on protected endpoints (auth)" $ do+ it "rejects unauthenticated calls" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/authed"+ res <- httpLbs req manager+ statusCode (responseStatus res) `shouldBe` 401+ it "rejects gibberish tokens" $ \port -> do+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/authed"+ let withAuth = applyBearerAuth "whatevs" req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "rejects tokens signed by the wrong keypair" $ \port -> do+ badToken <- mkBiscuit otherSecretKey mempty+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/authed"+ let withAuth = applyBearerAuth (serializeB64 badToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "rejects properly signed tokens which fail authorization" $ \port -> do+ badToken <- mkBiscuit secretKey mempty+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/authed"+ let withAuth = applyBearerAuth (serializeB64 badToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 403+ it "accepts properly signed tokens which succeed authorization" $ \port -> do+ goodToken <- mkBiscuit secretKey [block|right("/protected/authed");|]+ req <- parseRequest $ "http://localhost:" <> show port <> "/protected/authed"+ let withAuth = applyBearerAuth (serializeB64 goodToken) req+ res <- httpLbs withAuth manager+ statusCode (responseStatus res) `shouldBe` 200