From e9a68cea0cfc4d5cc6f3fca38659f90ee9d7236b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=B6nke=20Hahn?= Date: Thu, 27 Oct 2016 01:32:02 -0400 Subject: [PATCH] add documentation --- .../Servant/Server/Utils/CustomCombinators.hs | 82 ++++++++++++++++--- 1 file changed, 72 insertions(+), 10 deletions(-) diff --git a/servant-server/src/Servant/Server/Utils/CustomCombinators.hs b/servant-server/src/Servant/Server/Utils/CustomCombinators.hs index a6ed78cb..24180e42 100644 --- a/servant-server/src/Servant/Server/Utils/CustomCombinators.hs +++ b/servant-server/src/Servant/Server/Utils/CustomCombinators.hs @@ -4,11 +4,19 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +-- fixme: document RouteResult better -- fixme: document phases -- fixme: document that the req body can only be consumed once --- fixme: document that you can write request body streaming combinators -- fixme: document dependency problem +-- | This module provides convenience functions that make it easy to write +-- 'HasServer' instances for your own custom servant combinators. +-- +-- It is also intended to be a more stable interface for writing +-- combinators than 'Servant.Server.Internal' and its submodules. +-- +-- For examples on how to write combinators see 'makeCaptureCombinator' and friends. + module Servant.Server.Utils.CustomCombinators ( -- * ServerCombinator @@ -38,7 +46,21 @@ import Servant.API import Servant.Server import Servant.Server.Internal -data ServerCombinator combinator serverType api context where +-- | 'ServerCombinator' is a type to encapsulate the implementations +-- of the 'route' method of the 'HasServer' class of your custom combinators. +-- You can create a 'ServerCombinator' using one of the 'make...' functions below. +-- +-- Type parameters: +-- +-- - @combinator@ -- Your custom combinator type, usually an uninhabited dummy type. +-- - @context@ -- The context your combinator (and all other combinators) have access to. +-- In most cases this can be ignored. For further information, see +-- 'Servant.Server.Internal.Context'. +-- - @api@ -- The subapi to be used in @serverType@. +-- - @serverType@ -- The type of the server that implements an api containing your combinator. +-- This should contain a call to 'ServerT' applied to @api@ -- the other type parameter -- and +-- 'Handler'. If your combinator for example supplies an 'Int' to endpoint handlers, +-- @serverType@ would be @'Int' -> 'ServerT' api 'Handler'@. data ServerCombinator combinator api context serverType where CI :: (forall env . Proxy (combinator :> api) @@ -47,6 +69,9 @@ data ServerCombinator combinator api context serverType where -> Router' env RoutingApplication) -> ServerCombinator combinator api context serverType +-- | 'runServerCombinator' is used to actually implement the method 'route' from the type class +-- 'HasServer'. You can ignore most of the type of this function. All you need to do is to supply +-- a 'ServerCombinator'. runServerCombinator :: ServerCombinator combinator api context serverType -> Proxy (combinator :> api) -> Context context @@ -54,7 +79,15 @@ runServerCombinator :: ServerCombinator combinator api context serverType -> Router' env RoutingApplication runServerCombinator (CI i) = i --- | +-- | 'makeCaptureCombinator' allows you to write a combinator that inspects a path snippet +-- and provides an additional argument to endpoint handlers. You can choose the type of +-- that argument. +-- +-- Here's an example of a combinator 'MyCaptureCombinator' that tries to parse a path snippet as +-- an 'Int' and provides that 'Int' as an argument to the endpoint handler. Note that in case the +-- path snippet cannot be parsed as an 'Int' the combinator errors out (using 'Fail'), which means +-- the endpoint handler will not be called. +-- -- >>> :set -XTypeFamilies -- >>> :{ -- import Text.Read @@ -65,7 +98,7 @@ runServerCombinator (CI i) = i -- getCaptureString :: Context context -> Text -> IO (RouteResult Int) -- getCaptureString _context pathSnippet = return $ case readMaybe (cs pathSnippet) of -- Just n -> Route n --- Nothing -> FailFatal err400 +-- Nothing -> Fail err404 -- :} makeCaptureCombinator :: (HasServer api context) => @@ -83,7 +116,16 @@ makeCaptureCombinator = inner -- we use 'inner' to avoid having 'forall' show up route (Proxy :: Proxy api) context $ addCapture delayed $ \ captured -> (liftRouteResult =<< liftIO (getArg context captured)) --- | +-- | 'makeRequestCheckCombinator' allows you to a combinator that checks a property of the +-- 'Request', while not providing any additional argument to your endpoint handlers. +-- +-- Combinators created with 'makeRequestCheckCombinator' are *not* allowed to access the +-- request body (see 'makeCombinator'). +-- +-- This example shows a combinator 'BlockNonSSL' that disallows requests through @http@ and +-- only allows @https@. Note that -- in case of @http@ -- it uses 'FailFatal' to prevent +-- servant from trying out any remaining endpoints. +-- -- >>> :{ -- data BlockNonSSL -- instance HasServer api context => HasServer (BlockNonSSL :> api) context where @@ -110,22 +152,42 @@ makeRequestCheckCombinator = inner withRequest $ \ request -> liftRouteResult =<< liftIO (check context (protectBody "makeRequestCheckCombinator" request)) +-- | 'makeAuthCombinator' allows you to write combinators for authorization. +-- +-- Combinators created with this function are *not* allowed to access the request body +-- (see 'makeCombinator'). makeAuthCombinator :: (HasServer api context) => - (Context context -> Request -> IO (RouteResult arg)) - -> ServerCombinator combinator api context (arg -> ServerT api Handler) + (Context context -> Request -> IO (RouteResult authInformation)) + -> ServerCombinator combinator api context (authInformation -> ServerT api Handler) makeAuthCombinator = inner where inner :: - forall api combinator arg context . + forall api combinator authInformation context . (HasServer api context) => - (Context context -> Request -> IO (RouteResult arg)) - -> ServerCombinator combinator api context (arg -> ServerT api Handler) + (Context context -> Request -> IO (RouteResult authInformation)) + -> ServerCombinator combinator api context (authInformation -> ServerT api Handler) inner authCheck = CI $ \ Proxy context delayed -> route (Proxy :: Proxy api) context $ addAuthCheck delayed $ withRequest $ \ request -> liftRouteResult =<< liftIO (authCheck context (protectBody "makeAuthCombinator" request)) +-- | 'makeCombinator' allows you to write combinators that have access to the whole request +-- (including the request body) while providing an additional argument to the endpoint handler. +-- This includes writing combinators that allow you to stream the request body. Here's a simple +-- example for that using a very simple stream implementation 'Source': +-- +-- >>> import Data.ByteString +-- >>> :{ +-- data Source = Source (IO ByteString) +-- data Stream +-- instance HasServer api context => HasServer (Stream :> api) context where +-- type ServerT (Stream :> api) m = Source -> ServerT api m +-- route = runServerCombinator $ makeCombinator requestToSource +-- requestToSource :: Context context -> Request -> IO (RouteResult Source) +-- requestToSource _context request = +-- return $ Route $ Source $ requestBody request +-- :} makeCombinator :: (HasServer api context) => (Context context -> Request -> IO (RouteResult arg))