module Network.HTTP.Types
(
HttpCIByteString(..)
, mkHttpCIByteString
, Method
, methodGet
, methodPost
, methodHead
, methodPut
, methodDelete
, methodTrace
, methodConnect
, methodOptions
, MethodADT(GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS)
, methodToADT
, methodFromADT
, stringToMethodADT
, methodADTToString
, HttpVersion(..)
, http09
, http10
, http11
, Status(..)
, status200, statusOK
, status201, statusCreated
, status301, statusMovedPermanently
, status302, statusFound
, status303, statusSeeOther
, status400, statusBadRequest
, status401, statusUnauthorized
, status403, statusForbidden
, status404, statusNotFound
, status405, statusNotAllowed
, status500, statusServerError
, RequestHeaders
, ResponseHeaders
, Query
, QuerySimple
)
where
import Data.Char
import Data.Maybe
import Data.String
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as Ascii
localError :: String -> String -> a
localError f s = error $ "Network.HTTP.Types." ++ f ++ ": " ++ s
data HttpCIByteString
= HttpCIByteString {
ciOriginal :: !B.ByteString
, ciLowerCase :: !B.ByteString
}
mkHttpCIByteString :: B.ByteString -> HttpCIByteString
mkHttpCIByteString orig = HttpCIByteString {
ciOriginal = orig
, ciLowerCase = Ascii.map toLower orig
}
instance Eq HttpCIByteString where
HttpCIByteString { ciLowerCase = a } == HttpCIByteString { ciLowerCase = b }
= a == b
instance Ord HttpCIByteString where
compare HttpCIByteString { ciLowerCase = a } HttpCIByteString { ciLowerCase = b }
= compare a b
instance Show HttpCIByteString where
show = show . ciOriginal
instance IsString HttpCIByteString where
fromString = mkHttpCIByteString . Ascii.pack
type Method = B.ByteString
methodGet, methodPost, methodHead, methodPut, methodDelete, methodTrace, methodConnect, methodOptions :: Method
methodGet = Ascii.pack "GET"
methodPost = Ascii.pack "POST"
methodHead = Ascii.pack "HEAD"
methodPut = Ascii.pack "PUT"
methodDelete = Ascii.pack "DELETE"
methodTrace = Ascii.pack "TRACE"
methodConnect = Ascii.pack "CONNECT"
methodOptions = Ascii.pack "OPTIONS"
data MethodADT
= GET
| POST
| HEAD
| PUT
| DELETE
| TRACE
| CONNECT
| OPTIONS
| OtherMethod B.ByteString
deriving (Show, Eq, Ord)
methodListA :: [(Method, MethodADT)]
methodListA
= [ (methodGet, GET)
, (methodPost, POST)
, (methodHead, HEAD)
, (methodPut, PUT)
, (methodDelete, DELETE)
, (methodTrace, TRACE)
, (methodConnect, CONNECT)
, (methodOptions, OPTIONS)
]
methodListB :: [(MethodADT, Method)]
methodListB = map (\(a, b) -> (b, a)) methodListA
methodToADT :: Method -> MethodADT
methodToADT bs = fromMaybe (OtherMethod bs) $ lookup bs methodListA
methodFromADT :: MethodADT -> Method
methodFromADT m
= case m of
OtherMethod bs -> bs
_ -> fromMaybe (localError "methodToByteString" "This should not happen (methodListB is incomplete)") $
lookup m methodListB
stringToMethodADT :: String -> MethodADT
stringToMethodADT = methodToADT . Ascii.pack
methodADTToString :: MethodADT -> String
methodADTToString = Ascii.unpack . methodFromADT
data HttpVersion
= HttpVersion {
httpMajor :: !Int
, httpMinor :: !Int
}
deriving (Eq, Ord)
instance Show HttpVersion where
show (HttpVersion major minor) = "HTTP/" ++ show major ++ "." ++ show minor
http09 :: HttpVersion
http09 = HttpVersion 0 9
http10 :: HttpVersion
http10 = HttpVersion 1 0
http11 :: HttpVersion
http11 = HttpVersion 1 1
data Status
= Status {
statusCode :: Int
, statusMessage :: B.ByteString
}
deriving (Show)
instance Eq Status where
Status { statusCode = a } == Status { statusCode = b } = a == b
instance Ord Status where
compare Status { statusCode = a } Status { statusCode = b } = a `compare` b
status200, statusOK :: Status
status200 = Status 200 $ Ascii.pack "OK"
statusOK = status200
status201, statusCreated :: Status
status201 = Status 200 $ Ascii.pack "Created"
statusCreated = status201
status301, statusMovedPermanently :: Status
status301 = Status 301 $ Ascii.pack "Moved Permanently"
statusMovedPermanently = status301
status302, statusFound :: Status
status302 = Status 302 $ Ascii.pack "Found"
statusFound = status302
status303, statusSeeOther :: Status
status303 = Status 303 $ Ascii.pack "See Other"
statusSeeOther = status303
status400, statusBadRequest :: Status
status400 = Status 400 $ Ascii.pack "Bad Request"
statusBadRequest = status400
status401, statusUnauthorized :: Status
status401 = Status 401 $ Ascii.pack "Unauthorized"
statusUnauthorized = status401
status403, statusForbidden :: Status
status403 = Status 403 $ Ascii.pack "Forbidden"
statusForbidden = status403
status404, statusNotFound :: Status
status404 = Status 404 $ Ascii.pack "Not Found"
statusNotFound = status404
status405, statusNotAllowed :: Status
status405 = Status 405 $ Ascii.pack "Method Not Allowed"
statusNotAllowed = status405
status500, statusServerError :: Status
status500 = Status 500 $ Ascii.pack "Internal Server Error"
statusServerError = status500
type RequestHeaders = [(HttpCIByteString, B.ByteString)]
type ResponseHeaders = [(HttpCIByteString, B.ByteString)]
type Query = [(B.ByteString, Maybe B.ByteString)]
type QuerySimple = [(B.ByteString, B.ByteString)]