X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FResponse.hs;h=5c25b543006a7320a6ec05968aa02d3eda6eb848;hb=9668dc27a02b59d7bfb1e9e40af3d2619700ad69;hp=e61a6a50242779b91c665218ea565cbb85d69955;hpb=9961a721f98b101825ef154a2122c1fc2fa6d1ac;p=Lucu.git

diff --git a/Network/HTTP/Lucu/Response.hs b/Network/HTTP/Lucu/Response.hs
index e61a6a5..5c25b54 100644
--- a/Network/HTTP/Lucu/Response.hs
+++ b/Network/HTTP/Lucu/Response.hs
@@ -1,14 +1,45 @@
+{-# LANGUAGE
+    DeriveDataTypeable
+  , OverloadedStrings
+  , RecordWildCards
+  , UnboxedTuples
+  , UnicodeSyntax
+  , ViewPatterns
+  #-}
+
+-- |Definition of things related on HTTP response.
 module Network.HTTP.Lucu.Response
     ( StatusCode(..)
+    , printStatusCode
+
     , Response(..)
+    , emptyResponse
+    , resCanHaveBody
+    , printResponse
+
+    , isInformational
+    , isSuccessful
+    , isRedirection
+    , isError
+    , isClientError
+    , isServerError
+
+    , statusCode
     )
     where
+import Data.Ascii (Ascii, AsciiBuilder)
+import qualified Data.Ascii as A
+import Data.Monoid.Unicode
+import Data.Typeable
+import Network.HTTP.Lucu.Headers
+import Network.HTTP.Lucu.HttpVersion
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
 
-import qualified Data.ByteString.Lazy.Char8 as B
-import           Data.ByteString.Lazy.Char8 (ByteString)
-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 status
+-- codes so you don't have to memorize, for instance, that \"Gateway
+-- Timeout\" is 504.
 data StatusCode = Continue
                 | SwitchingProtocols
                 | Processing
@@ -59,14 +90,144 @@ data StatusCode = Continue
                 | GatewayTimeout
                 | HttpVersionNotSupported
                 | InsufficientStorage
+                  deriving (Eq, Show, Typeable)
+
+-- |Convert a 'StatusCode' to an 'AsciiBuilder'.
+printStatusCode ∷ StatusCode → AsciiBuilder
+{-# INLINEABLE printStatusCode #-}
+printStatusCode (statusCode → (# num, msg #))
+    = ( show3 num            ⊕
+        A.toAsciiBuilder " " ⊕
+        A.toAsciiBuilder msg
+      )
 
+-- |This is the definition of an HTTP response.
 data Response = Response {
-      resVersion :: HttpVersion
-    , resStatus  :: StatusCode
-    , resHeaders :: Headers
-    , resBody    :: Maybe ByteString
-    }
+      resVersion ∷ !HttpVersion
+    , resStatus  ∷ !StatusCode
+    , resHeaders ∷ !Headers
+    } deriving (Show, Eq)
 
 instance HasHeaders Response where
-    getHeaders = resHeaders
+    getHeaders         = resHeaders
     setHeaders res hdr = res { resHeaders = hdr }
+
+-- |Returns an HTTP\/1.1 'Response' with no header fields.
+emptyResponse ∷ StatusCode → Response
+emptyResponse sc
+    = Response {
+        resVersion = HttpVersion 1 1
+      , resStatus  = sc
+      , resHeaders = (∅)
+      }
+
+-- |Returns 'True' iff a given 'Response' allows the existence of
+-- response entity body.
+resCanHaveBody ∷ Response → Bool
+{-# INLINEABLE resCanHaveBody #-}
+resCanHaveBody (Response {..})
+    | isInformational resStatus = False
+    | resStatus ≡ NoContent     = False
+    | resStatus ≡ ResetContent  = False
+    | resStatus ≡ NotModified   = False
+    | otherwise                 = True
+
+-- |Convert a 'Response' to 'AsciiBuilder'.
+printResponse ∷ Response → AsciiBuilder
+{-# INLINEABLE printResponse #-}
+printResponse (Response {..})
+    = printHttpVersion resVersion ⊕
+      A.toAsciiBuilder " "        ⊕
+      printStatusCode  resStatus  ⊕
+      A.toAsciiBuilder "\x0D\x0A" ⊕
+      printHeaders     resHeaders
+
+-- |@'isInformational' sc@ returns 'True' iff @sc < 200@.
+isInformational ∷ StatusCode → Bool
+{-# INLINE isInformational #-}
+isInformational = satisfy (< 200)
+
+-- |@'isSuccessful' sc@ returns 'True' iff @200 <= sc < 300@.
+isSuccessful ∷ StatusCode → Bool
+{-# INLINE isSuccessful #-}
+isSuccessful = satisfy (\ n → n ≥ 200 ∧ n < 300)
+
+-- |@'isRedirection' sc@ returns 'True' iff @300 <= sc < 400@.
+isRedirection ∷ StatusCode → Bool
+{-# INLINE isRedirection #-}
+isRedirection = satisfy (\ n → n ≥ 300 ∧ n < 400)
+
+-- |@'isError' sc@ returns 'True' iff @400 <= sc@
+isError ∷ StatusCode → Bool
+{-# INLINE isError #-}
+isError = satisfy (≥ 400)
+
+-- |@'isClientError' sc@ returns 'True' iff @400 <= sc < 500@.
+isClientError ∷ StatusCode → Bool
+{-# INLINE isClientError #-}
+isClientError = satisfy (\ n → n ≥ 400 ∧ n < 500)
+
+-- |@'isServerError' sc@ returns 'True' iff @500 <= sc@.
+isServerError ∷ StatusCode → Bool
+{-# INLINE isServerError #-}
+isServerError = satisfy (≥ 500)
+
+satisfy ∷ (Int → Bool) → StatusCode → Bool
+{-# INLINE satisfy #-}
+satisfy p (statusCode → (# num, _ #)) = p num
+
+-- |@'statusCode' sc@ returns an unboxed tuple of numeric and textual
+-- representation of @sc@.
+statusCode ∷ StatusCode → (# Int, Ascii #)
+{-# INLINEABLE statusCode #-}
+
+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"          #)