module Network.Wai
(
Method (..)
, methodFromBS
, methodToBS
, UrlScheme (..)
, HttpVersion (..)
, httpVersionFromBS
, httpVersionToBS
, RequestHeader (..)
, requestHeader
, requestHeaderFromBS
, requestHeaderToBS
, requestHeaderToLower
, ResponseHeader (..)
, responseHeader
, responseHeaderFromBS
, responseHeaderToBS
, responseHeaderToLower
, Status (..)
, statusCode
, statusMessage
, Source (..)
, Enumerator (..)
, Request (..)
, Response (..)
, Application
, Middleware
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Char (toLower)
data Method =
OPTIONS
| GET
| HEAD
| POST
| PUT
| DELETE
| TRACE
| CONNECT
| Method B.ByteString
deriving (Show, Read)
instance Eq Method where
x == y = methodToBS x == methodToBS y
methodFromBS :: B.ByteString -> Method
methodFromBS bs
| B.length bs <= 7 = case B8.unpack bs of
"OPTIONS" -> OPTIONS
"GET" -> GET
"HEAD" -> HEAD
"POST" -> POST
"PUT" -> PUT
"DELETE" -> DELETE
"TRACE" -> TRACE
"CONNECT" -> CONNECT
_ -> Method bs
| otherwise = Method bs
methodToBS :: Method -> B.ByteString
methodToBS OPTIONS = B8.pack "OPTIONS"
methodToBS GET = B8.pack "GET"
methodToBS HEAD = B8.pack "HEAD"
methodToBS POST = B8.pack "POST"
methodToBS PUT = B8.pack "PUT"
methodToBS DELETE = B8.pack "DELETE"
methodToBS TRACE = B8.pack "TRACE"
methodToBS CONNECT = B8.pack "CONNECT"
methodToBS (Method bs) = bs
data UrlScheme = HTTP | HTTPS
deriving (Show, Eq)
data HttpVersion =
Http09
| Http10
| Http11
| HttpVersion B.ByteString
deriving (Show, Read)
instance Eq HttpVersion where
x == y = httpVersionToBS x == httpVersionToBS y
httpVersionFromBS :: B.ByteString -> HttpVersion
httpVersionFromBS bs
| B.length bs == 3 = case B8.unpack bs of
"0.9" -> Http09
"1.0" -> Http10
"1.1" -> Http11
_ -> HttpVersion bs
| otherwise = HttpVersion bs
httpVersionToBS :: HttpVersion -> B.ByteString
httpVersionToBS Http09 = B8.pack "0.9"
httpVersionToBS Http10 = B8.pack "1.0"
httpVersionToBS Http11 = B8.pack "1.1"
httpVersionToBS (HttpVersion bs) = bs
data RequestHeader =
Accept
| AcceptCharset
| AcceptEncoding
| AcceptLanguage
| Authorization
| Cookie
| ReqContentLength
| ReqContentType
| Host
| Referer
| RequestHeader B.ByteString B.ByteString
deriving (Show, Read)
lowerBS :: B.ByteString -> B.ByteString
lowerBS = B8.map toLower
requestHeader :: B.ByteString -> RequestHeader
requestHeader x = RequestHeader x $ lowerBS x
instance Eq RequestHeader where
x == y = requestHeaderToLower x == requestHeaderToLower y
requestHeaderFromBS :: B.ByteString -> RequestHeader
requestHeaderFromBS bs = case B8.unpack bs of
"Accept" -> Accept
"Accept-Charset" -> AcceptCharset
"Accept-Encoding" -> AcceptEncoding
"Accept-Language" -> AcceptLanguage
"Authorization" -> Authorization
"Cookie" -> Cookie
"Content-Length" -> ReqContentLength
"Content-Type" -> ReqContentType
"Host" -> Host
"Referer" -> Referer
_ -> requestHeader bs
requestHeaderToBS :: RequestHeader -> B.ByteString
requestHeaderToBS Accept = B8.pack "Accept"
requestHeaderToBS AcceptCharset = B8.pack "Accept-Charset"
requestHeaderToBS AcceptEncoding = B8.pack "Accept-Encoding"
requestHeaderToBS AcceptLanguage = B8.pack "Accept-Language"
requestHeaderToBS Authorization = B8.pack "Authorization"
requestHeaderToBS Cookie = B8.pack "Cookie"
requestHeaderToBS ReqContentLength = B8.pack "Content-Length"
requestHeaderToBS ReqContentType = B8.pack "Content-Type"
requestHeaderToBS Host = B8.pack "Host"
requestHeaderToBS Referer = B8.pack "Referer"
requestHeaderToBS (RequestHeader bs _) = bs
requestHeaderToLower :: RequestHeader -> B.ByteString
requestHeaderToLower Accept = B8.pack "accept"
requestHeaderToLower AcceptCharset = B8.pack "accept-charset"
requestHeaderToLower AcceptEncoding = B8.pack "accept-encoding"
requestHeaderToLower AcceptLanguage = B8.pack "accept-language"
requestHeaderToLower Authorization = B8.pack "authorization"
requestHeaderToLower Cookie = B8.pack "cookie"
requestHeaderToLower ReqContentLength = B8.pack "content-Length"
requestHeaderToLower ReqContentType = B8.pack "content-Type"
requestHeaderToLower Host = B8.pack "host"
requestHeaderToLower Referer = B8.pack "referer"
requestHeaderToLower (RequestHeader _ bs) = bs
data ResponseHeader =
ContentEncoding
| ContentLanguage
| ContentLength
| ContentDisposition
| ContentType
| Expires
| Location
| Server
| SetCookie
| ResponseHeader B.ByteString B.ByteString
deriving (Show)
instance Eq ResponseHeader where
x == y = responseHeaderToBS x == responseHeaderToBS y
responseHeader :: B.ByteString -> ResponseHeader
responseHeader x = ResponseHeader x $ lowerBS x
responseHeaderFromBS :: B.ByteString -> ResponseHeader
responseHeaderFromBS bs = case B8.unpack bs of
"Content-Encoding" -> ContentEncoding
"Content-Language" -> ContentLanguage
"Content-Length" -> ContentLength
"Content-Disposition" -> ContentDisposition
"Content-Type" -> ContentType
"Expires" -> Expires
"Location" -> Location
"Server" -> Server
"Set-Cookie" -> SetCookie
_ -> responseHeader bs
responseHeaderToBS :: ResponseHeader -> B.ByteString
responseHeaderToBS ContentEncoding = B8.pack "Content-Encoding"
responseHeaderToBS ContentLanguage = B8.pack "Content-Language"
responseHeaderToBS ContentLength = B8.pack "Content-Length"
responseHeaderToBS ContentDisposition = B8.pack "Content-Disposition"
responseHeaderToBS ContentType = B8.pack "Content-Type"
responseHeaderToBS Expires = B8.pack "Expires"
responseHeaderToBS Location = B8.pack "Location"
responseHeaderToBS Server = B8.pack "Server"
responseHeaderToBS SetCookie = B8.pack "Set-Cookie"
responseHeaderToBS (ResponseHeader bs _) = bs
responseHeaderToLower :: ResponseHeader -> B.ByteString
responseHeaderToLower ContentEncoding = B8.pack "content-encoding"
responseHeaderToLower ContentLanguage = B8.pack "content-language"
responseHeaderToLower ContentLength = B8.pack "content-length"
responseHeaderToLower ContentDisposition = B8.pack "content-disposition"
responseHeaderToLower ContentType = B8.pack "content-type"
responseHeaderToLower Expires = B8.pack "expires"
responseHeaderToLower Location = B8.pack "location"
responseHeaderToLower Server = B8.pack "server"
responseHeaderToLower SetCookie = B8.pack "set-cookie"
responseHeaderToLower (ResponseHeader _ bs) = bs
data Status =
Status200
| Status301
| Status302
| Status303
| Status400
| Status401
| Status403
| Status404
| Status405
| Status500
| Status Int B.ByteString
deriving Show
instance Eq Status where
x == y = statusCode x == statusCode y
statusCode :: Status -> Int
statusCode Status200 = 200
statusCode Status301 = 301
statusCode Status302 = 302
statusCode Status303 = 303
statusCode Status400 = 400
statusCode Status401 = 401
statusCode Status403 = 403
statusCode Status404 = 404
statusCode Status405 = 405
statusCode Status500 = 500
statusCode (Status i _) = i
statusMessage :: Status -> B.ByteString
statusMessage Status200 = B8.pack "OK"
statusMessage Status301 = B8.pack "Moved Permanently"
statusMessage Status302 = B8.pack "Found"
statusMessage Status303 = B8.pack "See Other"
statusMessage Status400 = B8.pack "Bad Request"
statusMessage Status401 = B8.pack "Unauthorized"
statusMessage Status403 = B8.pack "Forbidden"
statusMessage Status404 = B8.pack "Not Found"
statusMessage Status405 = B8.pack "Method Not Allowed"
statusMessage Status500 = B8.pack "Internal Server Error"
statusMessage (Status _ m) = m
newtype Source = Source { runSource :: IO (Maybe (B.ByteString, Source)) }
newtype Enumerator = Enumerator { runEnumerator :: forall a.
(a -> B.ByteString -> IO (Either a a))
-> a
-> IO (Either a a)
}
data Request = Request
{ requestMethod :: Method
, httpVersion :: HttpVersion
, pathInfo :: B.ByteString
, queryString :: B.ByteString
, serverName :: B.ByteString
, serverPort :: Int
, requestHeaders :: [(RequestHeader, B.ByteString)]
, urlScheme :: UrlScheme
, requestBody :: Source
, errorHandler :: String -> IO ()
, remoteHost :: B.ByteString
}
data Response = Response
{ status :: Status
, responseHeaders :: [(ResponseHeader, B.ByteString)]
, responseBody :: Either FilePath Enumerator
}
type Application = Request -> IO Response
type Middleware = Application -> Application