Merge #456
This commit is contained in:
commit
b8422e80b2
4 changed files with 14 additions and 5 deletions
|
@ -44,7 +44,7 @@ You can use this combinator to protect an API as follows:
|
||||||
|
|
||||||
module Authentication where
|
module Authentication where
|
||||||
|
|
||||||
import Control.Monad.Trans.Except (ExceptT, throwE)
|
import Control.Monad.Trans.Except (ExceptT)
|
||||||
import Data.Aeson (ToJSON)
|
import Data.Aeson (ToJSON)
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Data.Map (Map, fromList)
|
import Data.Map (Map, fromList)
|
||||||
|
@ -59,6 +59,7 @@ import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
|
||||||
Get, JSON)
|
Get, JSON)
|
||||||
import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
|
import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
|
||||||
import Servant.API.Experimental.Auth (AuthProtect)
|
import Servant.API.Experimental.Auth (AuthProtect)
|
||||||
|
import Servant (throwError)
|
||||||
import Servant.Server (BasicAuthCheck (BasicAuthCheck),
|
import Servant.Server (BasicAuthCheck (BasicAuthCheck),
|
||||||
BasicAuthResult( Authorized
|
BasicAuthResult( Authorized
|
||||||
, Unauthorized
|
, Unauthorized
|
||||||
|
@ -173,7 +174,7 @@ And now we create the `Context` used by servant to find `BasicAuthCheck`:
|
||||||
```haskell
|
```haskell
|
||||||
-- | We need to supply our handlers with the right Context. In this case,
|
-- | We need to supply our handlers with the right Context. In this case,
|
||||||
-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
|
-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
|
||||||
-- tagged with "foo-tag" This context is then supplied to 'server' and threaded
|
-- tagged with "foo-tag" This context is then supplied to 'server' and threaded
|
||||||
-- to the BasicAuth HasServer handlers.
|
-- to the BasicAuth HasServer handlers.
|
||||||
basicAuthServerContext :: Context (BasicAuthCheck User ': '[])
|
basicAuthServerContext :: Context (BasicAuthCheck User ': '[])
|
||||||
basicAuthServerContext = authCheck :. EmptyContext
|
basicAuthServerContext = authCheck :. EmptyContext
|
||||||
|
@ -274,7 +275,7 @@ database = fromList [ ("key1", Account "Anne Briggs")
|
||||||
-- This is our bespoke (and bad) authentication logic.
|
-- This is our bespoke (and bad) authentication logic.
|
||||||
lookupAccount :: ByteString -> ExceptT ServantErr IO Account
|
lookupAccount :: ByteString -> ExceptT ServantErr IO Account
|
||||||
lookupAccount key = case Map.lookup key database of
|
lookupAccount key = case Map.lookup key database of
|
||||||
Nothing -> throwE (err403 { errBody = "Invalid Cookie" })
|
Nothing -> throwError (err403 { errBody = "Invalid Cookie" })
|
||||||
Just usr -> return usr
|
Just usr -> return usr
|
||||||
```
|
```
|
||||||
|
|
||||||
|
@ -289,7 +290,7 @@ method:
|
||||||
authHandler :: AuthHandler Request Account
|
authHandler :: AuthHandler Request Account
|
||||||
authHandler =
|
authHandler =
|
||||||
let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
|
let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
|
||||||
Nothing -> throwE (err401 { errBody = "Missing auth header" })
|
Nothing -> throwError (err401 { errBody = "Missing auth header" })
|
||||||
Just authCookieKey -> lookupAccount authCookieKey
|
Just authCookieKey -> lookupAccount authCookieKey
|
||||||
in mkAuthHandler handler
|
in mkAuthHandler handler
|
||||||
```
|
```
|
||||||
|
@ -329,7 +330,7 @@ We now construct the `Context` for our server, allowing us to instantiate a
|
||||||
value of type `Server AuthGenAPI`, in addition to the server value:
|
value of type `Server AuthGenAPI`, in addition to the server value:
|
||||||
|
|
||||||
```haskell
|
```haskell
|
||||||
-- | The context that will be made available to request handlers. We supply the
|
-- | The context that will be made available to request handlers. We supply the
|
||||||
-- "cookie-auth"-tagged request handler defined above, so that the 'HasServer' instance
|
-- "cookie-auth"-tagged request handler defined above, so that the 'HasServer' instance
|
||||||
-- of 'AuthProtect' can extract the handler and run it on the request.
|
-- of 'AuthProtect' can extract the handler and run it on the request.
|
||||||
genAuthServerContext :: Context (AuthHandler Request Account ': '[])
|
genAuthServerContext :: Context (AuthHandler Request Account ': '[])
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
HEAD
|
||||||
|
----
|
||||||
|
|
||||||
|
* Use `throwError` instead of `throwE` in documentation
|
||||||
|
|
||||||
0.5
|
0.5
|
||||||
----
|
----
|
||||||
|
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
to the correct endpoint. Functions `layout` and `layoutWithContext` have
|
to the correct endpoint. Functions `layout` and `layoutWithContext` have
|
||||||
been added to visualize the router layout for debugging purposes. Test
|
been added to visualize the router layout for debugging purposes. Test
|
||||||
cases for expected router layouts have been added.
|
cases for expected router layouts have been added.
|
||||||
|
* Export `throwError` from module `Servant`
|
||||||
|
|
||||||
0.6.1
|
0.6.1
|
||||||
-----
|
-----
|
||||||
|
|
|
@ -10,8 +10,10 @@ module Servant (
|
||||||
module Servant.Utils.StaticFiles,
|
module Servant.Utils.StaticFiles,
|
||||||
-- | Useful re-exports
|
-- | Useful re-exports
|
||||||
Proxy(..),
|
Proxy(..),
|
||||||
|
throwError
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Error.Class (throwError)
|
||||||
import Data.Proxy
|
import Data.Proxy
|
||||||
import Servant.API
|
import Servant.API
|
||||||
import Servant.Server
|
import Servant.Server
|
||||||
|
|
Loading…
Reference in a new issue