-- #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           Data.Dynamic
import           Network.HTTP.Lucu.Headers
import           Network.HTTP.Lucu.HttpVersion
import           System.IO
import           Text.Printf

-- |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 = let (num, msg) = statusCode sc
              in
                printf "%03d %s" num 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 :: Handle -> Response -> IO ()
hPutResponse h res = do hPutHttpVersion h (resVersion res)
                        hPutChar        h ' '
                        hPutStatus      h (resStatus  res)
                        hPutStr         h "\r\n"
                        hPutHeaders     h (resHeaders res)

hPutStatus :: Handle -> StatusCode -> IO ()
hPutStatus h sc = let (num, msg) = statusCode sc
                  in
                    hPrintf h "%03d %s" num msg

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

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

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

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

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

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


doesMeet :: (Int -> Bool) -> StatusCode -> Bool
doesMeet p sc = let (num, _) = statusCode sc
                in
                  p num


-- |@'statusCode' sc@ returns a tuple of numeric and textual
-- representation of @sc@.
statusCode :: StatusCode -> (Int, String)
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")