{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RankNTypes #-} module Web.Scotty.Rest.Types ( RestM -- * Callbacks result types , Authorized(..) , DeleteResult(..) , ETag(..) , Moved(..) , ProcessingResult(..) , Representation (..) , RestConfig(..) , RestException(..) , Url -- * Re-exports , MediaType , Language , StdMethod(..) ) where import BasePrelude import Control.Monad.IO.Class (MonadIO) import Data.Default.Class (Default (..), def) 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 RestM 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 RestConfig m = RestConfig { allowedMethods :: m [StdMethod] -- ^ List of allowed methos. -- -- 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 -- ^ Only for `PUT` 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'. -- -- 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: @[]@ } instance (MonadIO m) => Default (RestConfig m) where def = RestConfig { allowedMethods = return [GET, HEAD, OPTIONS] , resourceExists = return True , previouslyExisted = return False , isConflict = return False , contentTypesAccepted = return [] , contentTypesProvided = return [] , languagesProvided = return Nothing , charsetsProvided = return Nothing , deleteResource = return NotDeleted , optionsHandler = return Nothing , generateEtag = return Nothing , expires = return Nothing , lastModified = return Nothing , malformedRequest = return False , isAuthorized = return Authorized , forbidden = return False , serviceAvailable = return True , allowMissingPost = return True , multipleChoices = return UniqueRepresentation , resourceMoved = return NotMoved , variances = return [] } data RestException = MovedPermanently301 | NotModified304 | MovedTemporarily307 | BadRequest400 | Unauthorized401 | Forbidden403 | NotFound404 | NotAcceptable406 | Conflict409 | Gone410 | PreconditionFailed412 | UnsupportedMediaType415 | NotImplemented501 | ServiceUnavailable503 | MethodNotAllowed405 | InternalServerError TL.Text deriving (Show, Eq) instance ScottyError RestException where stringError = InternalServerError . TL.pack showError = fromString . show