chu2-2012.11.18.2: src/Chu2/Interface/Hack2.hs
module Chu2.Interface.Hack2 where
import Data.ByteString (ByteString)
import qualified Hack2 as Hack2
import Data.ByteString.Char8 (pack, unpack)
import Data.ByteString.UTF8 (fromString, toString)
import Data.Default
import Chu2.FFI
hack2RequestMethodToChu2RequestMethod :: Hack2.RequestMethod -> RequestMethod
hack2RequestMethodToChu2RequestMethod Hack2.OPTIONS = OPTIONS
hack2RequestMethodToChu2RequestMethod Hack2.GET = GET
hack2RequestMethodToChu2RequestMethod Hack2.HEAD = HEAD
hack2RequestMethodToChu2RequestMethod Hack2.POST = POST
hack2RequestMethodToChu2RequestMethod Hack2.PUT = PUT
hack2RequestMethodToChu2RequestMethod Hack2.DELETE = DELETE
hack2RequestMethodToChu2RequestMethod Hack2.TRACE = TRACE
hack2RequestMethodToChu2RequestMethod Hack2.CONNECT = CONNECT
chu2RequestMethodToHack2RequestMethod :: RequestMethod -> Hack2.RequestMethod
chu2RequestMethodToHack2RequestMethod OPTIONS = Hack2.OPTIONS
chu2RequestMethodToHack2RequestMethod GET = Hack2.GET
chu2RequestMethodToHack2RequestMethod HEAD = Hack2.HEAD
chu2RequestMethodToHack2RequestMethod POST = Hack2.POST
chu2RequestMethodToHack2RequestMethod PUT = Hack2.PUT
chu2RequestMethodToHack2RequestMethod DELETE = Hack2.DELETE
chu2RequestMethodToHack2RequestMethod TRACE = Hack2.TRACE
chu2RequestMethodToHack2RequestMethod CONNECT = Hack2.CONNECT
hack2UrlSchemeToChu2UrlScheme :: Hack2.HackUrlScheme -> Chu2UrlScheme
hack2UrlSchemeToChu2UrlScheme Hack2.HTTP = HTTP
hack2UrlSchemeToChu2UrlScheme Hack2.HTTPS = HTTPS
chu2UrlSchemeToHack2UrlScheme :: Chu2UrlScheme -> Hack2.HackUrlScheme
chu2UrlSchemeToHack2UrlScheme HTTP = Hack2.HTTP
chu2UrlSchemeToHack2UrlScheme HTTPS = Hack2.HTTPS
hack2ErrorsToChu2Errors :: Hack2.HackErrors -> Chu2Errors
hack2ErrorsToChu2Errors io x = Hack2.unHackErrors io (f2b_Utf8Encoding x)
chu2ErrorsToHack2Errors :: Chu2Errors -> Hack2.HackErrors
chu2ErrorsToHack2Errors io = Hack2.HackErrors (\x -> io (b2f_Utf8Encoding x))
f2b :: Field -> ByteString
f2b = pack
b2f :: ByteString -> Field
b2f = unpack
f2b_Utf8Encoding :: Field -> ByteString
f2b_Utf8Encoding = fromString
b2f_Utf8Encoding :: ByteString -> Field
b2f_Utf8Encoding = toString
mapTuple :: (a -> b) -> [(a,a)] -> [(b,b)]
mapTuple f = map (\(x,y) -> (f x, f y))
hack2EnvToChu2Env :: Hack2.Env -> Env
hack2EnvToChu2Env e =
Env
{
requestMethod = hack2RequestMethodToChu2RequestMethod $ Hack2.requestMethod e
, chu2UrlScheme = hack2UrlSchemeToChu2UrlScheme $ Hack2.hackUrlScheme e
, chu2Errors = hack2ErrorsToChu2Errors $ Hack2.hackErrors e
, serverPort = show $ Hack2.serverPort e
, scriptName = b2f $ Hack2.scriptName e
, pathInfo = b2f $ Hack2.pathInfo e
, queryString = b2f $ Hack2.queryString e
, serverName = b2f $ Hack2.serverName e
, httpHeaders = mapTuple b2f $ Hack2.httpHeaders e
, chu2Input = b2f_Utf8Encoding $ Hack2.hackInput e
, chu2Headers = mapTuple b2f $ Hack2.hackHeaders e
}
chu2EnvToHack2Env :: Env -> Hack2.Env
chu2EnvToHack2Env e =
def
{
Hack2.requestMethod = chu2RequestMethodToHack2RequestMethod $ requestMethod e
, Hack2.hackUrlScheme = chu2UrlSchemeToHack2UrlScheme $ chu2UrlScheme e
, Hack2.hackErrors = chu2ErrorsToHack2Errors $ chu2Errors e
, Hack2.serverPort = read $ serverPort e
, Hack2.scriptName = f2b $ scriptName e
, Hack2.pathInfo = f2b $ pathInfo e
, Hack2.queryString = f2b $ queryString e
, Hack2.serverName = f2b $ serverName e
, Hack2.httpHeaders = mapTuple f2b $ httpHeaders e
, Hack2.hackInput = f2b_Utf8Encoding $ chu2Input e
, Hack2.hackHeaders = mapTuple f2b $ chu2Headers e
}
showStatus :: Status -> Int
showStatus OK = 200
showStatus Created = 201
showStatus Accepted = 202
showStatus NoContent = 204
showStatus MultipleChoices = 300
showStatus MovedPermanently = 301
showStatus SeeOther = 303
showStatus NotModified = 304
showStatus MovedTemporarily = 307
showStatus BadRequest = 400
showStatus Unauthorized = 401
showStatus Forbidden = 403
showStatus NotFound = 404
showStatus MethodNotAllowed = 405
showStatus NotAcceptable = 406
showStatus Conflict = 409
showStatus Gone = 410
showStatus PreconditionFailed = 412
showStatus RequestEntityTooLarge = 413
showStatus RequestURItooLong = 414
showStatus UnsupportedMediaType = 415
showStatus NotImplemented = 501
showStatus ServiceUnavailable = 503
readStatus :: Int -> Status
readStatus 200 = OK
readStatus 201 = Created
readStatus 202 = Accepted
readStatus 204 = NoContent
readStatus 300 = MultipleChoices
readStatus 301 = MovedPermanently
readStatus 303 = SeeOther
readStatus 304 = NotModified
readStatus 307 = MovedTemporarily
readStatus 400 = BadRequest
readStatus 401 = Unauthorized
readStatus 403 = Forbidden
readStatus 404 = NotFound
readStatus 405 = MethodNotAllowed
readStatus 406 = NotAcceptable
readStatus 409 = Conflict
readStatus 410 = Gone
readStatus 412 = PreconditionFailed
readStatus 413 = RequestEntityTooLarge
readStatus 414 = RequestURItooLong
readStatus 415 = UnsupportedMediaType
readStatus 501 = NotImplemented
readStatus 503 = ServiceUnavailable
readStatus _ = ServiceUnavailable
chu2ResponseToHack2Response :: Response -> Hack2.Response
chu2ResponseToHack2Response r =
Hack2.Response
{
Hack2.status = showStatus $ status r
, Hack2.headers = mapTuple f2b $ headers r
, Hack2.body = f2b_Utf8Encoding $ body r
}
hack2ResponseToHack2Response :: Hack2.Response -> Response
hack2ResponseToHack2Response r =
Response
{
status = readStatus $ Hack2.status r
, headers = mapTuple b2f $ Hack2.headers r
, body = b2f_Utf8Encoding $ Hack2.body r
}
type Application = Env -> IO Response
type Middleware = Application -> Application
chu2ApplicationToHack2Application :: Application -> Hack2.Application
chu2ApplicationToHack2Application app = \hack2Env -> do
chu2Response <- app (hack2EnvToChu2Env hack2Env)
return (chu2ResponseToHack2Response chu2Response)
hack2ApplicationToChu2Application :: Hack2.Application -> Application
hack2ApplicationToChu2Application hack2App = \env -> do
hack2Response <- hack2App (chu2EnvToHack2Env env)
return (hack2ResponseToHack2Response hack2Response)
hack2MiddlewareToChu2Middleware :: Hack2.Middleware -> Middleware
hack2MiddlewareToChu2Middleware h2m app =
let hackApp = h2m $ chu2ApplicationToHack2Application app
in
hack2ApplicationToChu2Application hackApp