chu2-2012.11.18: 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.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 = Hack2.unHackErrors
chu2ErrorsToHack2Errors :: Chu2Errors -> Hack2.HackErrors
chu2ErrorsToHack2Errors = Hack2.HackErrors
hack2EnvToChu2Env :: Hack2.Env -> Env
hack2EnvToChu2Env e =
Env
{
requestMethod = hack2RequestMethodToChu2RequestMethod $ Hack2.requestMethod e
, scriptName = Hack2.scriptName e
, pathInfo = Hack2.pathInfo e
, queryString = Hack2.queryString e
, serverName = Hack2.serverName e
, serverPort = pack $ show $ Hack2.serverPort e
, httpHeaders = Hack2.httpHeaders e
, chu2UrlScheme = hack2UrlSchemeToChu2UrlScheme $ Hack2.hackUrlScheme e
, chu2Input = Hack2.hackInput e
, chu2Errors = hack2ErrorsToChu2Errors $ Hack2.hackErrors e
, chu2Headers = Hack2.hackHeaders e
}
chu2EnvToHack2Env :: Env -> Hack2.Env
chu2EnvToHack2Env e =
def
{
Hack2.requestMethod = chu2RequestMethodToHack2RequestMethod $ requestMethod e
, Hack2.scriptName = scriptName e
, Hack2.pathInfo = pathInfo e
, Hack2.queryString = queryString e
, Hack2.serverName = serverName e
, Hack2.serverPort = read $ unpack $ serverPort e
, Hack2.httpHeaders = httpHeaders e
, Hack2.hackUrlScheme = chu2UrlSchemeToHack2UrlScheme $ chu2UrlScheme e
, Hack2.hackInput = chu2Input e
, Hack2.hackErrors = chu2ErrorsToHack2Errors $ chu2Errors e
, Hack2.hackHeaders = 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 = headers r
, Hack2.body = body r
}
hack2ResponseToHack2Response :: Hack2.Response -> Response
hack2ResponseToHack2Response r =
Response
{
status = readStatus $ Hack2.status r
, headers = Hack2.headers r
, body = 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