2154699 · servant · git.iko.soy

git.iko.soy/servant

Introduce a `Handler` alias for `ExceptT ServantErr IO`

Fixes #434

commit21546991af2a62d834faf766c83c9095554330ca authorLuke Cycon <luke@lukecycon.com> dateThu 7 Apr 2016, 14:34 (11 years ago) parentb8422e8

14 files changed+115−117

compare with master

unifiedsplit

doc/tutorial/Authentication.lhs+10−11 doc/tutorial/Server.lhs+41−45 servant-client/test/Servant/ClientSpec.hs+1−1 servant-mock/src/Servant/Mock.hs+2−2 servant-server/example/greet.hs+1−1 servant-server/src/Servant/Server.hs+1 servant-server/src/Servant/Server/Experimental/Auth.hs+4−5 servant-server/src/Servant/Server/Internal.hs+9−10 servant-server/src/Servant/Server/Internal/RoutingApplication.hs+2−2 servant-server/src/Servant/Server/Internal/ServantErr.hs+33−30 servant-server/test/Servant/Server/Internal/EnterSpec.hs+1−1 servant-server/test/Servant/Server/StreamingSpec.hs+2−2 servant-server/test/Servant/Server/UsingContextSpec.hs+1−1 servant-server/test/Servant/ServerSpec.hs+7−6

doc/tutorial/Authentication.lhs+10−11

@@ -44,7 +44,6 @@ You can use this combinator to protect an API as follows:

4444

4545module Authentication where

4646

47−import Control.Monad.Trans.Except (ExceptT)

4847import Data.Aeson (ToJSON)

4948import Data.ByteString (ByteString)

5049import Data.Map (Map, fromList)

@@ -66,7 +65,7 @@ import Servant.Server (BasicAuthCheck (BasicAuthCheck),

6665 ),

6766 Context ((:.), EmptyContext),

6867 err401, err403, errBody, Server,

69− ServantErr, serveWithContext)

68+ serveWithContext, Handler)

7069import Servant.Server.Experimental.Auth (AuthHandler, AuthServerData,

7170 mkAuthHandler)

7271import Servant.Server.Experimental.Auth()

@@ -118,22 +117,22 @@ or dictated the structure of a response (e.g. a `Capture` param is pulled from

118117the request path). Now consider an API resource protected by basic

119118authentication. Once the required `WWW-Authenticate` header is checked, we need

120119to verify the username and password. But how? One solution would be to force an

121−API author to provide a function of type `BasicAuthData -> ExceptT ServantErr IO User`

120+API author to provide a function of type `BasicAuthData -> Handler User`

122121and servant should use this function to authenticate a request. Unfortunately

123122this didn't work prior to `0.5` because all of servant's machinery was

124123engineered around the idea that each combinator can extract information from

125124only the request. We cannot extract the function

126−`BasicAuthData -> ExceptT ServantErr IO User` from a request! Are we doomed?

125+`BasicAuthData -> Handler User` from a request! Are we doomed?

127126

128127Servant `0.5` introduced `Context` to handle this. The type machinery is beyond

129128the scope of this tutorial, but the idea is simple: provide some data to the

130129`serve` function, and that data is propagated to the functions that handle each

131130combinator. Using `Context`, we can supply a function of type

132−`BasicAuthData -> ExceptT ServantErr IO User` to the `BasicAuth` combinator

131+`BasicAuthData -> Handler User` to the `BasicAuth` combinator

133132handler. This will allow the handler to check authentication and return a `User`

134133to downstream handlers if successful.

135134

136−In practice we wrap `BasicAuthData -> ExceptT ServantErr IO` into a slightly

135+In practice we wrap `BasicAuthData -> Handler` into a slightly

137136different function to better capture the semantics of basic authentication:

138137

139138``` haskell ignore

@@ -247,7 +246,7 @@ your feedback!

247246### What is Generalized Authentication?

248247

249248**TL;DR**: you throw a tagged `AuthProtect` combinator in front of the endpoints

250−you want protected and then supply a function `Request -> ExceptT IO ServantErr user`

249+you want protected and then supply a function `Request -> Handler user`

251250which we run anytime a request matches a protected endpoint. It precisely solves

252251the "I just need to protect these endpoints with a function that does some

253252complicated business logic" and nothing more. Behind the scenes we use a type

@@ -273,19 +272,19 @@ database = fromList [ ("key1", Account "Anne Briggs")

273272

274273-- | A method that, when given a password, will return a Account.

275274-- This is our bespoke (and bad) authentication logic.

276−lookupAccount :: ByteString -> ExceptT ServantErr IO Account

275+lookupAccount :: ByteString -> Handler Account

277276lookupAccount key = case Map.lookup key database of

278277 Nothing -> throwError (err403 { errBody = "Invalid Cookie" })

279278 Just usr -> return usr

280279```

281280

282281For generalized authentication, servant exposes the `AuthHandler` type,

283−which is used to wrap the `Request -> ExceptT IO ServantErr user` logic. Let's

282+which is used to wrap the `Request -> Handler user` logic. Let's

284283create a value of type `AuthHandler Request Account` using the above `lookupAccount`

285284method:

286285

287286```haskell

288−-- | The auth handler wraps a function from Request -> ExceptT ServantErr IO Account

287+-- | The auth handler wraps a function from Request -> Handler Account

289288-- we look for a Cookie and pass the value of the cookie to `lookupAccount`.

290289authHandler :: AuthHandler Request Account

291290authHandler =

@@ -380,7 +379,7 @@ forward:

3803792. choose a application-specific data type used by your server when

381380authentication is successful (in our case this was `User`).

3823813. Create a value of `AuthHandler Request User` which encapsulates the

383−authentication logic (`Request -> ExceptT IO ServantErr User`). This function

382+authentication logic (`Request -> Handler User`). This function

384383will be executed everytime a request matches a protected route.

3853844. Provide an instance of the `AuthServerData` type family, specifying your

386385application-specific data type returned when authentication is successful (in

doc/tutorial/Server.lhs+41−45

@@ -111,11 +111,11 @@ corresponding API type.

111111The first thing to know about the `Server` type family is that behind the

112112scenes it will drive the routing, letting you focus only on the business

113113logic. The second thing to know is that for each endpoint, your handlers will

114−by default run in the `ExceptT ServantErr IO` monad. This is overridable very

114+by default run in the `Handler` monad. This is overridable very

115115easily, as explained near the end of this guide. Third thing, the type of the

116116value returned in that monad must be the same as the second argument of the

117117HTTP method combinator used for the corresponding endpoint. In our case, it

118−means we must provide a handler of type `ExceptT ServantErr IO [User]`. Well,

118+means we must provide a handler of type `Handler [User]`. Well,

119119we have a monad, let's just `return` our list:

120120

121121``` haskell

@@ -269,15 +269,15 @@ server3 = position

269269 :<|> hello

270270 :<|> marketing

271271

272− where position :: Int -> Int -> ExceptT ServantErr IO Position

272+ where position :: Int -> Int -> Handler Position

273273 position x y = return (Position x y)

274274

275− hello :: Maybe String -> ExceptT ServantErr IO HelloMessage

275+ hello :: Maybe String -> Handler HelloMessage

276276 hello mname = return . HelloMessage $ case mname of

277277 Nothing -> "Hello, anonymous coward"

278278 Just n -> "Hello, " ++ n

279279

280− marketing :: ClientInfo -> ExceptT ServantErr IO Email

280+ marketing :: ClientInfo -> Handler Email

281281 marketing clientinfo = return (emailForClient clientinfo)

282282```

283283

@@ -307,7 +307,7 @@ $ curl -X POST -d '{"clientName":"Alp Mestanogullari", "clientEmail" : "alp@foo.

307307

308308For reference, here's a list of some combinators from **servant**:

309309

310− > - `Delete`, `Get`, `Patch`, `Post`, `Put`: these do not become arguments. They provide the return type of handlers, which usually is `ExceptT ServantErr IO <something>`.

310+ > - `Delete`, `Get`, `Patch`, `Post`, `Put`: these do not become arguments. They provide the return type of handlers, which usually is `Handler <something>`.

311311 > - `Capture "something" a` becomes an argument of type `a`.

312312 > - `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.

313313 > - `QueryFlag "something"` gets turned into an argument of type `Bool`.

@@ -601,11 +601,10 @@ $ curl -H 'Accept: text/html' http://localhost:8081/persons

601601# or just point your browser to http://localhost:8081/persons

602602```

603603

604−## The `ExceptT ServantErr IO` monad

604+## The `Handler` monad

605605

606−At the heart of the handlers is the monad they run in, namely `ExceptT

607−ServantErr IO`

608−([haddock documentation for `ExceptT`](http://hackage.haskell.org/package/mtl-2.2.1/docs/Control-Monad-Except.html#t:ExceptT)).

606+At the heart of the handlers is the monad they run in, namely `ExceptT ServantErr IO`

607+([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`.

609608One might wonder: why this monad? The answer is that it is the

610609simplest monad with the following properties:

611610

@@ -621,7 +620,7 @@ Let's recall some definitions.

621620newtype ExceptT e m a = ExceptT (m (Either e a))

622621```

623622

624−In short, this means that a handler of type `ExceptT ServantErr IO a` is simply

623+In short, this means that a handler of type `Handler a` is simply

625624equivalent to a computation of type `IO (Either ServantErr a)`, that is, an IO

626625action that either returns an error or a result.

627626

@@ -688,7 +687,7 @@ module. If you want to use these values but add a body or some headers, just

688687use record update syntax:

689688

690689``` haskell

691−failingHandler :: ExceptT ServantErr IO ()

690+failingHandler :: Handler ()

692691failingHandler = throwError myerr

693692

694693 where myerr :: ServantErr

@@ -826,11 +825,11 @@ However, you have to be aware that this has an effect on the type of the

826825corresponding `Server`:

827826

828827``` haskell ignore

829−Server UserAPI3 = (Int -> ExceptT ServantErr IO User)

830− :<|> (Int -> ExceptT ServantErr IO ())

828+Server UserAPI3 = (Int -> Handler User)

829+ :<|> (Int -> Handler ())

831830

832−Server UserAPI4 = Int -> ( ExceptT ServantErr IO User

833− :<|> ExceptT ServantErr IO ()

831+Server UserAPI4 = Int -> ( Handler User

832+ :<|> Handler ()

834833 )

835834```

836835

@@ -842,10 +841,10 @@ computations in `ExceptT`, with no arguments. In other words:

842841server8 :: Server UserAPI3

843842server8 = getUser :<|> deleteUser

844843

845− where getUser :: Int -> ExceptT ServantErr IO User

844+ where getUser :: Int -> Handler User

846845 getUser _userid = error "..."

847846

848− deleteUser :: Int -> ExceptT ServantErr IO ()

847+ deleteUser :: Int -> Handler ()

849848 deleteUser _userid = error "..."

850849

851850-- notice how getUser and deleteUser

@@ -854,10 +853,10 @@ server8 = getUser :<|> deleteUser

854853server9 :: Server UserAPI4

855854server9 userid = getUser userid :<|> deleteUser userid

856855

857− where getUser :: Int -> ExceptT ServantErr IO User

856+ where getUser :: Int -> Handler User

858857 getUser = error "..."

859858

860− deleteUser :: Int -> ExceptT ServantErr IO ()

859+ deleteUser :: Int -> Handler ()

861860 deleteUser = error "..."

862861```

863862

@@ -905,23 +904,23 @@ type UsersAPI =

905904usersServer :: Server UsersAPI

906905usersServer = getUsers :<|> newUser :<|> userOperations

907906

908− where getUsers :: ExceptT ServantErr IO [User]

907+ where getUsers :: Handler [User]

909908 getUsers = error "..."

910909

911− newUser :: User -> ExceptT ServantErr IO ()

910+ newUser :: User -> Handler ()

912911 newUser = error "..."

913912

914913 userOperations userid =

915914 viewUser userid :<|> updateUser userid :<|> deleteUser userid

916915

917916 where

918− viewUser :: Int -> ExceptT ServantErr IO User

917+ viewUser :: Int -> Handler User

919918 viewUser = error "..."

920919

921− updateUser :: Int -> User -> ExceptT ServantErr IO ()

920+ updateUser :: Int -> User -> Handler ()

922921 updateUser = error "..."

923922

924− deleteUser :: Int -> ExceptT ServantErr IO ()

923+ deleteUser :: Int -> Handler ()

925924 deleteUser = error "..."

926925```

927926

@@ -940,23 +939,23 @@ data Product = Product { productId :: Int }

940939productsServer :: Server ProductsAPI

941940productsServer = getProducts :<|> newProduct :<|> productOperations

942941

943− where getProducts :: ExceptT ServantErr IO [Product]

942+ where getProducts :: Handler [Product]

944943 getProducts = error "..."

945944

946− newProduct :: Product -> ExceptT ServantErr IO ()

945+ newProduct :: Product -> Handler ()

947946 newProduct = error "..."

948947

949948 productOperations productid =

950949 viewProduct productid :<|> updateProduct productid :<|> deleteProduct productid

951950

952951 where

953− viewProduct :: Int -> ExceptT ServantErr IO Product

952+ viewProduct :: Int -> Handler Product

954953 viewProduct = error "..."

955954

956− updateProduct :: Int -> Product -> ExceptT ServantErr IO ()

955+ updateProduct :: Int -> Product -> Handler ()

957956 updateProduct = error "..."

958957

959− deleteProduct :: Int -> ExceptT ServantErr IO ()

958+ deleteProduct :: Int -> Handler ()

960959 deleteProduct = error "..."

961960```

962961

@@ -985,11 +984,11 @@ type APIFor a i =

985984

986985-- Build the appropriate 'Server'

987986-- given the handlers of the right type.

988−serverFor :: ExceptT ServantErr IO [a] -- handler for listing of 'a's

989− -> (a -> ExceptT ServantErr IO ()) -- handler for adding an 'a'

990− -> (i -> ExceptT ServantErr IO a) -- handler for viewing an 'a' given its identifier of type 'i'

991− -> (i -> a -> ExceptT ServantErr IO ()) -- updating an 'a' with given id

992− -> (i -> ExceptT ServantErr IO ()) -- deleting an 'a' given its id

987+serverFor :: Handler [a] -- handler for listing of 'a's

988+ -> (a -> Handler ()) -- handler for adding an 'a'

989+ -> (i -> Handler a) -- handler for viewing an 'a' given its identifier of type 'i'

990+ -> (i -> a -> Handler ()) -- updating an 'a' with given id

991+ -> (i -> Handler ()) -- deleting an 'a' given its id

993992 -> Server (APIFor a i)

994993serverFor = error "..."

995994-- implementation left as an exercise. contact us on IRC

@@ -998,12 +997,11 @@ serverFor = error "..."

998997

999998## Using another monad for your handlers

1000999

1001−Remember how `Server` turns combinators for HTTP methods into `ExceptT

1002−ServantErr IO`? Well, actually, there's more to that. `Server` is actually a

1000+Remember how `Server` turns combinators for HTTP methods into `Handler`? Well, actually, there's more to that. `Server` is actually a

10031001simple type synonym.

10041002

10051003``` haskell ignore

1006−type Server api = ServerT api (ExceptT ServantErr IO)

1004+type Server api = ServerT api Handler

10071005```

10081006

10091007`ServerT` is the actual type family that computes the required types for the

@@ -1036,12 +1034,11 @@ listToMaybeNat = Nat listToMaybe -- from Data.Maybe

10361034

10371035(`Nat` comes from "natural transformation", in case you're wondering.)

10381036

1039−So if you want to write handlers using another monad/type than `ExceptT

1040−ServantErr IO`, say the `Reader String` monad, the first thing you have to

1037+So if you want to write handlers using another monad/type than `Handler`, say the `Reader String` monad, the first thing you have to

10411038prepare is a function:

10421039

10431040``` haskell ignore

1044−readerToHandler :: Reader String :~> ExceptT ServantErr IO

1041+readerToHandler :: Reader String :~> Handler

10451042```

10461043

10471044Let's start with `readerToHandler'`. We obviously have to run the `Reader`

@@ -1050,10 +1047,10 @@ from that and can then just `return` it into `ExceptT`. We can then just wrap

10501047that function with the `Nat` constructor to make it have the fancier type.

10511048

10521049``` haskell

1053−readerToHandler' :: forall a. Reader String a -> ExceptT ServantErr IO a

1050+readerToHandler' :: forall a. Reader String a -> Handler a

10541051readerToHandler' r = return (runReader r "hi")

10551052

1056−readerToHandler :: Reader String :~> ExceptT ServantErr IO

1053+readerToHandler :: Reader String :~> Handler

10571054readerToHandler = Nat readerToHandler'

10581055```

10591056

@@ -1077,8 +1074,7 @@ readerServerT = a :<|> b

10771074```

10781075

10791076We unfortunately can't use `readerServerT` as an argument of `serve`, because

1080−`serve` wants a `Server ReaderAPI`, i.e., with handlers running in `ExceptT

1081−ServantErr IO`. But there's a simple solution to this.

1077+`serve` wants a `Server ReaderAPI`, i.e., with handlers running in `Handler`. But there's a simple solution to this.

10821078

10831079### Enter `enter`

10841080

servant-client/test/Servant/ClientSpec.hs+1−1

@@ -355,7 +355,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do

355355 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

356356

357357data WrappedApi where

358− WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,

358+ WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,

359359 HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>

360360 Proxy api -> WrappedApi

361361

servant-mock/src/Servant/Mock.hs+2−2

@@ -97,8 +97,8 @@ class HasServer api context => HasMock api context where

9797 -- actually "means" 2 request handlers, of the following types:

9898 --

9999 -- @

100− -- getUser :: ExceptT ServantErr IO User

101− -- getBook :: ExceptT ServantErr IO Book

100+ -- getUser :: Handler User

101+ -- getBook :: Handler Book

102102 -- @

103103 --

104104 -- So under the hood, 'mock' uses the 'IO' bit to generate

servant-server/example/greet.hs+1−1

@@ -44,7 +44,7 @@ testApi = Proxy

4444-- There's one handler per endpoint, which, just like in the type

4545-- that represents the API, are glued together using :<|>.

4646--

47−-- Each handler runs in the 'ExceptT ServantErr IO' monad.

47+-- Each handler runs in the 'Handler' monad.

4848server :: Server TestApi

4949server = helloH :<|> postGreetH :<|> deleteGreetH

5050

servant-server/src/Servant/Server.hs+1

@@ -17,6 +17,7 @@ module Servant.Server

1717 , -- * Handlers for all standard combinators

1818 HasServer(..)

1919 , Server

20+ , Handler

2021

2122 -- * Debugging the server layout

2223 , layout

servant-server/src/Servant/Server/Experimental/Auth.hs+4−5

@@ -12,8 +12,7 @@

1212

1313module Servant.Server.Experimental.Auth where

1414

15−import Control.Monad.Trans.Except (ExceptT,

16− runExceptT)

15+import Control.Monad.Trans.Except (runExceptT)

1716import Data.Proxy (Proxy (Proxy))

1817import Data.Typeable (Typeable)

1918import GHC.Generics (Generic)

@@ -28,7 +27,7 @@ import Servant.Server.Internal (HasContextEntry,

2827import Servant.Server.Internal.Router (Router' (WithRequest))

2928import Servant.Server.Internal.RoutingApplication (RouteResult (FailFatal, Route),

3029 addAuthCheck)

31−import Servant.Server.Internal.ServantErr (ServantErr)

30+import Servant.Server.Internal.ServantErr (ServantErr, Handler)

3231

3332-- * General Auth

3433

@@ -42,11 +41,11 @@ type family AuthServerData a :: *

4241--

4342-- NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

4443newtype AuthHandler r usr = AuthHandler

45− { unAuthHandler :: r -> ExceptT ServantErr IO usr }

44+ { unAuthHandler :: r -> Handler usr }

4645 deriving (Generic, Typeable)

4746

4847-- | NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE

49−mkAuthHandler :: (r -> ExceptT ServantErr IO usr) -> AuthHandler r usr

48+mkAuthHandler :: (r -> Handler usr) -> AuthHandler r usr

5049mkAuthHandler = AuthHandler

5150

5251-- | Known orphan instance.

servant-server/src/Servant/Server/Internal.hs+9−10

@@ -22,7 +22,6 @@ module Servant.Server.Internal

2222 , module Servant.Server.Internal.ServantErr

2323 ) where

2424

25−import Control.Monad.Trans.Except (ExceptT)

2625import qualified Data.ByteString as B

2726import qualified Data.ByteString.Char8 as BC8

2827import qualified Data.ByteString.Lazy as BL

@@ -73,7 +72,7 @@ class HasServer layout context where

7372

7473 route :: Proxy layout -> Context context -> Delayed (Server layout) -> Router

7574

76−type Server layout = ServerT layout (ExceptT ServantErr IO)

75+type Server layout = ServerT layout Handler

7776

7877-- * Instances

7978

@@ -112,7 +111,7 @@ instance (HasServer a context, HasServer b context) => HasServer (a :<|> b) cont

112111-- >

113112-- > server :: Server MyApi

114113-- > server = getBook

115−-- > where getBook :: Text -> ExceptT ServantErr IO Book

114+-- > where getBook :: Text -> Handler Book

116115-- > getBook isbn = ...

117116instance (KnownSymbol capture, FromHttpApiData a, HasServer sublayout context)

118117 => HasServer (Capture capture a :> sublayout) context where

@@ -157,7 +156,7 @@ acceptCheck proxy accH

157156

158157methodRouter :: (AllCTRender ctypes a)

159158 => Method -> Proxy ctypes -> Status

160− -> Delayed (ExceptT ServantErr IO a)

159+ -> Delayed (Handler a)

161160 -> Router

162161methodRouter method proxy status action = leafRouter route'

163162 where

@@ -171,7 +170,7 @@ methodRouter method proxy status action = leafRouter route'

171170

172171methodRouterHeaders :: (GetHeaders (Headers h v), AllCTRender ctypes v)

173172 => Method -> Proxy ctypes -> Status

174− -> Delayed (ExceptT ServantErr IO (Headers h v))

173+ -> Delayed (Handler (Headers h v))

175174 -> Router

176175methodRouterHeaders method proxy status action = leafRouter route'

177176 where

@@ -223,7 +222,7 @@ instance OVERLAPPING_

223222-- >

224223-- > server :: Server MyApi

225224-- > server = viewReferer

226−-- > where viewReferer :: Referer -> ExceptT ServantErr IO referer

225+-- > where viewReferer :: Referer -> Handler referer

227226-- > viewReferer referer = return referer

228227instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)

229228 => HasServer (Header sym a :> sublayout) context where

@@ -254,7 +253,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)

254253-- >

255254-- > server :: Server MyApi

256255-- > server = getBooksBy

257−-- > where getBooksBy :: Maybe Text -> ExceptT ServantErr IO [Book]

256+-- > where getBooksBy :: Maybe Text -> Handler [Book]

258257-- > getBooksBy Nothing = ...return all books...

259258-- > getBooksBy (Just author) = ...return books by the given author...

260259instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)

@@ -291,7 +290,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)

291290-- >

292291-- > server :: Server MyApi

293292-- > server = getBooksBy

294−-- > where getBooksBy :: [Text] -> ExceptT ServantErr IO [Book]

293+-- > where getBooksBy :: [Text] -> Handler [Book]

295294-- > getBooksBy authors = ...return all books by these authors...

296295instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)

297296 => HasServer (QueryParams sym a :> sublayout) context where

@@ -322,7 +321,7 @@ instance (KnownSymbol sym, FromHttpApiData a, HasServer sublayout context)

322321-- >

323322-- > server :: Server MyApi

324323-- > server = getBooks

325−-- > where getBooks :: Bool -> ExceptT ServantErr IO [Book]

324+-- > where getBooks :: Bool -> Handler [Book]

326325-- > getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument...

327326instance (KnownSymbol sym, HasServer sublayout context)

328327 => HasServer (QueryFlag sym :> sublayout) context where

@@ -379,7 +378,7 @@ instance HasServer Raw context where

379378-- >

380379-- > server :: Server MyApi

381380-- > server = postBook

382−-- > where postBook :: Book -> ExceptT ServantErr IO Book

381+-- > where postBook :: Book -> Handler Book

383382-- > postBook book = ...insert into your db...

384383instance ( AllCTUnrender list a, HasServer sublayout context

385384 ) => HasServer (ReqBody list a :> sublayout) context where

servant-server/src/Servant/Server/Internal/RoutingApplication.hs+2−2

@@ -8,7 +8,7 @@

88{-# LANGUAGE StandaloneDeriving #-}

99module Servant.Server.Internal.RoutingApplication where

1010

11−import Control.Monad.Trans.Except (ExceptT, runExceptT)

11+import Control.Monad.Trans.Except (runExceptT)

1212import Network.Wai (Application, Request,

1313 Response, ResponseReceived)

1414import Prelude ()

@@ -222,7 +222,7 @@ runDelayed Delayed{..} =

222222-- Takes a continuation that lets us send a response.

223223-- Also takes a continuation for how to turn the

224224-- result of the delayed server into a response.

225−runAction :: Delayed (ExceptT ServantErr IO a)

225+runAction :: Delayed (Handler a)

226226 -> (RouteResult Response -> IO r)

227227 -> (a -> RouteResult Response)

228228 -> IO r

servant-server/src/Servant/Server/Internal/ServantErr.hs+33−30

@@ -4,6 +4,7 @@

44module Servant.Server.Internal.ServantErr where

66import Control.Exception (Exception)

7+import Control.Monad.Trans.Except (ExceptT)

78import qualified Data.ByteString.Char8 as BS

89import qualified Data.ByteString.Lazy as LBS

910import Data.Typeable (Typeable)

@@ -18,6 +19,8 @@ data ServantErr = ServantErr { errHTTPCode :: Int

1819

1920instance Exception ServantErr

2021

22+type Handler = ExceptT ServantErr IO

23+

2124responseServantErr :: ServantErr -> Response

2225responseServantErr ServantErr{..} = responseLBS status errHeaders errBody

2326 where

@@ -27,7 +30,7 @@ responseServantErr ServantErr{..} = responseLBS status errHeaders errBody

2730--

2831-- Example:

2932--

30−-- > failingHandler :: ExceptT ServantErr IO ()

33+-- > failingHandler :: Handler ()

3134-- > failingHandler = throwErr $ err300 { errBody = "I can't choose." }

3235--

3336err300 :: ServantErr

@@ -41,7 +44,7 @@ err300 = ServantErr { errHTTPCode = 300

4144--

4245-- Example:

4346--

44−-- > failingHandler :: ExceptT ServantErr IO ()

47+-- > failingHandler :: Handler ()

4548-- > failingHandler = throwErr err301

4649--

4750err301 :: ServantErr

@@ -55,7 +58,7 @@ err301 = ServantErr { errHTTPCode = 301

5558--

5659-- Example:

5760--

58−-- > failingHandler :: ExceptT ServantErr IO ()

61+-- > failingHandler :: Handler ()

5962-- > failingHandler = throwErr err302

6063--

6164err302 :: ServantErr

@@ -69,7 +72,7 @@ err302 = ServantErr { errHTTPCode = 302

6972--

7073-- Example:

7174--

72−-- > failingHandler :: ExceptT ServantErr IO ()

75+-- > failingHandler :: Handler ()

7376-- > failingHandler = throwErr err303

7477--

7578err303 :: ServantErr

@@ -83,7 +86,7 @@ err303 = ServantErr { errHTTPCode = 303

8386--

8487-- Example:

8588--

86−-- > failingHandler :: ExceptT ServantErr IO ()

89+-- > failingHandler :: Handler ()

8790-- > failingHandler = throwErr err304

8891--

8992err304 :: ServantErr

@@ -97,7 +100,7 @@ err304 = ServantErr { errHTTPCode = 304

97100--

98101-- Example:

99102--

100−-- > failingHandler :: ExceptT ServantErr IO ()

103+-- > failingHandler :: Handler ()

101104-- > failingHandler = throwErr err305

102105--

103106err305 :: ServantErr

@@ -111,7 +114,7 @@ err305 = ServantErr { errHTTPCode = 305

111114--

112115-- Example:

113116--

114−-- > failingHandler :: ExceptT ServantErr IO ()

117+-- > failingHandler :: Handler ()

115118-- > failingHandler = throwErr err307

116119--

117120err307 :: ServantErr

@@ -125,7 +128,7 @@ err307 = ServantErr { errHTTPCode = 307

125128--

126129-- Example:

127130--

128−-- > failingHandler :: ExceptT ServantErr IO ()

131+-- > failingHandler :: Handler ()

129132-- > failingHandler = throwErr $ err400 { errBody = "Your request makes no sense to me." }

130133--

131134err400 :: ServantErr

@@ -139,7 +142,7 @@ err400 = ServantErr { errHTTPCode = 400

139142--

140143-- Example:

141144--

142−-- > failingHandler :: ExceptT ServantErr IO ()

145+-- > failingHandler :: Handler ()

143146-- > failingHandler = throwErr $ err401 { errBody = "Your credentials are invalid." }

144147--

145148err401 :: ServantErr

@@ -153,7 +156,7 @@ err401 = ServantErr { errHTTPCode = 401

153156--

154157-- Example:

155158--

156−-- > failingHandler :: ExceptT ServantErr IO ()

159+-- > failingHandler :: Handler ()

157160-- > failingHandler = throwErr $ err402 { errBody = "You have 0 credits. Please give me $$$." }

158161--

159162err402 :: ServantErr

@@ -167,7 +170,7 @@ err402 = ServantErr { errHTTPCode = 402

167170--

168171-- Example:

169172--

170−-- > failingHandler :: ExceptT ServantErr IO ()

173+-- > failingHandler :: Handler ()

171174-- > failingHandler = throwErr $ err403 { errBody = "Please login first." }

172175--

173176err403 :: ServantErr

@@ -181,7 +184,7 @@ err403 = ServantErr { errHTTPCode = 403

181184--

182185-- Example:

183186--

184−-- > failingHandler :: ExceptT ServantErr IO ()

187+-- > failingHandler :: Handler ()

185188-- > failingHandler = throwErr $ err404 { errBody = "(╯°□°）╯︵ ┻━┻)." }

186189--

187190err404 :: ServantErr

@@ -195,7 +198,7 @@ err404 = ServantErr { errHTTPCode = 404

195198--

196199-- Example:

197200--

198−-- > failingHandler :: ExceptT ServantErr IO ()

201+-- > failingHandler :: Handler ()

199202-- > failingHandler = throwErr $ err405 { errBody = "Your account privileges does not allow for this. Please pay $$$." }

200203--

201204err405 :: ServantErr

@@ -209,7 +212,7 @@ err405 = ServantErr { errHTTPCode = 405

209212--

210213-- Example:

211214--

212−-- > failingHandler :: ExceptT ServantErr IO ()

215+-- > failingHandler :: Handler ()

213216-- > failingHandler = throwErr err406

214217--

215218err406 :: ServantErr

@@ -223,7 +226,7 @@ err406 = ServantErr { errHTTPCode = 406

223226--

224227-- Example:

225228--

226−-- > failingHandler :: ExceptT ServantErr IO ()

229+-- > failingHandler :: Handler ()

227230-- > failingHandler = throwErr err407

228231--

229232err407 :: ServantErr

@@ -237,7 +240,7 @@ err407 = ServantErr { errHTTPCode = 407

237240--

238241-- Example:

239242--

240−-- > failingHandler :: ExceptT ServantErr IO ()

243+-- > failingHandler :: Handler ()

241244-- > failingHandler = throwErr $ err409 { errBody = "Transaction conflicts with 59879cb56c7c159231eeacdd503d755f7e835f74" }

242245--

243246err409 :: ServantErr

@@ -251,7 +254,7 @@ err409 = ServantErr { errHTTPCode = 409

251254--

252255-- Example:

253256--

254−-- > failingHandler :: ExceptT ServantErr IO ()

257+-- > failingHandler :: Handler ()

255258-- > failingHandler = throwErr $ err410 { errBody = "I know it was here at some point, but.. I blame bad luck." }

256259--

257260err410 :: ServantErr

@@ -265,7 +268,7 @@ err410 = ServantErr { errHTTPCode = 410

265268--

266269-- Example:

267270--

268−-- > failingHandler :: ExceptT ServantErr IO ()

271+-- > failingHandler :: Handler ()

269272-- > failingHandler = throwErr err411

270273--

271274err411 :: ServantErr

@@ -279,7 +282,7 @@ err411 = ServantErr { errHTTPCode = 411

279282--

280283-- Example:

281284--

282−-- > failingHandler :: ExceptT ServantErr IO ()

285+-- > failingHandler :: Handler ()

283286-- > failingHandler = throwErr $ err412 { errBody = "Precondition fail: x < 42 && y > 57" }

284287--

285288err412 :: ServantErr

@@ -293,7 +296,7 @@ err412 = ServantErr { errHTTPCode = 412

293296--

294297-- Example:

295298--

296−-- > failingHandler :: ExceptT ServantErr IO ()

299+-- > failingHandler :: Handler ()

297300-- > failingHandler = throwErr $ err413 { errBody = "Request exceeded 64k." }

298301--

299302err413 :: ServantErr

@@ -307,7 +310,7 @@ err413 = ServantErr { errHTTPCode = 413

307310--

308311-- Example:

309312--

310−-- > failingHandler :: ExceptT ServantErr IO ()

313+-- > failingHandler :: Handler ()

311314-- > failingHandler = throwErr $ err414 { errBody = "Maximum length is 64." }

312315--

313316err414 :: ServantErr

@@ -321,7 +324,7 @@ err414 = ServantErr { errHTTPCode = 414

321324--

322325-- Example:

323326--

324−-- > failingHandler :: ExceptT ServantErr IO ()

327+-- > failingHandler :: Handler ()

325328-- > failingHandler = throwErr $ err415 { errBody = "Supported media types: gif, png" }

326329--

327330err415 :: ServantErr

@@ -335,7 +338,7 @@ err415 = ServantErr { errHTTPCode = 415

335338--

336339-- Example:

337340--

338−-- > failingHandler :: ExceptT ServantErr IO ()

341+-- > failingHandler :: Handler ()

339342-- > failingHandler = throwErr $ err416 { errBody = "Valid range is [0, 424242]." }

340343--

341344err416 :: ServantErr

@@ -349,7 +352,7 @@ err416 = ServantErr { errHTTPCode = 416

349352--

350353-- Example:

351354--

352−-- > failingHandler :: ExceptT ServantErr IO ()

355+-- > failingHandler :: Handler ()

353356-- > failingHandler = throwErr $ err417 { errBody = "I found a quux in the request. This isn't going to work." }

354357--

355358err417 :: ServantErr

@@ -363,7 +366,7 @@ err417 = ServantErr { errHTTPCode = 417

363366--

364367-- Example:

365368--

366−-- > failingHandler :: ExceptT ServantErr IO ()

369+-- > failingHandler :: Handler ()

367370-- > failingHandler = throwErr $ err500 { errBody = "Exception in module A.B.C:55. Have a great day!" }

368371--

369372err500 :: ServantErr

@@ -377,7 +380,7 @@ err500 = ServantErr { errHTTPCode = 500

377380--

378381-- Example:

379382--

380−-- > failingHandler :: ExceptT ServantErr IO ()

383+-- > failingHandler :: Handler ()

381384-- > failingHandler = throwErr $ err501 { errBody = "/v1/foo is not supported with quux in the request." }

382385--

383386err501 :: ServantErr

@@ -391,7 +394,7 @@ err501 = ServantErr { errHTTPCode = 501

391394--

392395-- Example:

393396--

394−-- > failingHandler :: ExceptT ServantErr IO ()

397+-- > failingHandler :: Handler ()

395398-- > failingHandler = throwErr $ err502 { errBody = "Tried gateway foo, bar, and baz. None responded." }

396399--

397400err502 :: ServantErr

@@ -405,7 +408,7 @@ err502 = ServantErr { errHTTPCode = 502

405408--

406409-- Example:

407410--

408−-- > failingHandler :: ExceptT ServantErr IO ()

411+-- > failingHandler :: Handler ()

409412-- > failingHandler = throwErr $ err503 { errBody = "We're rewriting in PHP." }

410413--

411414err503 :: ServantErr

@@ -419,7 +422,7 @@ err503 = ServantErr { errHTTPCode = 503

419422--

420423-- Example:

421424--

422−-- > failingHandler :: ExceptT ServantErr IO ()

425+-- > failingHandler :: Handler ()

423426-- > failingHandler = throwErr $ err504 { errBody = "Backend foobar did not respond in 5 seconds." }

424427--

425428err504 :: ServantErr

@@ -433,7 +436,7 @@ err504 = ServantErr { errHTTPCode = 504

433436--

434437-- Example usage:

435438--

436−-- > failingHandler :: ExceptT ServantErr IO ()

439+-- > failingHandler :: Handler ()

437440-- > failingHandler = throwErr $ err505 { errBody = "I support HTTP/4.0 only." }

438441--

439442err505 :: ServantErr

servant-server/test/Servant/Server/Internal/EnterSpec.hs+1−1

@@ -34,7 +34,7 @@ combinedAPI = Proxy

3434readerServer' :: ServerT ReaderAPI (Reader String)

3535readerServer' = return 1797 :<|> ask

3636

37−fReader :: Reader String :~> ExceptT ServantErr IO

37+fReader :: Reader String :~> Handler

3838fReader = generalizeNat C.. (runReaderTNat "hi")

3939

4040readerServer :: Server ReaderAPI

servant-server/test/Servant/Server/StreamingSpec.hs+2−2

@@ -9,7 +9,7 @@

99module Servant.Server.StreamingSpec where

1010

1111import Control.Concurrent

12−import Control.Exception

12+import Control.Exception hiding (Handler)

1313import Control.Monad.IO.Class

1414import Control.Monad.Trans.Except

1515import qualified Data.ByteString as Strict

@@ -66,7 +66,7 @@ spec = do

6666 -- - receives the first chunk

6767 -- - notifies serverReceivedFirstChunk

6868 -- - receives the rest of the request

69− let handler :: Lazy.ByteString -> ExceptT ServantErr IO NoContent

69+ let handler :: Lazy.ByteString -> Handler NoContent

7070 handler input = liftIO $ do

7171 let prefix = Lazy.take 3 input

7272 prefix `shouldBe` "foo"

servant-server/test/Servant/Server/UsingContextSpec.hs+1−1

@@ -25,7 +25,7 @@ spec = do

2525type OneEntryAPI =

2626 ExtractFromContext :> Get '[JSON] String

2727

28−testServer :: String -> ExceptT ServantErr IO String

28+testServer :: String -> Handler String

2929testServer s = return s

3030

3131oneEntryApp :: Application

servant-server/test/Servant/ServerSpec.hs+7−6

@@ -14,7 +14,7 @@

1414module Servant.ServerSpec where

1515

1616import Control.Monad (forM_, when, unless)

17−import Control.Monad.Trans.Except (ExceptT, throwE)

17+import Control.Monad.Trans.Except (throwE)

1818import Data.Aeson (FromJSON, ToJSON, decode', encode)

1919import qualified Data.ByteString.Base64 as Base64

2020import Data.ByteString.Conversion ()

@@ -48,8 +48,9 @@ import Servant.API ((:<|>) (..), (:>), AuthProtect,

4848 Raw, RemoteHost, ReqBody,

4949 StdMethod (..), Verb, addHeader)

5050import Servant.API.Internal.Test.ComprehensiveAPI

51−import Servant.Server (ServantErr (..), Server, err401, err403, err404,

52− serve, serveWithContext, Context((:.), EmptyContext))

51+import Servant.Server (ServantErr (..), Server, Handler, err401, err403,

52+ err404, serve, serveWithContext,

53+ Context((:.), EmptyContext))

5354import Test.Hspec (Spec, context, describe, it,

5455 shouldBe, shouldContain)

5556import qualified Test.Hspec.Wai as THW

@@ -180,7 +181,7 @@ verbSpec = describe "Servant.API.Verb" $ do

180181type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal

181182captureApi :: Proxy CaptureApi

182183captureApi = Proxy

183−captureServer :: Integer -> ExceptT ServantErr IO Animal

184+captureServer :: Integer -> Handler Animal

184185captureServer legs = case legs of

185186 4 -> return jerry

186187 2 -> return tweety

@@ -336,11 +337,11 @@ headerApi = Proxy

336337headerSpec :: Spec

337338headerSpec = describe "Servant.API.Header" $ do

338339

339− let expectsInt :: Maybe Int -> ExceptT ServantErr IO ()

340+ let expectsInt :: Maybe Int -> Handler ()

340341 expectsInt (Just x) = when (x /= 5) $ error "Expected 5"

341342 expectsInt Nothing = error "Expected an int"

342343

343− let expectsString :: Maybe String -> ExceptT ServantErr IO ()

344+ let expectsString :: Maybe String -> Handler ()

344345 expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"

345346 expectsString Nothing = error "Expected a string"

346347