diff --git a/biscuit-wai/src/Network/Wai/Middleware/Biscuit.hs b/biscuit-wai/src/Network/Wai/Middleware/Biscuit.hs index 8f41a55..f1a2a72 100644 --- a/biscuit-wai/src/Network/Wai/Middleware/Biscuit.hs +++ b/biscuit-wai/src/Network/Wai/Middleware/Biscuit.hs @@ -3,12 +3,22 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Network.Wai.Middleware.Biscuit - ( parseBiscuit + ( + -- * Biscuit parsing + parseBiscuit + , getBiscuit , parseBiscuitWith + , ExtractionConfig (..) + , defaultExtractionConfig + -- * Biscuit authorization , authorizeBiscuit' - , authorizeBiscuitWith - , getBiscuit , getAuthorizedBiscuit + , authorizeBiscuitWith + , AuthorizationConfig (..) + , defaultAuthorizationConfig + -- * Helpers + , defaultExtractToken + , defaultHandleError ) where import Auth.Biscuit (AuthorizedBiscuit, Authorizer, Biscuit, @@ -27,24 +37,64 @@ import Network.HTTP.Types (forbidden403, hAuthorization, import Network.Wai (Middleware, Request (..), Response, responseLBS) --- todo explain why +-- | Key where the verified biscuit is stored in the request context. The +-- `Vault` 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 +-- `Vault` 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. 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. 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`. parseBiscuit :: PublicKey -> Middleware parseBiscuit = parseBiscuitWith . defaultExtractionConfig +-- | 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`. parseBiscuitWith :: ExtractionConfig e -> Middleware parseBiscuitWith config app req sendResponse = do let ExtractionConfig{extractToken,parseToken,handleError} = config @@ -55,9 +105,38 @@ parseBiscuitWith config app req sendResponse = do eBiscuit <- either (pure . Left) parseToken =<< extractToken req either onError forward eBiscuit +-- | 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`. 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'`. authorizeBiscuitWith :: AuthorizationConfig e -> Middleware authorizeBiscuitWith config app req sendResponse = do let AuthorizationConfig{extractToken,parseToken,authorizeToken,handleError} = config @@ -69,26 +148,47 @@ authorizeBiscuitWith config app req sendResponse = do eResult <- either (pure . Left) (authorizeToken req) eBiscuit either onError forward eResult +-- | Configuration for `parseBiscuitWith`. data ExtractionConfig e = ExtractionConfig + -- | 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 handle errors (this does not allow recovery) , handleError :: e -> IO Response } +-- | Configuration for `authorizeBiscuitWith`. 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 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. defaultExtractionConfig :: PublicKey -> ExtractionConfig BiscuitError defaultExtractionConfig publicKey = ExtractionConfig { extractToken = pure . maybe (Left NoToken) Right . defaultExtractToken @@ -96,6 +196,16 @@ defaultExtractionConfig publicKey = ExtractionConfig , handleError = defaultHandleError } +-- | 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. defaultAuthorizationConfig :: PublicKey -> (Request -> IO Authorizer) -> AuthorizationConfig BiscuitError defaultAuthorizationConfig publicKey mkAuthorizer = AuthorizationConfig { extractToken = pure . maybe (Left NoToken) Right . defaultExtractToken @@ -104,11 +214,19 @@ defaultAuthorizationConfig publicKey mkAuthorizer = AuthorizationConfig , handleError = defaultHandleError } +-- | Extract a token from the @Authorization@ header, stripping the @Bearer @ +-- prefix. 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. defaultHandleError :: BiscuitError -> IO Response defaultHandleError = \case NoToken -> do