Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
-
class
GServer
(api :: * -> *) (m :: * -> *)
where
- gServerProof :: Dict ( GServerConstraints api m)
- type GServerConstraints api m = ( ToServant api ( AsServerT m) ~ ServerT ( ToServantApi api) m, GServantProduct ( Rep (api ( AsServerT m))))
- type AsServer = AsServerT Handler
- data AsServerT (m :: * -> *)
- type HasServerArrowTypeError a b = (((' Text "No instance HasServer (a -> b)." :$$: ' Text "Maybe you have used '->' instead of ':>' between ") :$$: ' ShowType a) :$$: ' Text "and") :$$: ' ShowType b
- data EmptyServer = EmptyServer
- type Server api = ServerT api Handler
- class HasServer api context where
- allowedMethodHead :: Method -> Request -> Bool
- allowedMethod :: Method -> Request -> Bool
- methodCheck :: Method -> Request -> DelayedIO ()
- acceptCheck :: AllMime list => Proxy list -> AcceptHeader -> DelayedIO ()
- methodRouter :: AllCTRender ctypes a => (b -> ([( HeaderName , ByteString )], a)) -> Method -> Proxy ctypes -> Status -> Delayed env ( Handler b) -> Router env
- noContentRouter :: Method -> Status -> Delayed env ( Handler b) -> Router env
- streamRouter :: forall ctype a c chunk env framing. ( MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) => (c -> ([( HeaderName , ByteString )], a)) -> Method -> Status -> Proxy framing -> Proxy ctype -> Delayed env ( Handler c) -> Router env
- emptyServer :: ServerT EmptyAPI m
- ct_wildcard :: ByteString
- getAcceptHeader :: Request -> AcceptHeader
- module Servant.Server.Internal.BasicAuth
- module Servant.Server.Internal.Context
- module Servant.Server.Internal.Delayed
- module Servant.Server.Internal.DelayedIO
- module Servant.Server.Internal.ErrorFormatter
- module Servant.Server.Internal.Handler
- module Servant.Server.Internal.Router
- module Servant.Server.Internal.RouteResult
- module Servant.Server.Internal.RoutingApplication
- module Servant.Server.Internal.ServerError
Documentation
class GServer (api :: * -> *) (m :: * -> *) where Source #
This class is a necessary evil: in the implementation of
HasServer
for
, we essentially need the quantified constraint
NamedRoutes
api
forall
m.
to hold.
GServerConstraints
m
We cannot require do that directly as the definition of
GServerConstraints
contains type family applications (
Rep
and
ServerT
). The trick is to hide
those type family applications behind a typeclass providing evidence for
in the form of a dictionary, and require that
GServerConstraints
api m
forall m.
instead.
GServer
api m
Users shouldn't have to worry about this class, as the only possible instance is provided in this module for all record APIs.
gServerProof :: Dict ( GServerConstraints api m) Source #
Instances
( ToServant api ( AsServerT m) ~ ServerT ( ToServantApi api) m, GServantProduct ( Rep (api ( AsServerT m)))) => GServer api m Source # | |
Defined in Servant.Server.Internal gServerProof :: Dict ( GServerConstraints api m) Source # |
type GServerConstraints api m = ( ToServant api ( AsServerT m) ~ ServerT ( ToServantApi api) m, GServantProduct ( Rep (api ( AsServerT m)))) Source #
Set of constraints required to convert to / from vanilla server types.
data AsServerT (m :: * -> *) Source #
A type that specifies that an API record contains a server implementation.
type HasServerArrowTypeError a b = (((' Text "No instance HasServer (a -> b)." :$$: ' Text "Maybe you have used '->' instead of ':>' between ") :$$: ' ShowType a) :$$: ' Text "and") :$$: ' ShowType b Source #
data EmptyServer Source #
Singleton type representing a server that serves an empty API.
Instances
Bounded EmptyServer Source # | |
Defined in Servant.Server.Internal |
|
Enum EmptyServer Source # | |
Defined in Servant.Server.Internal succ :: EmptyServer -> EmptyServer Source # pred :: EmptyServer -> EmptyServer Source # toEnum :: Int -> EmptyServer Source # fromEnum :: EmptyServer -> Int Source # enumFrom :: EmptyServer -> [ EmptyServer ] Source # enumFromThen :: EmptyServer -> EmptyServer -> [ EmptyServer ] Source # enumFromTo :: EmptyServer -> EmptyServer -> [ EmptyServer ] Source # enumFromThenTo :: EmptyServer -> EmptyServer -> EmptyServer -> [ EmptyServer ] Source # |
|
Eq EmptyServer Source # | |
Defined in Servant.Server.Internal (==) :: EmptyServer -> EmptyServer -> Bool Source # (/=) :: EmptyServer -> EmptyServer -> Bool Source # |
|
Show EmptyServer Source # | |
Defined in Servant.Server.Internal |
class HasServer api context where Source #
route :: Proxy api -> Context context -> Delayed env ( Server api) -> Router env Source #
hoistServerWithContext :: Proxy api -> Proxy context -> ( forall x. m x -> n x) -> ServerT api m -> ServerT api n Source #
Instances
( TypeError ( NoInstanceFor ( HasServer api context)) :: Constraint ) => HasServer (api :: k) context Source # | |
HasServer Raw context Source # |
Just pass the request to the underlying application and serve its response. Example: type MyApi = "images" :> Raw server :: Server MyApi server = serveDirectory "/var/www/images" |
HasServer EmptyAPI context Source # |
The server for an
type MyApi = "nothing" :> EmptyApi server :: Server MyApi server = emptyServer |
Defined in Servant.Server.Internal |
|
( HasServer ( ToServantApi api) context, forall (m :: Type -> Type ). Generic (api ( AsServerT m)), forall (m :: Type -> Type ). GServer api m) => HasServer ( NamedRoutes api :: Type ) context Source # | |
Defined in Servant.Server.Internal type ServerT ( NamedRoutes api) m Source # route :: Proxy ( NamedRoutes api) -> Context context -> Delayed env ( Server ( NamedRoutes api)) -> Router env Source # hoistServerWithContext :: Proxy ( NamedRoutes api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( NamedRoutes api) m -> ServerT ( NamedRoutes api) n Source # |
|
( TypeError ( HasServerArrowTypeError a b) :: Constraint ) => HasServer (a -> b :: Type ) context Source # |
This instance prevents from accidentally using
|
Defined in Servant.Server.Internal |
|
ReflectMethod method => HasServer ( NoContentVerb method :: Type ) context Source # | |
Defined in Servant.Server.Internal type ServerT ( NoContentVerb method) m Source # route :: Proxy ( NoContentVerb method) -> Context context -> Delayed env ( Server ( NoContentVerb method)) -> Router env Source # hoistServerWithContext :: Proxy ( NoContentVerb method) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( NoContentVerb method) m -> ServerT ( NoContentVerb method) n Source # |
|
( HasServer a context, HasServer b context) => HasServer (a :<|> b :: Type ) context Source # |
A server for
type MyApi = "books" :> Get '[JSON] [Book] -- GET /books :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books server :: Server MyApi server = listAllBooks :<|> postBook where listAllBooks = ... postBook book = ... |
Defined in Servant.Server.Internal |
|
( HasContextEntry context ( NamedContext name subContext), HasServer subApi subContext) => HasServer ( WithNamedContext name subContext subApi :: Type ) context Source # | |
Defined in Servant.Server.Internal type ServerT ( WithNamedContext name subContext subApi) m Source # route :: Proxy ( WithNamedContext name subContext subApi) -> Context context -> Delayed env ( Server ( WithNamedContext name subContext subApi)) -> Router env Source # hoistServerWithContext :: Proxy ( WithNamedContext name subContext subApi) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( WithNamedContext name subContext subApi) m -> ServerT ( WithNamedContext name subContext subApi) n Source # |
|
( ReflectMethod method, AllMime contentTypes, All (IsServerResourceWithStatus contentTypes) as, Unique ( Statuses as)) => HasServer ( UVerb method contentTypes as :: Type ) context Source # | |
Defined in Servant.Server.UVerb route :: Proxy ( UVerb method contentTypes as) -> Context context -> Delayed env ( Server ( UVerb method contentTypes as)) -> Router env Source # hoistServerWithContext :: Proxy ( UVerb method contentTypes as) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( UVerb method contentTypes as) m -> ServerT ( UVerb method contentTypes as) n Source # |
|
( TypeError ( PartialApplication ( HasServer :: k -> [ Type ] -> Constraint ) arr) :: Constraint ) => HasServer (arr :> sub :: Type ) context Source # | |
Defined in Servant.Server.Internal |
|
HasServer api context => HasServer ( HttpVersion :> api :: Type ) context Source # | |
Defined in Servant.Server.Internal type ServerT ( HttpVersion :> api) m Source # route :: Proxy ( HttpVersion :> api) -> Context context -> Delayed env ( Server ( HttpVersion :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( HttpVersion :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( HttpVersion :> api) m -> ServerT ( HttpVersion :> api) n Source # |
|
( FramingUnrender framing, FromSourceIO chunk a, MimeUnrender ctype chunk, HasServer api context) => HasServer ( StreamBody' mods framing ctype a :> api :: Type ) context Source # | |
Defined in Servant.Server.Internal type ServerT ( StreamBody' mods framing ctype a :> api) m Source # route :: Proxy ( StreamBody' mods framing ctype a :> api) -> Context context -> Delayed env ( Server ( StreamBody' mods framing ctype a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( StreamBody' mods framing ctype a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( StreamBody' mods framing ctype a :> api) m -> ServerT ( StreamBody' mods framing ctype a :> api) n Source # |
|
( AllCTUnrender list a, HasServer api context, SBoolI ( FoldLenient mods), HasContextEntry ( MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer ( ReqBody' mods list a :> api :: Type ) context Source # |
If you use
All it asks is for a
Example: type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book server :: Server MyApi server = postBook where postBook :: Book -> Handler Book postBook book = ...insert into your db... |
Defined in Servant.Server.Internal route :: Proxy ( ReqBody' mods list a :> api) -> Context context -> Delayed env ( Server ( ReqBody' mods list a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( ReqBody' mods list a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( ReqBody' mods list a :> api) m -> ServerT ( ReqBody' mods list a :> api) n Source # |
|
HasServer api context => HasServer ( RemoteHost :> api :: Type ) context Source # | |
Defined in Servant.Server.Internal type ServerT ( RemoteHost :> api) m Source # route :: Proxy ( RemoteHost :> api) -> Context context -> Delayed env ( Server ( RemoteHost :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( RemoteHost :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( RemoteHost :> api) m -> ServerT ( RemoteHost :> api) n Source # |
|
( KnownSymbol sym, FromHttpApiData a, HasServer api context, SBoolI ( FoldRequired mods), SBoolI ( FoldLenient mods), HasContextEntry ( MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer ( QueryParam' mods sym a :> api :: Type ) context Source # |
If you use
This lets servant worry about looking it up in the query string
and turning it into a value of the type you specify, enclosed
in
You can control how it'll be converted from
Example: type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book] server :: Server MyApi server = getBooksBy where getBooksBy :: Maybe Text -> Handler [Book] getBooksBy Nothing = ...return all books... getBooksBy (Just author) = ...return books by the given author... |
Defined in Servant.Server.Internal type ServerT ( QueryParam' mods sym a :> api) m Source # route :: Proxy ( QueryParam' mods sym a :> api) -> Context context -> Delayed env ( Server ( QueryParam' mods sym a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( QueryParam' mods sym a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( QueryParam' mods sym a :> api) m -> ServerT ( QueryParam' mods sym a :> api) n Source # |
|
( KnownSymbol sym, FromHttpApiData a, HasServer api context, HasContextEntry ( MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer ( QueryParams sym a :> api :: Type ) context Source # |
If you use
This lets servant worry about looking up 0 or more values in the query string
associated to
You can control how the individual values are converted from
Example: type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book] server :: Server MyApi server = getBooksBy where getBooksBy :: [Text] -> Handler [Book] getBooksBy authors = ...return all books by these authors... |
Defined in Servant.Server.Internal type ServerT ( QueryParams sym a :> api) m Source # route :: Proxy ( QueryParams sym a :> api) -> Context context -> Delayed env ( Server ( QueryParams sym a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( QueryParams sym a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( QueryParams sym a :> api) m -> ServerT ( QueryParams sym a :> api) n Source # |
|
( KnownSymbol sym, HasServer api context) => HasServer ( QueryFlag sym :> api :: Type ) context Source # |
If you use
Example: type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book] server :: Server MyApi server = getBooks where getBooks :: Bool -> Handler [Book] getBooks onlyPublished = ...return all books, or only the ones that are already published, depending on the argument... |
Defined in Servant.Server.Internal route :: Proxy ( QueryFlag sym :> api) -> Context context -> Delayed env ( Server ( QueryFlag sym :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( QueryFlag sym :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( QueryFlag sym :> api) m -> ServerT ( QueryFlag sym :> api) n Source # |
|
( KnownSymbol sym, FromHttpApiData a, HasServer api context, SBoolI ( FoldRequired mods), SBoolI ( FoldLenient mods), HasContextEntry ( MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer ( Header' mods sym a :> api :: Type ) context Source # |
If you use
All it asks is for a
Example: newtype Referer = Referer Text deriving (Eq, Show, FromHttpApiData) -- GET /view-my-referer type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer server :: Server MyApi server = viewReferer where viewReferer :: Referer -> Handler referer viewReferer referer = return referer |
Defined in Servant.Server.Internal route :: Proxy ( Header' mods sym a :> api) -> Context context -> Delayed env ( Server ( Header' mods sym a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( Header' mods sym a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Header' mods sym a :> api) m -> ServerT ( Header' mods sym a :> api) n Source # |
|
HasServer api context => HasServer ( IsSecure :> api :: Type ) context Source # | |
Defined in Servant.Server.Internal |
|
( AtLeastOneFragment api, FragmentUnique ( Fragment a1 :> api), HasServer api context) => HasServer ( Fragment a1 :> api :: Type ) context Source # |
Ignore
Example: type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book] server :: Server MyApi server = getBooks where getBooks :: Handler [Book] getBooks = ...return all books... |
Defined in Servant.Server.Internal route :: Proxy ( Fragment a1 :> api) -> Context context -> Delayed env ( Server ( Fragment a1 :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( Fragment a1 :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Fragment a1 :> api) m -> ServerT ( Fragment a1 :> api) n Source # |
|
( HasServer api context, HasContextEntry context ( AuthHandler Request ( AuthServerData ( AuthProtect tag)))) => HasServer ( AuthProtect tag :> api :: Type ) context Source # |
Known orphan instance. |
Defined in Servant.Server.Experimental.Auth type ServerT ( AuthProtect tag :> api) m Source # route :: Proxy ( AuthProtect tag :> api) -> Context context -> Delayed env ( Server ( AuthProtect tag :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( AuthProtect tag :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( AuthProtect tag :> api) m -> ServerT ( AuthProtect tag :> api) n Source # |
|
HasServer api ctx => HasServer ( Summary desc :> api :: Type ) ctx Source # |
Ignore
|
Defined in Servant.Server.Internal |
|
HasServer api ctx => HasServer ( Description desc :> api :: Type ) ctx Source # |
Ignore
|
Defined in Servant.Server.Internal type ServerT ( Description desc :> api) m Source # route :: Proxy ( Description desc :> api) -> Context ctx -> Delayed env ( Server ( Description desc :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( Description desc :> api) -> Proxy ctx -> ( forall x. m x -> n x) -> ServerT ( Description desc :> api) m -> ServerT ( Description desc :> api) n Source # |
|
( KnownSymbol capture, FromHttpApiData a, Typeable a, HasServer api context, SBoolI ( FoldLenient mods), HasContextEntry ( MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer ( Capture' mods capture a :> api :: Type ) context Source # |
If you use
You can control how it'll be converted from
Example: type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book server :: Server MyApi server = getBook where getBook :: Text -> Handler Book getBook isbn = ... |
Defined in Servant.Server.Internal route :: Proxy ( Capture' mods capture a :> api) -> Context context -> Delayed env ( Server ( Capture' mods capture a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( Capture' mods capture a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Capture' mods capture a :> api) m -> ServerT ( Capture' mods capture a :> api) n Source # |
|
( KnownSymbol capture, FromHttpApiData a, Typeable a, HasServer api context, HasContextEntry ( MkContextWithErrorFormatter context) ErrorFormatters ) => HasServer ( CaptureAll capture a :> api :: Type ) context Source # |
If you use
You can control how they'll be converted from
Example: type MyApi = "src" :> CaptureAll "segments" Text :> Get '[JSON] SourceFile server :: Server MyApi server = getSourceFile where getSourceFile :: [Text] -> Handler Book getSourceFile pathSegments = ... |
Defined in Servant.Server.Internal type ServerT ( CaptureAll capture a :> api) m Source # route :: Proxy ( CaptureAll capture a :> api) -> Context context -> Delayed env ( Server ( CaptureAll capture a :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( CaptureAll capture a :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( CaptureAll capture a :> api) m -> ServerT ( CaptureAll capture a :> api) n Source # |
|
( KnownSymbol realm, HasServer api context, HasContextEntry context ( BasicAuthCheck usr)) => HasServer ( BasicAuth realm usr :> api :: Type ) context Source # |
Basic Authentication |
Defined in Servant.Server.Internal route :: Proxy ( BasicAuth realm usr :> api) -> Context context -> Delayed env ( Server ( BasicAuth realm usr :> api)) -> Router env Source # hoistServerWithContext :: Proxy ( BasicAuth realm usr :> api) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( BasicAuth realm usr :> api) m -> ServerT ( BasicAuth realm usr :> api) n Source # |
|
HasServer api context => HasServer ( Vault :> api :: Type ) context Source # | |
Defined in Servant.Server.Internal |
|
( KnownSymbol path, HasServer api context) => HasServer (path :> api :: Type ) context Source # |
Make sure the incoming request starts with
|
Defined in Servant.Server.Internal |
|
( TypeError ( NoInstanceForSub ( HasServer :: k2 -> [ Type ] -> Constraint ) ty) :: Constraint ) => HasServer (ty :> sub :: Type ) context Source # | |
Defined in Servant.Server.Internal |
|
( AllCTRender ctypes a, ReflectMethod method, KnownNat status, GetHeaders ( Headers h a)) => HasServer ( Verb method status ctypes ( Headers h a) :: Type ) context Source # | |
Defined in Servant.Server.Internal route :: Proxy ( Verb method status ctypes ( Headers h a)) -> Context context -> Delayed env ( Server ( Verb method status ctypes ( Headers h a))) -> Router env Source # hoistServerWithContext :: Proxy ( Verb method status ctypes ( Headers h a)) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Verb method status ctypes ( Headers h a)) m -> ServerT ( Verb method status ctypes ( Headers h a)) n Source # |
|
( AllCTRender ctypes a, ReflectMethod method, KnownNat status) => HasServer ( Verb method status ctypes a :: Type ) context Source # | |
Defined in Servant.Server.Internal route :: Proxy ( Verb method status ctypes a) -> Context context -> Delayed env ( Server ( Verb method status ctypes a)) -> Router env Source # hoistServerWithContext :: Proxy ( Verb method status ctypes a) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Verb method status ctypes a) m -> ServerT ( Verb method status ctypes a) n Source # |
|
( MimeRender ctype chunk, ReflectMethod method, KnownNat status, FramingRender framing, ToSourceIO chunk a, GetHeaders ( Headers h a)) => HasServer ( Stream method status framing ctype ( Headers h a) :: Type ) context Source # | |
Defined in Servant.Server.Internal route :: Proxy ( Stream method status framing ctype ( Headers h a)) -> Context context -> Delayed env ( Server ( Stream method status framing ctype ( Headers h a))) -> Router env Source # hoistServerWithContext :: Proxy ( Stream method status framing ctype ( Headers h a)) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Stream method status framing ctype ( Headers h a)) m -> ServerT ( Stream method status framing ctype ( Headers h a)) n Source # |
|
( MimeRender ctype chunk, ReflectMethod method, KnownNat status, FramingRender framing, ToSourceIO chunk a) => HasServer ( Stream method status framing ctype a :: Type ) context Source # | |
Defined in Servant.Server.Internal route :: Proxy ( Stream method status framing ctype a) -> Context context -> Delayed env ( Server ( Stream method status framing ctype a)) -> Router env Source # hoistServerWithContext :: Proxy ( Stream method status framing ctype a) -> Proxy context -> ( forall x. m x -> n x) -> ServerT ( Stream method status framing ctype a) m -> ServerT ( Stream method status framing ctype a) n Source # |
acceptCheck :: AllMime list => Proxy list -> AcceptHeader -> DelayedIO () Source #
methodRouter :: AllCTRender ctypes a => (b -> ([( HeaderName , ByteString )], a)) -> Method -> Proxy ctypes -> Status -> Delayed env ( Handler b) -> Router env Source #
streamRouter :: forall ctype a c chunk env framing. ( MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) => (c -> ([( HeaderName , ByteString )], a)) -> Method -> Status -> Proxy framing -> Proxy ctype -> Delayed env ( Handler c) -> Router env Source #