2015-05-03 01:28:13 +02:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
2014-12-10 16:10:57 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2015-05-03 01:28:13 +02:00
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
2014-12-10 16:10:57 +01:00
|
|
|
|
|
|
|
-- | This module lets you implement 'Server's for defined APIs. You'll
|
|
|
|
-- most likely just need 'serve'.
|
|
|
|
module Servant.Server
|
2015-02-24 13:46:50 +01:00
|
|
|
( -- * Run a wai application from an API
|
2014-12-10 16:10:57 +01:00
|
|
|
serve
|
|
|
|
|
2015-02-24 13:46:50 +01:00
|
|
|
, -- * Construct a wai Application from an API
|
|
|
|
toApplication
|
|
|
|
|
2014-12-10 16:10:57 +01:00
|
|
|
, -- * Handlers for all standard combinators
|
|
|
|
HasServer(..)
|
2015-03-09 15:16:38 +01:00
|
|
|
, Server
|
2015-05-02 04:38:53 +02:00
|
|
|
|
2015-05-02 16:46:43 +02:00
|
|
|
-- * Enter
|
2015-05-03 01:28:13 +02:00
|
|
|
-- $enterDoc
|
|
|
|
|
|
|
|
-- ** Basic functions and datatypes
|
|
|
|
, enter
|
|
|
|
, (:~>)(..)
|
|
|
|
-- ** `Nat` utilities
|
|
|
|
, liftNat
|
|
|
|
, runReaderTNat
|
|
|
|
, evalStateTLNat
|
|
|
|
, evalStateTSNat
|
|
|
|
, logWriterTLNat
|
|
|
|
, logWriterTSNat
|
|
|
|
-- ** Functions based on <https://hackage.haskell.org/package/mmorph mmorph>
|
|
|
|
, hoistNat
|
|
|
|
, embedNat
|
|
|
|
, squashNat
|
|
|
|
, generalizeNat
|
|
|
|
|
2015-05-02 16:46:43 +02:00
|
|
|
|
2015-05-02 04:38:53 +02:00
|
|
|
-- * Default error type
|
|
|
|
, ServantErr(..)
|
|
|
|
-- ** 3XX
|
|
|
|
, err300
|
|
|
|
, err301
|
|
|
|
, err302
|
|
|
|
, err303
|
|
|
|
, err304
|
|
|
|
, err305
|
|
|
|
, err307
|
|
|
|
-- ** 4XX
|
|
|
|
, err400
|
|
|
|
, err401
|
|
|
|
, err402
|
|
|
|
, err403
|
|
|
|
, err404
|
|
|
|
, err405
|
|
|
|
, err406
|
|
|
|
, err407
|
|
|
|
, err409
|
|
|
|
, err410
|
|
|
|
, err411
|
|
|
|
, err412
|
|
|
|
, err413
|
|
|
|
, err414
|
|
|
|
, err415
|
|
|
|
, err416
|
|
|
|
, err417
|
|
|
|
-- * 5XX
|
|
|
|
, err500
|
|
|
|
, err501
|
|
|
|
, err502
|
|
|
|
, err503
|
|
|
|
, err504
|
|
|
|
, err505
|
|
|
|
|
2014-12-10 16:10:57 +01:00
|
|
|
) where
|
|
|
|
|
2015-08-17 23:56:29 +02:00
|
|
|
import Data.Proxy (Proxy)
|
|
|
|
import Network.Wai (Application)
|
2015-05-03 01:28:13 +02:00
|
|
|
import Servant.Server.Internal
|
|
|
|
import Servant.Server.Internal.Enter
|
2014-12-10 16:10:57 +01:00
|
|
|
|
2015-01-06 17:25:25 +01:00
|
|
|
|
2014-12-10 16:10:57 +01:00
|
|
|
-- * Implementing Servers
|
|
|
|
|
|
|
|
-- | 'serve' allows you to implement an API and produce a wai 'Application'.
|
|
|
|
--
|
|
|
|
-- Example:
|
|
|
|
--
|
2015-01-13 20:40:41 +01:00
|
|
|
-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
|
|
|
|
-- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books
|
2014-12-10 16:10:57 +01:00
|
|
|
-- >
|
|
|
|
-- > server :: Server MyApi
|
|
|
|
-- > server = listAllBooks :<|> postBook
|
|
|
|
-- > where listAllBooks = ...
|
|
|
|
-- > postBook book = ...
|
|
|
|
-- >
|
2015-01-01 21:10:17 +01:00
|
|
|
-- > myApi :: Proxy MyApi
|
2015-01-06 17:25:25 +01:00
|
|
|
-- > myApi = Proxy
|
2015-01-01 21:10:17 +01:00
|
|
|
-- >
|
2014-12-10 16:10:57 +01:00
|
|
|
-- > app :: Application
|
|
|
|
-- > app = serve myApi server
|
|
|
|
-- >
|
|
|
|
-- > main :: IO ()
|
|
|
|
-- > main = Network.Wai.Handler.Warp.run 8080 app
|
2015-05-03 01:28:13 +02:00
|
|
|
--
|
2015-05-03 01:45:17 +02:00
|
|
|
serve :: HasServer layout => Proxy layout -> Server layout -> Application
|
2015-05-29 17:16:36 +02:00
|
|
|
serve p server = toApplication (runRouter (route p (return (RR (Right server)))))
|
2015-05-03 01:28:13 +02:00
|
|
|
|
|
|
|
|
|
|
|
-- Documentation
|
|
|
|
|
|
|
|
-- $enterDoc
|
2015-09-12 14:11:24 +02:00
|
|
|
-- Sometimes our cherished `ExceptT` monad isn't quite the type you'd like for
|
2015-05-03 01:28:13 +02:00
|
|
|
-- your handlers. Maybe you want to thread some configuration in a @Reader@
|
|
|
|
-- monad. Or have your types ensure that your handlers don't do any IO. Enter
|
|
|
|
-- `enter`.
|
|
|
|
--
|
|
|
|
-- With `enter`, you can provide a function, wrapped in the `(:~>)` / `Nat`
|
|
|
|
-- newtype, to convert any number of endpoints from one type constructor to
|
|
|
|
-- another. For example
|
|
|
|
--
|
|
|
|
-- >>> import Control.Monad.Reader
|
|
|
|
-- >>> import qualified Control.Category as C
|
|
|
|
-- >>> type ReaderAPI = "ep1" :> Get '[JSON] Int :<|> "ep2" :> Get '[JSON] String
|
|
|
|
-- >>> let readerServer = return 1797 :<|> ask :: ServerT ReaderAPI (Reader String)
|
|
|
|
-- >>> let mainServer = enter (generalizeNat C.. (runReaderTNat "hi")) readerServer :: Server ReaderAPI
|
|
|
|
--
|
|
|
|
|
|
|
|
-- $setup
|
|
|
|
-- >>> import Servant.API
|
|
|
|
-- >>> import Servant.Server
|