Many improvements: still in early development

[Lucu.git] / Network / HTTP / Lucu / Response.hs

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index e61a6a50242779b91c665218ea565cbb85d69955..0e6fbe2d8f2bb120b9f229cc5290db9610cb5957 100644 (file)
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -1,13 +1,16 @@
 module Network.HTTP.Lucu.Response
     ( StatusCode(..)
     , Response(..)
+    , hPutResponse    -- Handle -> Response -> IO ()
+    , isInformational -- StatusCode -> Bool
+    , isError         -- StatusCode -> Bool
     )
     where
 
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
 import           Network.HTTP.Lucu.Headers
 import           Network.HTTP.Lucu.HttpVersion
+import           System.IO
+import           Text.Printf
 
 data StatusCode = Continue
                 | SwitchingProtocols
@@ -59,14 +62,96 @@ data StatusCode = Continue
                 | GatewayTimeout
                 | HttpVersionNotSupported
                 | InsufficientStorage
+                  deriving (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
-    , resBody    :: Maybe ByteString
     }
+                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 :: StatusCode -> Bool
+isInformational sc = let (num, _) = statusCode sc
+                     in num < 200
+
+isError :: StatusCode -> Bool
+isError sc = let (num, _) = statusCode sc
+             in num >= 400
+
+
+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")
\ No newline at end of file