{-# 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