{-# OPTIONS_HADDOCK prune #-}

-- |Definition of things related on HTTP response.
module Network.HTTP.Lucu.Response
    ( StatusCode(..)
    , Response(..)
    , hPutResponse
    , isInformational
    , isSuccessful
    , isRedirection
    , isError
    , isClientError
    , isServerError
    , statusCode
    )
    where

import qualified Data.ByteString as Strict (ByteString)
import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
import           Data.Dynamic
import           Network.HTTP.Lucu.Format
import           Network.HTTP.Lucu.HandleLike
import           Network.HTTP.Lucu.Headers
import           Network.HTTP.Lucu.HttpVersion

-- |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 (Typeable, Eq)

instance Show StatusCode where
    show sc = case statusCode sc of
                (# num, msg #)
                    -> (fmtDec 3 num) ++ " " ++ C8.unpack 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 }


hPutResponse :: HandleLike h => h -> Response -> IO ()
hPutResponse h res
    = h `seq` res `seq`
      do hPutHttpVersion h (resVersion res)
         hPutChar        h ' '
         hPutStatus      h (resStatus  res)
         hPutBS          h (C8.pack "\r\n")
         hPutHeaders     h (resHeaders res)

hPutStatus :: HandleLike h => h -> StatusCode -> IO ()
hPutStatus h sc
    = h `seq` sc `seq`
      case statusCode sc of
        (# num, msg #)
            -> do hPutStr  h (fmtDec 3 num)
                  hPutChar h ' '
                  hPutBS   h msg


-- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
isInformational :: StatusCode -> Bool
isInformational = doesMeet (< 200)

-- |@'isSuccessful' sc@ is 'Prelude.True' iff @200 <= sc < 300@.
isSuccessful :: StatusCode -> Bool
isSuccessful = doesMeet (\ n -> n >= 200 && n < 300)

-- |@'isRedirection' sc@ is 'Prelude.True' iff @300 <= sc < 400@.
isRedirection :: StatusCode -> Bool
isRedirection = doesMeet (\ n -> n >= 300 && n < 400)

-- |@'isError' sc@ is 'Prelude.True' iff @400 <= sc@
isError :: StatusCode -> Bool
isError = doesMeet (>= 400)

-- |@'isClientError' sc@ is 'Prelude.True' iff @400 <= sc < 500@.
isClientError :: StatusCode -> Bool
isClientError = doesMeet (\ n -> n >= 400 && n < 500)

-- |@'isServerError' sc@ is 'Prelude.True' iff @500 <= sc@.
isServerError :: StatusCode -> Bool
isServerError = doesMeet (>= 500)


doesMeet :: (Int -> Bool) -> StatusCode -> Bool
doesMeet p sc = case statusCode sc of
                  (# num, _ #) -> p num


-- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
-- representation of @sc@.
statusCode :: StatusCode -> (# Int, Strict.ByteString #)

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

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

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

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

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