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 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 , 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.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