{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} module Web.Scotty.Rest.Types ( RestT -- * Callbacks result types , Authorized(..) , DeleteResult(..) , ETag(..) , Moved(..) , ProcessingResult(..) , Representation (..) , EndpointConfig(..) , RestException(..) , Url -- * Re-exports , MediaType , Language , StdMethod(..) ) where import BasePrelude import qualified Data.Text.Lazy as TL import Data.Time.Clock (UTCTime) import Network.HTTP.Media (Language, MediaType) import Network.HTTP.Types (StdMethod (..)) import Web.Scotty.Trans hiding (get) type RestT m = ActionT RestException m -- | A URL. type Url = TL.Text -- | Result of the 'resourceMoved' callback. data Moved = NotMoved -- ^ Resource has not moved. | MovedTemporarily !Url -- ^ Resource has been temporarily moved to the given URL. | MovedPermanently !Url -- ^ Resource has been permanently moved to the given URL. -- | An ETag validator generated by the 'generateEtag' callback. data ETag = Strong TL.Text -- ^ A strong ETag validator | Weak TL.Text -- ^ A weak ETag validator -- | Result of a Processing request (e.g. `POST`, `PUT`, `PATCH`) data ProcessingResult = Succeeded -- ^ Processing succeeded. Returns __204 No Content__ or __201 Created__ based -- on whether the resource existed previously or not. | SucceededWithContent !MediaType !TL.Text -- ^ Processing succeeded with the given content. Returns __201 Created__ or -- __200 OK/300 Multiple Representations__ based on whether the resource -- existed previously or not. | SucceededWithLocation !Url -- ^ Processing succeeded with the given content. Returns __201 Created__ or -- __200 OK/300 Multiple Representations__ based on whether the resource -- existed previously or not. | Redirect !Url -- ^ Redirects (with __303 See Other__) to the given URL. | Failed -- ^ Processing failed. Returns __400 Bad Request__. -- | Response to 'multipleChoices' callback. data Representation = UniqueRepresentation -- ^ The resource has a unique representation. | MultipleRepresentations !MediaType !TL.Text -- ^ There are multiple representations of this resource. Respond with the -- given body. | MultipleWithPreferred !MediaType !TL.Text !Url -- ^ There are multiple representations of this resource, but one is preferred. -- Respond with the given body, and 'Url' (in the `Location` header). -- | Response to 'deleteResource' callback. data DeleteResult = NotDeleted -- ^ The resource could not be deleted. | Deleted -- ^ The deletion operation has been fully completed. | DeletedWithResponse !MediaType !TL.Text -- ^ The deletion operation has been fully completed. Respond with the given body. | DeleteEnacted -- ^ Accepted for processing, but the processing has not been completed (and may never be). -- | Response to 'isAuthorized' callback. data Authorized = Authorized -- ^ User is authenticated and authorized. | NotAuthorized !TL.Text -- ^ User is not authorized. The given challenge will be -- sent as part of the /WWW-Authenticate/ header. -- | The callbacks that control a handler's behaviour. 'Scotty.Rest.defaultConfig' returns a config -- with default values. For typical handlers, you only need to override a few of these callbacks. data EndpointConfig m = EndpointConfig { allowedMethods :: m [StdMethod] -- ^ List of allowed methods. -- -- Default: @[GET, HEAD, OPTIONS]@ , resourceExists :: m Bool -- ^ Does this resource exist? -- -- Default: 'True' , previouslyExisted :: m Bool -- ^ Did this resource exist previously? -- -- Default: 'False' , isConflict :: m Bool -- ^ For `PUT`/`PATCH` requests: Does this request result in a conflict? -- -- Default: 'False' , contentTypesAccepted :: m [(MediaType, m ProcessingResult)] -- ^ A list of the content types /accepted/, together with handlers producing a 'ProcessingResult' -- for that 'MediaType'. -- -- Default: @[]@ , contentTypesProvided :: m [(MediaType, m ())] -- ^ A list of the content types /provided/, together with handlers producing a response body for -- that 'MediaType'. The first one that matches the `Accept` header passed by the client will be -- chosen, which could make a difference e.g. with `Accept: */*` or `Accept: audio/*`. -- -- Default: @[]@ , languagesProvided :: m (Maybe [Language]) -- ^ A list of the languages provided in order of preference. If the `Accept-Language` header was -- not sent, the first charset is selected. If 'Nothing', the `Accept-Language` header is ignored. -- -- Default: 'Nothing' , charsetsProvided :: m (Maybe [TL.Text]) -- ^ A list of the character sets provided in order of preference. If the `Accept-Charset` header -- was not sent, the first charset is selected. If 'Nothing', the `Accept-Charset` header is -- ignored. -- -- Default: 'Nothing' , deleteResource :: m DeleteResult -- ^ A handler for `DELETE` requests. The handler is responsible for deleting the resource and -- returning a 'DeleteResult'. -- -- Default: 'NotDeleted' , optionsHandler :: m (Maybe (MediaType, m ())) -- ^ A handler for `OPTIONS` requests. If implemented, the handler will be run (possibly producing -- a body), and the given media type will be sent in the `Content-Type` header. When 'Nothing', -- the `Allow` header will be sent with the allowed methods (from 'allowedMethods'). -- -- Default: 'Nothing' , generateEtag :: m (Maybe ETag) -- ^ An ETag for the resource. -- -- Default: 'Nothing' , expires :: m (Maybe UTCTime) -- ^ When the resource expires (if ever). This will be sent in the `expires` header. -- -- Default: 'Nothing' , lastModified :: m (Maybe UTCTime) -- ^ When the resource was last modified. -- -- Default: 'Nothing' , malformedRequest :: m Bool -- ^ If 'True', the request is considered malformed and a __400 Bad Request__ is returned. -- -- Default: 'False' , isAuthorized :: m Authorized -- ^ Is authentication is required, and has it failed or has not been provided? -- -- Default: 'Authorized' , forbidden :: m Bool -- ^ If 'True', access to this resource is forbidden, and __403 Forbidden__ is returned. -- -- Default: 'False'. , serviceAvailable :: m Bool -- ^ Is the service available? -- -- Default 'True' , allowMissingPost :: m Bool -- ^ Do we allow `POST`ing to this resource if it does not exist? -- -- Default 'True' , multipleChoices :: m Representation -- ^ Are there multiple representations for this resource? -- -- Default: 'UniqueRepresentation' , resourceMoved :: m Moved -- ^ Has this resource moved? -- -- Default: 'NotMoved' , variances :: m [TL.Text] -- ^ Returns a list of header names that should be included in a given response's /Vary/ header. -- The standard content negotiation headers (/Accept/, /Accept-Encoding/, /Accept-Charset/, -- /Accept-Language/) do not need to be specified here as they will be added automatically when -- e.g. several content types are provided. -- -- Default: @[]@ } data RestException = MovedPermanently301 | NotModified304 | MovedTemporarily307 | BadRequest400 | Unauthorized401 | Forbidden403 | NotFound404 | NotAcceptable406 | Conflict409 | Gone410 | PreconditionFailed412 | UnsupportedMediaType415 | NotImplemented501 | ServiceUnavailable503 | MethodNotAllowed405 | InternalServerError TL.Text deriving (Show) instance ScottyError RestException where stringError = InternalServerError . TL.pack showError (InternalServerError message) = "Internal server error: " <> message showError err = (fromString . show) err