module Network.Protocol.Http.Status where
import Data.Bimap
import Data.Maybe
import Prelude hiding (lookup)
data Status =
Continue
| SwitchingProtocols
| OK
| Created
| Accepted
| NonAuthoritativeInformation
| NoContent
| ResetContent
| PartialContent
| MultipleChoices
| MovedPermanently
| Found
| SeeOther
| NotModified
| UseProxy
| TemporaryRedirect
| BadRequest
| Unauthorized
| PaymentRequired
| Forbidden
| NotFound
| MethodNotAllowed
| NotAcceptable
| ProxyAuthenticationRequired
| RequestTimeOut
| Conflict
| Gone
| LengthRequired
| PreconditionFailed
| RequestEntityTooLarge
| RequestURITooLarge
| UnsupportedMediaType
| RequestedRangeNotSatisfiable
| ExpectationFailed
| InternalServerError
| NotImplemented
| BadGateway
| ServiceUnavailable
| GatewayTimeOut
| HTTPVersionNotSupported
| CustomStatus Int String
deriving (Eq, Ord)
instance Show Status where
show Continue = "Continue"
show SwitchingProtocols = "Switching Protocols"
show OK = "OK"
show Created = "Created"
show Accepted = "Accepted"
show NonAuthoritativeInformation = "Non-Authoritative Information"
show NoContent = "No Content"
show ResetContent = "Reset Content"
show PartialContent = "Partial Content"
show MultipleChoices = "Multiple Choices"
show MovedPermanently = "Moved Permanently"
show Found = "Found"
show SeeOther = "See Other"
show NotModified = "Not Modified"
show UseProxy = "Use Proxy"
show TemporaryRedirect = "Temporary Redirect"
show BadRequest = "Bad Request"
show Unauthorized = "Unauthorized"
show PaymentRequired = "Payment Required"
show Forbidden = "Forbidden"
show NotFound = "Not Found"
show MethodNotAllowed = "Method Not Allowed"
show NotAcceptable = "Not Acceptable"
show ProxyAuthenticationRequired = "Proxy Authentication Required"
show RequestTimeOut = "Request Time-out"
show Conflict = "Conflict"
show Gone = "Gone"
show LengthRequired = "Length Required"
show PreconditionFailed = "Precondition Failed"
show RequestEntityTooLarge = "Request Entity Too Large"
show RequestURITooLarge = "Request-URI Too Large"
show UnsupportedMediaType = "Unsupported Media Type"
show RequestedRangeNotSatisfiable = "Requested range not satisfiable"
show ExpectationFailed = "Expectation Failed"
show InternalServerError = "Internal Server Error"
show NotImplemented = "Not Implemented"
show BadGateway = "Bad Gateway"
show ServiceUnavailable = "Service Unavailable"
show GatewayTimeOut = "Gateway Time-out"
show HTTPVersionNotSupported = "HTTP Version not supported"
show (CustomStatus _ s) = s
statusCodes :: Bimap Int Status
statusCodes = fromList [
(100, Continue)
, (101, SwitchingProtocols)
, (200, OK)
, (201, Created)
, (202, Accepted)
, (203, NonAuthoritativeInformation)
, (204, NoContent)
, (205, ResetContent)
, (206, PartialContent)
, (300, MultipleChoices)
, (301, MovedPermanently)
, (302, Found)
, (303, SeeOther)
, (304, NotModified)
, (305, UseProxy)
, (307, TemporaryRedirect)
, (400, BadRequest)
, (401, Unauthorized)
, (402, PaymentRequired)
, (403, Forbidden)
, (404, NotFound)
, (405, MethodNotAllowed)
, (406, NotAcceptable)
, (407, ProxyAuthenticationRequired)
, (408, RequestTimeOut)
, (409, Conflict)
, (410, Gone)
, (411, LengthRequired)
, (412, PreconditionFailed)
, (413, RequestEntityTooLarge)
, (414, RequestURITooLarge)
, (415, UnsupportedMediaType)
, (416, RequestedRangeNotSatisfiable)
, (417, ExpectationFailed)
, (500, InternalServerError)
, (501, NotImplemented)
, (502, BadGateway)
, (503, ServiceUnavailable)
, (504, GatewayTimeOut)
, (505, HTTPVersionNotSupported)
]
statusFailure :: Status -> Bool
statusFailure st = codeFromStatus st >= 400
statusFromCode :: Int -> Status
statusFromCode num =
fromMaybe (CustomStatus num "Unknown Status")
$ lookup num statusCodes
codeFromStatus :: Status -> Int
codeFromStatus (CustomStatus i _) = i
codeFromStatus st =
fromMaybe 0
$ lookupR st statusCodes