Skip to content

Commit

Permalink
Introduce a Handler alias for ExceptT ServantErr IO
Browse files Browse the repository at this point in the history
Fixes #434
  • Loading branch information
lcycon committed Apr 12, 2016
1 parent b8422e8 commit 2154699
Show file tree
Hide file tree
Showing 14 changed files with 115 additions and 117 deletions.
21 changes: 10 additions & 11 deletions doc/tutorial/Authentication.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,6 @@ You can use this combinator to protect an API as follows:
module Authentication where
import Control.Monad.Trans.Except (ExceptT)
import Data.Aeson (ToJSON)
import Data.ByteString (ByteString)
import Data.Map (Map, fromList)
Expand All @@ -66,7 +65,7 @@ import Servant.Server (BasicAuthCheck (BasicAuthCheck),
),
Context ((:.), EmptyContext),
err401, err403, errBody, Server,
ServantErr, serveWithContext)
serveWithContext, Handler)
import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,
mkAuthHandler)
import Servant.Server.Experimental.Auth()
Expand Down Expand Up @@ -118,22 +117,22 @@ or dictated the structure of a response (e.g. a `Capture` param is pulled from
the request path). Now consider an API resource protected by basic
authentication. Once the required `WWW-Authenticate` header is checked, we need
to verify the username and password. But how? One solution would be to force an
API author to provide a function of type `BasicAuthData -> ExceptT ServantErr IO User`
API author to provide a function of type `BasicAuthData -> Handler User`
and servant should use this function to authenticate a request. Unfortunately
this didn't work prior to `0.5` because all of servant's machinery was
engineered around the idea that each combinator can extract information from
only the request. We cannot extract the function
`BasicAuthData -> ExceptT ServantErr IO User` from a request! Are we doomed?
`BasicAuthData -> Handler User` from a request! Are we doomed?
Servant `0.5` introduced `Context` to handle this. The type machinery is beyond
the scope of this tutorial, but the idea is simple: provide some data to the
`serve` function, and that data is propagated to the functions that handle each
combinator. Using `Context`, we can supply a function of type
`BasicAuthData -> ExceptT ServantErr IO User` to the `BasicAuth` combinator
`BasicAuthData -> Handler User` to the `BasicAuth` combinator
handler. This will allow the handler to check authentication and return a `User`
to downstream handlers if successful.
In practice we wrap `BasicAuthData -> ExceptT ServantErr IO` into a slightly
In practice we wrap `BasicAuthData -> Handler` into a slightly
different function to better capture the semantics of basic authentication:
``` haskell ignore
Expand Down Expand Up @@ -247,7 +246,7 @@ your feedback!
### What is Generalized Authentication?
**TL;DR**: you throw a tagged `AuthProtect` combinator in front of the endpoints
you want protected and then supply a function `Request -> ExceptT IO ServantErr user`
you want protected and then supply a function `Request -> Handler user`
which we run anytime a request matches a protected endpoint. It precisely solves
the "I just need to protect these endpoints with a function that does some
complicated business logic" and nothing more. Behind the scenes we use a type
Expand All @@ -273,19 +272,19 @@ database = fromList [ ("key1", Account "Anne Briggs")
-- | A method that, when given a password, will return a Account.
-- This is our bespoke (and bad) authentication logic.
lookupAccount :: ByteString -> ExceptT ServantErr IO Account
lookupAccount :: ByteString -> Handler Account
lookupAccount key = case Map.lookup key database of
Nothing -> throwError (err403 { errBody = "Invalid Cookie" })
Just usr -> return usr
```
For generalized authentication, servant exposes the `AuthHandler` type,
which is used to wrap the `Request -> ExceptT IO ServantErr user` logic. Let's
which is used to wrap the `Request -> Handler user` logic. Let's
create a value of type `AuthHandler Request Account` using the above `lookupAccount`
method:
```haskell
-- | The auth handler wraps a function from Request -> ExceptT ServantErr IO Account
-- | The auth handler wraps a function from Request -> Handler Account
-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.
authHandler :: AuthHandler Request Account
authHandler =
Expand Down Expand Up @@ -380,7 +379,7 @@ forward:
2. choose a application-specific data type used by your server when
authentication is successful (in our case this was `User`).
3. Create a value of `AuthHandler Request User` which encapsulates the
authentication logic (`Request -> ExceptT IO ServantErr User`). This function
authentication logic (`Request -> Handler User`). This function
will be executed everytime a request matches a protected route.
4. Provide an instance of the `AuthServerData` type family, specifying your
application-specific data type returned when authentication is successful (in
Expand Down
86 changes: 41 additions & 45 deletions doc/tutorial/Server.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -111,11 +111,11 @@ corresponding API type.
The first thing to know about the `Server` type family is that behind the
scenes it will drive the routing, letting you focus only on the business
logic. The second thing to know is that for each endpoint, your handlers will
by default run in the `ExceptT ServantErr IO` monad. This is overridable very
by default run in the `Handler` monad. This is overridable very
easily, as explained near the end of this guide. Third thing, the type of the
value returned in that monad must be the same as the second argument of the
HTTP method combinator used for the corresponding endpoint. In our case, it
means we must provide a handler of type `ExceptT ServantErr IO [User]`. Well,
means we must provide a handler of type `Handler [User]`. Well,
we have a monad, let's just `return` our list:
``` haskell
Expand Down Expand Up @@ -269,15 +269,15 @@ server3 = position
:<|> hello
:<|> marketing
where position :: Int -> Int -> ExceptT ServantErr IO Position
where position :: Int -> Int -> Handler Position
position x y = return (Position x y)
hello :: Maybe String -> ExceptT ServantErr IO HelloMessage
hello :: Maybe String -> Handler HelloMessage
hello mname = return . HelloMessage $ case mname of
Nothing -> "Hello, anonymous coward"
Just n -> "Hello, " ++ n
marketing :: ClientInfo -> ExceptT ServantErr IO Email
marketing :: ClientInfo -> Handler Email
marketing clientinfo = return (emailForClient clientinfo)
```
Expand Down Expand Up @@ -307,7 +307,7 @@ $ curl -X POST -d '{"clientName":"Alp Mestanogullari", "clientEmail" : "alp@foo.
For reference, here's a list of some combinators from **servant**:
> - `Delete`, `Get`, `Patch`, `Post`, `Put`: these do not become arguments. They provide the return type of handlers, which usually is `ExceptT ServantErr IO <something>`.
> - `Delete`, `Get`, `Patch`, `Post`, `Put`: these do not become arguments. They provide the return type of handlers, which usually is `Handler <something>`.
> - `Capture "something" a` becomes an argument of type `a`.
> - `QueryParam "something" a`, `Header "something" a` all become arguments of type `Maybe a`, because there might be no value at all specified by the client for these.
> - `QueryFlag "something"` gets turned into an argument of type `Bool`.
Expand Down Expand Up @@ -601,11 +601,10 @@ $ curl -H 'Accept: text/html' http://localhost:8081/persons
# or just point your browser to http://localhost:8081/persons
```
## The `ExceptT ServantErr IO` monad
## The `Handler` monad
At the heart of the handlers is the monad they run in, namely `ExceptT
ServantErr IO`
([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).
At the heart of the handlers is the monad they run in, namely `ExceptT ServantErr IO`
([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)), which is aliased as `Handler`.
One might wonder: why this monad? The answer is that it is the
simplest monad with the following properties:
Expand All @@ -621,7 +620,7 @@ Let's recall some definitions.
newtype ExceptT e m a = ExceptT (m (Either e a))
```
In short, this means that a handler of type `ExceptT ServantErr IO a` is simply
In short, this means that a handler of type `Handler a` is simply
equivalent to a computation of type `IO (Either ServantErr a)`, that is, an IO
action that either returns an error or a result.
Expand Down Expand Up @@ -688,7 +687,7 @@ module. If you want to use these values but add a body or some headers, just
use record update syntax:
``` haskell
failingHandler :: ExceptT ServantErr IO ()
failingHandler :: Handler ()
failingHandler = throwError myerr
where myerr :: ServantErr
Expand Down Expand Up @@ -826,11 +825,11 @@ However, you have to be aware that this has an effect on the type of the
corresponding `Server`:
``` haskell ignore
Server UserAPI3 = (Int -> ExceptT ServantErr IO User)
:<|> (Int -> ExceptT ServantErr IO ())
Server UserAPI3 = (Int -> Handler User)
:<|> (Int -> Handler ())
Server UserAPI4 = Int -> ( ExceptT ServantErr IO User
:<|> ExceptT ServantErr IO ()
Server UserAPI4 = Int -> ( Handler User
:<|> Handler ()
)
```
Expand All @@ -842,10 +841,10 @@ computations in `ExceptT`, with no arguments. In other words:
server8 :: Server UserAPI3
server8 = getUser :<|> deleteUser
where getUser :: Int -> ExceptT ServantErr IO User
where getUser :: Int -> Handler User
getUser _userid = error "..."
deleteUser :: Int -> ExceptT ServantErr IO ()
deleteUser :: Int -> Handler ()
deleteUser _userid = error "..."
-- notice how getUser and deleteUser
Expand All @@ -854,10 +853,10 @@ server8 = getUser :<|> deleteUser
server9 :: Server UserAPI4
server9 userid = getUser userid :<|> deleteUser userid
where getUser :: Int -> ExceptT ServantErr IO User
where getUser :: Int -> Handler User
getUser = error "..."
deleteUser :: Int -> ExceptT ServantErr IO ()
deleteUser :: Int -> Handler ()
deleteUser = error "..."
```
Expand Down Expand Up @@ -905,23 +904,23 @@ type UsersAPI =
usersServer :: Server UsersAPI
usersServer = getUsers :<|> newUser :<|> userOperations
where getUsers :: ExceptT ServantErr IO [User]
where getUsers :: Handler [User]
getUsers = error "..."
newUser :: User -> ExceptT ServantErr IO ()
newUser :: User -> Handler ()
newUser = error "..."
userOperations userid =
viewUser userid :<|> updateUser userid :<|> deleteUser userid
where
viewUser :: Int -> ExceptT ServantErr IO User
viewUser :: Int -> Handler User
viewUser = error "..."
updateUser :: Int -> User -> ExceptT ServantErr IO ()
updateUser :: Int -> User -> Handler ()
updateUser = error "..."
deleteUser :: Int -> ExceptT ServantErr IO ()
deleteUser :: Int -> Handler ()
deleteUser = error "..."
```
Expand All @@ -940,23 +939,23 @@ data Product = Product { productId :: Int }
productsServer :: Server ProductsAPI
productsServer = getProducts :<|> newProduct :<|> productOperations
where getProducts :: ExceptT ServantErr IO [Product]
where getProducts :: Handler [Product]
getProducts = error "..."
newProduct :: Product -> ExceptT ServantErr IO ()
newProduct :: Product -> Handler ()
newProduct = error "..."
productOperations productid =
viewProduct productid :<|> updateProduct productid :<|> deleteProduct productid
where
viewProduct :: Int -> ExceptT ServantErr IO Product
viewProduct :: Int -> Handler Product
viewProduct = error "..."
updateProduct :: Int -> Product -> ExceptT ServantErr IO ()
updateProduct :: Int -> Product -> Handler ()
updateProduct = error "..."
deleteProduct :: Int -> ExceptT ServantErr IO ()
deleteProduct :: Int -> Handler ()
deleteProduct = error "..."
```
Expand Down Expand Up @@ -985,11 +984,11 @@ type APIFor a i =
-- Build the appropriate 'Server'
-- given the handlers of the right type.
serverFor :: ExceptT ServantErr IO [a] -- handler for listing of 'a's
-> (a -> ExceptT ServantErr IO ()) -- handler for adding an 'a'
-> (i -> ExceptT ServantErr IO a) -- handler for viewing an 'a' given its identifier of type 'i'
-> (i -> a -> ExceptT ServantErr IO ()) -- updating an 'a' with given id
-> (i -> ExceptT ServantErr IO ()) -- deleting an 'a' given its id
serverFor :: Handler [a] -- handler for listing of 'a's
-> (a -> Handler ()) -- handler for adding an 'a'
-> (i -> Handler a) -- handler for viewing an 'a' given its identifier of type 'i'
-> (i -> a -> Handler ()) -- updating an 'a' with given id
-> (i -> Handler ()) -- deleting an 'a' given its id
-> Server (APIFor a i)
serverFor = error "..."
-- implementation left as an exercise. contact us on IRC
Expand All @@ -998,12 +997,11 @@ serverFor = error "..."
## Using another monad for your handlers
Remember how `Server` turns combinators for HTTP methods into `ExceptT
ServantErr IO`? Well, actually, there's more to that. `Server` is actually a
Remember how `Server` turns combinators for HTTP methods into `Handler`? Well, actually, there's more to that. `Server` is actually a
simple type synonym.
``` haskell ignore
type Server api = ServerT api (ExceptT ServantErr IO)
type Server api = ServerT api Handler
```
`ServerT` is the actual type family that computes the required types for the
Expand Down Expand Up @@ -1036,12 +1034,11 @@ listToMaybeNat = Nat listToMaybe -- from Data.Maybe
(`Nat` comes from "natural transformation", in case you're wondering.)
So if you want to write handlers using another monad/type than `ExceptT
ServantErr IO`, say the `Reader String` monad, the first thing you have to
So if you want to write handlers using another monad/type than `Handler`, say the `Reader String` monad, the first thing you have to
prepare is a function:
``` haskell ignore
readerToHandler :: Reader String :~> ExceptT ServantErr IO
readerToHandler :: Reader String :~> Handler
```
Let's start with `readerToHandler'`. We obviously have to run the `Reader`
Expand All @@ -1050,10 +1047,10 @@ from that and can then just `return` it into `ExceptT`. We can then just wrap
that function with the `Nat` constructor to make it have the fancier type.
``` haskell
readerToHandler' :: forall a. Reader String a -> ExceptT ServantErr IO a
readerToHandler' :: forall a. Reader String a -> Handler a
readerToHandler' r = return (runReader r "hi")
readerToHandler :: Reader String :~> ExceptT ServantErr IO
readerToHandler :: Reader String :~> Handler
readerToHandler = Nat readerToHandler'
```
Expand All @@ -1077,8 +1074,7 @@ readerServerT = a :<|> b
```
We unfortunately can't use `readerServerT` as an argument of `serve`, because
`serve` wants a `Server ReaderAPI`, i.e., with handlers running in `ExceptT
ServantErr IO`. But there's a simple solution to this.
`serve` wants a `Server ReaderAPI`, i.e., with handlers running in `Handler`. But there's a simple solution to this.
### Enter `enter`
Expand Down
2 changes: 1 addition & 1 deletion servant-client/test/Servant/ClientSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -355,7 +355,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

data WrappedApi where
WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,
WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,
HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>
Proxy api -> WrappedApi

Expand Down
4 changes: 2 additions & 2 deletions servant-mock/src/Servant/Mock.hs
Original file line number Diff line number Diff line change
Expand Up @@ -97,8 +97,8 @@ class HasServer api context => HasMock api context where
-- actually "means" 2 request handlers, of the following types:
--
-- @
-- getUser :: ExceptT ServantErr IO User
-- getBook :: ExceptT ServantErr IO Book
-- getUser :: Handler User
-- getBook :: Handler Book
-- @
--
-- So under the hood, 'mock' uses the 'IO' bit to generate
Expand Down
2 changes: 1 addition & 1 deletion servant-server/example/greet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,7 @@ testApi = Proxy
-- There's one handler per endpoint, which, just like in the type
-- that represents the API, are glued together using :<|>.
--
-- Each handler runs in the 'ExceptT ServantErr IO' monad.
-- Each handler runs in the 'Handler' monad.
server :: Server TestApi
server = helloH :<|> postGreetH :<|> deleteGreetH

Expand Down
1 change: 1 addition & 0 deletions servant-server/src/Servant/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@ module Servant.Server
, -- * Handlers for all standard combinators
HasServer(..)
, Server
, Handler

-- * Debugging the server layout
, layout
Expand Down
9 changes: 4 additions & 5 deletions servant-server/src/Servant/Server/Experimental/Auth.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,7 @@

module Servant.Server.Experimental.Auth where

import Control.Monad.Trans.Except (ExceptT,
runExceptT)
import Control.Monad.Trans.Except (runExceptT)
import Data.Proxy (Proxy (Proxy))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
Expand All @@ -28,7 +27,7 @@ import Servant.Server.Internal (HasContextEntry,
import Servant.Server.Internal.Router (Router' (WithRequest))
import Servant.Server.Internal.RoutingApplication (RouteResult (FailFatal, Route),
addAuthCheck)
import Servant.Server.Internal.ServantErr (ServantErr)
import Servant.Server.Internal.ServantErr (ServantErr, Handler)

-- * General Auth

Expand All @@ -42,11 +41,11 @@ type family AuthServerData a :: *
--
-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
newtype AuthHandler r usr = AuthHandler
{ unAuthHandler :: r -> ExceptT ServantErr IO usr }
{ unAuthHandler :: r -> Handler usr }
deriving (Generic, Typeable)

-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
mkAuthHandler :: (r -> ExceptT ServantErr IO usr) -> AuthHandler r usr
mkAuthHandler :: (r -> Handler usr) -> AuthHandler r usr
mkAuthHandler = AuthHandler

-- | Known orphan instance.
Expand Down

0 comments on commit 2154699

Please sign in to comment.