{-# LANGUAGE
    DeriveDataTypeable
  , OverloadedStrings
  , RecordWildCards
  , UnboxedTuples
  , UnicodeSyntax
  , ViewPatterns
  #-}

-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
    ( StatusCode(..)
    , printStatusCode

    , Response(..)
    , emptyResponse
    , resCanHaveBody
    , printResponse

    , isInformational
    , isSuccessful
    , isRedirection
    , isError
    , isClientError
    , isServerError

    , statusCode
    )
    where
import Data.Ascii (Ascii, AsciiBuilder)
import qualified Data.Ascii as A
import Data.Monoid.Unicode
import Data.Typeable
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
import Network.HTTP.Lucu.Utils
import Prelude.Unicode

-- |This is the definition of HTTP status code.
-- 'Network.HTTP.Lucu.Resource.setStatus' accepts these named statuses
-- so you don't have to memorize, for instance, that \"Gateway
-- Timeout\" is 504.
data StatusCode = Continue
                | SwitchingProtocols
                | Processing
                -- 
                | Ok
                | Created
                | Accepted
                | NonAuthoritativeInformation
                | NoContent
                | ResetContent
                | PartialContent
                | MultiStatus
                --
                | MultipleChoices
                | MovedPermanently
                | Found
                | SeeOther
                | NotModified
                | UseProxy
                | TemporaryRedirect
                --
                | BadRequest
                | Unauthorized
                | PaymentRequired
                | Forbidden
                | NotFound
                | MethodNotAllowed
                | NotAcceptable
                | ProxyAuthenticationRequired
                | RequestTimeout
                | Conflict
                | Gone
                | LengthRequired
                | PreconditionFailed
                | RequestEntityTooLarge
                | RequestURITooLarge
                | UnsupportedMediaType
                | RequestRangeNotSatisfiable
                | ExpectationFailed
                | UnprocessableEntitiy
                | Locked
                | FailedDependency
                --
                | InternalServerError
                | NotImplemented
                | BadGateway
                | ServiceUnavailable
                | GatewayTimeout
                | HttpVersionNotSupported
                | InsufficientStorage
                  deriving (Eq, Show, Typeable)

-- |Convert a 'StatusCode' to 'AsciiBuilder'.
printStatusCode ∷ StatusCode → AsciiBuilder
{-# INLINEABLE printStatusCode #-}
printStatusCode (statusCode → (# num, msg #))
    = ( show3 num            ⊕
        A.toAsciiBuilder " " ⊕
        A.toAsciiBuilder msg
      )

data Response = Response {
      resVersion ∷ !HttpVersion
    , resStatus  ∷ !StatusCode
    , resHeaders ∷ !Headers
    } deriving (Show, Eq)

instance HasHeaders Response where
    getHeaders         = resHeaders
    setHeaders res hdr = res { resHeaders = hdr }

-- |Returns an HTTP\/1.1 'Response' with no header fields.
emptyResponse ∷ StatusCode → Response
emptyResponse sc
    = Response {
        resVersion = HttpVersion 1 1
      , resStatus  = sc
      , resHeaders = (∅)
      }

-- |Returns 'True' iff a given 'Response' allows the existence of
-- response entity body.
resCanHaveBody ∷ Response → Bool
{-# INLINEABLE resCanHaveBody #-}
resCanHaveBody (Response {..})
    | isInformational resStatus = False
    | resStatus ≡ NoContent     = False
    | resStatus ≡ ResetContent  = False
    | resStatus ≡ NotModified   = False
    | otherwise                 = True

-- |Convert a 'Response' to 'AsciiBuilder'.
printResponse ∷ Response → AsciiBuilder
{-# INLINEABLE printResponse #-}
printResponse (Response {..})
    = printHttpVersion resVersion ⊕
      A.toAsciiBuilder " "        ⊕
      printStatusCode  resStatus  ⊕
      A.toAsciiBuilder "\x0D\x0A" ⊕
      printHeaders     resHeaders

-- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
isInformational ∷ StatusCode → Bool
{-# INLINE isInformational #-}
isInformational = satisfy (< 200)

-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
isSuccessful ∷ StatusCode → Bool
{-# INLINE isSuccessful #-}
isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)

-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
isRedirection ∷ StatusCode → Bool
{-# INLINE isRedirection #-}
isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)

-- |@'isError' sc@ returns 'True' iff @400 <= sc@
isError ∷ StatusCode → Bool
{-# INLINE isError #-}
isError = satisfy (≥ 400)

-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
isClientError ∷ StatusCode → Bool
{-# INLINE isClientError #-}
isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)

-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
isServerError ∷ StatusCode → Bool
{-# INLINE isServerError #-}
isServerError = satisfy (≥ 500)

satisfy ∷ (Int → Bool) → StatusCode → Bool
{-# INLINE satisfy #-}
satisfy p (statusCode → (# num, _ #)) = p num

-- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
-- representation of @sc@.
statusCode ∷ StatusCode → (# Int, Ascii #)
{-# INLINEABLE statusCode #-}

statusCode Continue                    = (# 100, "Continue"                      #)
statusCode SwitchingProtocols          = (# 101, "Switching Protocols"           #)
statusCode Processing                  = (# 102, "Processing"                    #)

statusCode Ok                          = (# 200, "OK"                            #)
statusCode Created                     = (# 201, "Created"                       #)
statusCode Accepted                    = (# 202, "Accepted"                      #)
statusCode NonAuthoritativeInformation = (# 203, "Non Authoritative Information" #)
statusCode NoContent                   = (# 204, "No Content"                    #)
statusCode ResetContent                = (# 205, "Reset Content"                 #)
statusCode PartialContent              = (# 206, "Partial Content"               #)
statusCode MultiStatus                 = (# 207, "Multi Status"                  #)

statusCode MultipleChoices             = (# 300, "Multiple Choices"              #)
statusCode MovedPermanently            = (# 301, "Moved Permanently"             #)
statusCode Found                       = (# 302, "Found"                         #)
statusCode SeeOther                    = (# 303, "See Other"                     #)
statusCode NotModified                 = (# 304, "Not Modified"                  #)
statusCode UseProxy                    = (# 305, "Use Proxy"                     #)
statusCode TemporaryRedirect           = (# 306, "Temporary Redirect"            #)

statusCode BadRequest                  = (# 400, "Bad Request"                   #)
statusCode Unauthorized                = (# 401, "Unauthorized"                  #)
statusCode PaymentRequired             = (# 402, "Payment Required"              #)
statusCode Forbidden                   = (# 403, "Forbidden"                     #)
statusCode NotFound                    = (# 404, "Not Found"                     #)
statusCode MethodNotAllowed            = (# 405, "Method Not Allowed"            #)
statusCode NotAcceptable               = (# 406, "Not Acceptable"                #)
statusCode ProxyAuthenticationRequired = (# 407, "Proxy Authentication Required" #)
statusCode RequestTimeout              = (# 408, "Request Timeout"               #)
statusCode Conflict                    = (# 409, "Conflict"                      #)
statusCode Gone                        = (# 410, "Gone"                          #)
statusCode LengthRequired              = (# 411, "Length Required"               #)
statusCode PreconditionFailed          = (# 412, "Precondition Failed"           #)
statusCode RequestEntityTooLarge       = (# 413, "Request Entity Too Large"      #)
statusCode RequestURITooLarge          = (# 414, "Request URI Too Large"         #)
statusCode UnsupportedMediaType        = (# 415, "Unsupported Media Type"        #)
statusCode RequestRangeNotSatisfiable  = (# 416, "Request Range Not Satisfiable" #)
statusCode ExpectationFailed           = (# 417, "Expectation Failed"            #)
statusCode UnprocessableEntitiy        = (# 422, "Unprocessable Entity"          #)
statusCode Locked                      = (# 423, "Locked"                        #)
statusCode FailedDependency            = (# 424, "Failed Dependency"             #)

statusCode InternalServerError         = (# 500, "Internal Server Error"         #)
statusCode NotImplemented              = (# 501, "Not Implemented"               #)
statusCode BadGateway                  = (# 502, "Bad Gateway"                   #)
statusCode ServiceUnavailable          = (# 503, "Service Unavailable"           #)
statusCode GatewayTimeout              = (# 504, "Gateway Timeout"               #)
statusCode HttpVersionNotSupported     = (# 505, "HTTP Version Not Supported"    #)
statusCode InsufficientStorage         = (# 507, "Insufficient Storage"          #)