module Types where
import Control.Proxy
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C
import Data.Data
import Network.Socket (SockAddr)
import Text.PrettyPrint.HughesPJ
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)
type MessageBody = ByteString
data Request = Request
{ rqMethod :: !Method
, rqURIbs :: !ByteString
, rqHTTPVersion :: !HTTPVersion
, rqHeaders :: ![(ByteString, ByteString)]
, rqSecure :: !Bool
, rqClient :: !SockAddr
}
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 "}"
ppHeader :: (ByteString, ByteString) -> Doc
ppHeader (fieldName, fieldValue) =
bytestring fieldName <> char ':' <> bytestring fieldValue
data Response m = Response
{ rsCode :: !Int
, rsHeaders :: [(ByteString, ByteString)]
, rsBody :: Pipe ProxyFast ByteString MessageBody m ()
}
instance Show (Response m) where
show = show . ppResponse
ppResponse :: Response m -> Doc
ppResponse Response{..} =
text "Response {" $+$
nest 2 (vcat [ field "rsCode" (text $ show rsCode)
, field "rsHeaders" (vcat $ map ppHeader rsHeaders)
]) $+$
text "}"
bytestring :: ByteString -> Doc
bytestring = text . C.unpack
field :: String -> Doc -> Doc
field name doc = text name $$ nest 20 (char '=' <+> doc)