{-# LANGUAGE OverloadedStrings #-}

module Hack2.Interface.Wai
(
  hackAppToWaiApp
) where

import           Control.Monad.IO.Class (liftIO)
import           Data.ByteString.Char8 (ByteString, pack)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as Lazy
import qualified Data.CaseInsensitive as CaseInsensitive
import           Data.Char (toUpper)
import           Data.Default (def, Default)
import           Data.Maybe (fromMaybe)
import           Hack2
import qualified Network.HTTP.Types as HTTPTypes
import qualified Network.Wai as Wai
import           Prelude hiding ((-), (.))
import qualified Safe as Safe

{-

{  requestMethod  :: RequestMethod
,  scriptName     :: ByteString
,  pathInfo       :: ByteString
,  queryString    :: ByteString
,  serverName     :: ByteString
,  serverPort     :: Int
,  httpHeaders    :: [(ByteString, ByteString)]
,  hackVersion    :: (Int, Int, Int)
,  hackUrlScheme  :: HackUrlScheme
,  hackInput      :: HackEnumerator
,  hackErrors     :: HackErrors
,  hackHeaders    :: [(ByteString, ByteString)]

-}

infixr 0 -
{-# INLINE (-) #-}
(-) :: (a -> b) -> a -> b
f - x = f x

infixl 9 .
{-# INLINE (.) #-}
(.) :: a -> (a -> b) -> b
a . f = f a

requestToEnv :: Wai.Request -> IO Env
requestToEnv request = do
  requestBody <- request.Wai.strictRequestBody

  let
      (serverName:serverPort:_) = request.Wai.remoteHost.show.B.pack.B.split ':' ++ [mempty, mempty]

  return -
    def
      {
        requestMethod = request.Wai.requestMethod.show.map toUpper.Safe.readDef GET
      , pathInfo      = request.Wai.rawPathInfo
      , queryString   = request.Wai.rawQueryString.B.dropWhile (== '?')
      , serverName    = serverName
      , serverPort    = Safe.readMay (show serverPort).fromMaybe 0
      , httpHeaders   = request.Wai.requestHeaders.map caseInsensitiveHeaderToHeader
      , hackUrlScheme = if request.Wai.isSecure then HTTPS else HTTP
      , hackHeaders   = [("RemoteHost", request.Wai.remoteHost.show.pack)]
      , hackInput     = Lazy.toStrict requestBody
      }



caseInsensitiveHeaderToHeader :: (CaseInsensitive.CI ByteString, ByteString) -> (ByteString, ByteString)
caseInsensitiveHeaderToHeader (x, y) = (x.CaseInsensitive.original, y)

headerToCaseInsensitiveHeader ::  (ByteString, ByteString) -> (CaseInsensitive.CI ByteString, ByteString)
headerToCaseInsensitiveHeader (x, y) = (x.CaseInsensitive.mk, y)

statusToStatusHeader :: Int -> HTTPTypes.Status
statusToStatusHeader 200 = HTTPTypes.status200
statusToStatusHeader 201 = HTTPTypes.status201
statusToStatusHeader 206 = HTTPTypes.status206
statusToStatusHeader 301 = HTTPTypes.status301
statusToStatusHeader 302 = HTTPTypes.status302
statusToStatusHeader 303 = HTTPTypes.status303
statusToStatusHeader 304 = HTTPTypes.status304
statusToStatusHeader 400 = HTTPTypes.status400
statusToStatusHeader 401 = HTTPTypes.status401
statusToStatusHeader 403 = HTTPTypes.status403
statusToStatusHeader 404 = HTTPTypes.status404
statusToStatusHeader 405 = HTTPTypes.status405
statusToStatusHeader 412 = HTTPTypes.status412
statusToStatusHeader 416 = HTTPTypes.status416
statusToStatusHeader 500 = HTTPTypes.status500
statusToStatusHeader 501 = HTTPTypes.status501
statusToStatusHeader 502 = HTTPTypes.status502
statusToStatusHeader 503 = HTTPTypes.status503
statusToStatusHeader 504 = HTTPTypes.status504
statusToStatusHeader 505 = HTTPTypes.status505
statusToStatusHeader _   = HTTPTypes.status505

hackAppToWaiApp :: Application -> Wai.Application
hackAppToWaiApp app request respond = do
   response <- liftIO - app =<< requestToEnv request
   let wai_response = hackResponseToWaiResponse response
   respond wai_response

hackResponseToWaiResponse :: Response -> Wai.Response
hackResponseToWaiResponse response =
  let s = response.status.statusToStatusHeader
      h = response.headers.map headerToCaseInsensitiveHeader

      b = Lazy.fromChunks [response.body]

  in

  Wai.responseLBS s h b