| Copyright | (C) 2024 Bellroy Pty Ltd |
|---|---|
| License | BSD-3-Clause |
| Maintainer | Bellroy Tech Team <haskell@bellroy.com> |
| Stability | experimental |
| Safe Haskell | Safe-Inferred |
| Language | Haskell2010 |
Servant.ActiveResource
Description
Types and helpers for defining Servant routes compatible with Rails' ActiveResource.
{-# LANGUAGE TemplateHaskell #-}
import qualified Servant.ActiveResource as AR
newtype MyResourceId = MyResourceId Int
-- Type for new values or updates to existing values. Usually
-- missing an id field.
data MyResource = MyResource {...}
-- Like MyResource, but returned from the database.
data MyStoredResource = MyStoredResource {...}
-- The exact monad used will depend on your program. Here, we just assume
-- Handler from package servant-server.
instance AR.Resource MyResourceId Handler where
type ResourceData MyResourceId = MyResource
type StoredResourceData MyResourceId = MyStoredResource
-- These form the implementation of your API.
listResources = ...
createResource = ...
readResource = ...
upsertResource = ...
deleteResource = ...
-- Record of routes, which can be spliced into a top-level handler
-- via NamedRoutes.
routes :: AR.ResourceRoutes MyResourceId (AsServerT Handler)
routes = $(AR.makeResourceServerT [t|MyResourceId|])
Synopsis
- class Monad m => Resource id m where
- type ResourceData id :: Type
- type StoredResourceData id :: Type
- listResources :: m [StoredResourceData id]
- createResource :: ResourceData id -> m (Either ValidationError (StoredResourceData id))
- readResource :: id -> m (Either NotFoundError (StoredResourceData id))
- upsertResource :: id -> ResourceData id -> m (Either ValidationError (CreatedUpdated, StoredResourceData id))
- deleteResource :: id -> m (Either NotFoundError ())
- data NotFoundError = NotFoundError
- newtype ValidationError = ValidationError (Map Text [Text])
- data CreatedUpdated
- data ResourceRoutes (id :: Type) mode = ResourceRoutes {
- listRoute :: mode :- UVerb 'GET '[JSON] '[WithStatus 200 [StoredResourceData id]]
- createRoute :: mode :- (ReqBody '[JSON] (ResourceData id) :> UVerb 'POST '[JSON] '[WithStatus 422 ValidationError, WithStatus 201 (StoredResourceData id)])
- readRoute :: mode :- (Capture "id" id :> UVerb 'GET '[JSON] '[WithStatus 404 NotFoundError, WithStatus 200 (StoredResourceData id)])
- upsertRoute :: mode :- (Capture "id" id :> (ReqBody '[JSON] (ResourceData id) :> UVerb 'PUT '[JSON] '[WithStatus 422 ValidationError, WithStatus 200 (StoredResourceData id), WithStatus 201 (StoredResourceData id)]))
- deleteRoute :: mode :- (Capture "id" id :> UVerb 'DELETE '[JSON] '[WithStatus 404 NotFoundError, WithStatus 204 NoContent])
- makeResourceServerT :: TypeQ -> ExpQ
- errorFormatters :: ErrorFormatters
Documentation
class Monad m => Resource id m where Source #
A Resource instance says that the type id is the primary
key for some abstract resource, and that the collection of such
resources can be manipulated with CRUDL actions inside a Monad m.
Associated Types
type ResourceData id :: Type Source #
The type used to represent new records or updates to existing
records. Typically, this is missing an id field.
type StoredResourceData id :: Type Source #
The type used to represent existing records.
Methods
listResources :: m [StoredResourceData id] Source #
createResource :: ResourceData id -> m (Either ValidationError (StoredResourceData id)) Source #
readResource :: id -> m (Either NotFoundError (StoredResourceData id)) Source #
upsertResource :: id -> ResourceData id -> m (Either ValidationError (CreatedUpdated, StoredResourceData id)) Source #
deleteResource :: id -> m (Either NotFoundError ()) Source #
data NotFoundError Source #
Constructors
| NotFoundError |
Instances
newtype ValidationError Source #
ActiveResource errors are a map where the keys name fields from the payload, and the values are lists of errors at that field.
The ToJSON instance wraps the whole thing in an { "errors": ... }
object, to match ActiveResource's expectations.
Constructors
| ValidationError (Map Text [Text]) |
Instances
data CreatedUpdated Source #
Instances
data ResourceRoutes (id :: Type) mode Source #
The CRUDL routes required by an ActiveResource API, using Servant's
generic record-based routing.
Once you have a Resource instance, use makeResourceServerT to
generate a server that fills out this structure.
NOTE: If the
alternate syntax
for :- gets merged, we intend to adopt it; it's easier to read.
Constructors
| ResourceRoutes | |
Fields
| |
Instances
makeResourceServerT :: TypeQ -> ExpQ Source #
Given an instance of 'ResourceId ty', plumb through its operations to
build a ResourceRoutes. GHC's type checker
isn't smart enough
to reason through the generated code if it's given a polymorphic
type, so we have to use TH.
If m ~ ResourceMonad ty, then you can call it like this:
myResourceServer ::ResourceRoutesty (AsServerTm) myResourceServer = $(makeResourceServerT [t|ty|])
The generated code will
need -XDataKinds, -XLambdaCase, and -XTypeApplications.
You can then serve it using the functions in Servant.Server.Generic.
errorFormatters :: ErrorFormatters Source #
This is a custom error formatter for parse errors, which runs when Servant fails to deserialise a request parameter (i.e., before endpoint code runs).
Technically, such a parse failure should return HTTP 400 Bad Request, but ActiveResource shows no useful information in such cases. This formatter therefore gives up technical purity in favour of reasonable error messages.
You can use it with servant-server's various ...WithContext functions:
-- Supposing ourResourceMonadis servant-server'sHandlertype, so we -- can passidas the natural transformation parameter:genericServeTWithContextid myResourceServer (errorFormatters:.EmptyContext)