module Acme.Types where
import Control.Exception.Extensible (Exception)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Internal (c2w)
import Data.Data (Data, Typeable)
import Text.PrettyPrint.HughesPJ (Doc, ($$), (<+>), ($+$), (<>), char, nest, text, vcat)
import Data.Word (Word8)
data HTTPVersion
= HTTP10
| HTTP11
deriving (Eq, Ord, Read, Show, Data, Typeable)
ppHTTPVersion :: HTTPVersion -> Doc
ppHTTPVersion HTTP10 = text "HTTP/1.0"
ppHTTPVersion HTTP11 = text "HTTP/1.1"
data Method
= OPTIONS
| GET
| GETONLY
| HEAD
| POST
| PUT
| DELETE
| TRACE
| CONNECT
| EXTENSION ByteString
deriving (Eq, Ord, Read, Show, Data, Typeable)
ppMethod :: Method -> Doc
ppMethod OPTIONS = text "OPTIONS"
ppMethod GET = text "GET"
ppMethod GETONLY = text "GETONLY"
ppMethod HEAD = text "HEAD"
ppMethod POST = text "POST"
ppMethod PUT = text "PUT"
ppMethod DELETE = text "DELETE"
ppMethod TRACE = text "TRACE"
ppMethod CONNECT = text "CONNECT"
ppMethod (EXTENSION ext) = text (C.unpack ext)
data Request = Request
{ rqMethod :: !Method
, rqURIbs :: !ByteString
, rqHTTPVersion :: !HTTPVersion
, rqHeaders :: ![(ByteString, ByteString)]
, rqSecure :: !Bool
, rqBody :: !ByteString
}
deriving Typeable
instance Show Request where
show = show . ppRequest
ppRequest :: Request -> Doc
ppRequest Request{..} =
text "Request {" $+$
nest 2 (
vcat [ field " rqMethod" (ppMethod rqMethod)
, field ", rqURIbs" (bytestring rqURIbs)
, field ", rqHTTPVersion" (ppHTTPVersion rqHTTPVersion)
, field ", rqHeaders" (vcat $ map ppHeader rqHeaders)
, field ", rqSecure" (text $ show rqSecure)
]) $+$
text "}"
data Response
= PongResponse
| ByteStringResponse
{ rsCode :: !Int
, rsHeaders :: ![(ByteString, ByteString)]
, rsBody :: !ByteString
}
ppResponse :: Response -> Doc
ppResponse PongResponse = text "PongResponse"
ppResponse ByteStringResponse{..} =
text "Response {" $+$
nest 2 (vcat [ field "rsCode" (text $ show rsCode)
, field "rsHeaders" (text $ show rsCode)
, field "rsBody" (text $ show rsBody)
]) $+$
text "}"
instance Show Response where
show = show . ppResponse
data ConnectionClosed
= ConnectionClosed
deriving (Typeable, Show)
instance Exception ConnectionClosed
bytestring :: ByteString -> Doc
bytestring = text . C.unpack
field :: String
-> Doc
-> Doc
field name doc = text name $$ nest 15 (char '=' <+> doc)
ppHeader :: (ByteString, ByteString) -> Doc
ppHeader (fieldName, fieldValue) =
bytestring fieldName <> char ':' <> bytestring fieldValue
colon, cr, nl, space :: Word8
colon = c2w ':'
cr = c2w '\r'
nl = c2w '\n'
space = c2w ' '