]> gitweb @ CieloNegro.org - Lucu.git/blobdiff - Network/HTTP/Lucu/Response.hs
Implemented fallback handler.
[Lucu.git] / Network / HTTP / Lucu / Response.hs
index b1ad3d8df4a914b1a7900e4d7463a19902421863..fd949fe9af09e8af5997b5ccf2634e5865777743 100644 (file)
@@ -15,6 +15,8 @@ module Network.HTTP.Lucu.Response
     )
     where
 
+import           Data.ByteString.Base (ByteString)
+import qualified Data.ByteString.Char8 as C8
 import           Data.Dynamic
 import           Network.HTTP.Lucu.Format
 import           Network.HTTP.Lucu.Headers
@@ -78,9 +80,9 @@ data StatusCode = Continue
                   deriving (Typeable, Eq)
 
 instance Show StatusCode where
-    show sc = let (# num, msg #) = statusCode sc
-              in
-                (fmtDec 3 num) ++ " " ++ msg
+    show sc = case statusCode sc of
+                (# num, msg #)
+                    -> (fmtDec 3 num) ++ " " ++ C8.unpack msg
 
 
 data Response = Response {
@@ -101,13 +103,18 @@ hPutResponse h res
       do hPutHttpVersion h (resVersion res)
          hPutChar        h ' '
          hPutStatus      h (resStatus  res)
-         hPutStr         h "\r\n"
+         C8.hPut         h (C8.pack "\r\n")
          hPutHeaders     h (resHeaders res)
 
 hPutStatus :: Handle -> StatusCode -> IO ()
 hPutStatus h sc
     = h `seq` sc `seq`
-      hPutStr h (show sc)
+      case statusCode sc of
+        (# num, msg #)
+            -> do hPutStr  h (fmtDec 3 num)
+                  hPutChar h ' '
+                  C8.hPut  h msg
+
 
 -- |@'isInformational' sc@ is 'Prelude.True' iff @sc < 200@.
 isInformational :: StatusCode -> Bool
@@ -141,55 +148,55 @@ doesMeet p sc = case statusCode sc of
 
 -- |@'statusCode' sc@ returns an unboxed 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"          #)
\ No newline at end of file
+statusCode :: StatusCode -> (# Int, 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"          #)
\ No newline at end of file