-- | Wai

{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP.Pony.Serve.Wai where

import           Blaze.ByteString.Builder (toLazyByteString)
import           Control.Monad.Trans.Class (lift)
import           Data.Attoparsec.ByteString (parse, eitherResult)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import           Data.IORef (newIORef, readIORef, writeIORef)
import           Data.Semigroup ((<>))
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import           Network.Wai.Internal (Response(ResponseBuilder)
                                      , ResponseReceived(ResponseReceived))
import           Pipes (next)
import           Pipes.ByteString (fromLazy)
import           Pipes.Safe (SafeT, runSafeT, MonadSafe)

import           Network.HTTP.Pony.Serve.Wai.Helper ((-))
import           Network.HTTP.Pony.Serve.Wai.Type (Request, Response, App)
import           Prelude hiding ((-))


parseRequest :: Request (SafeT IO) -> (SafeT IO) Wai.Request
parseRequest (((method, uri, version), headers), body) = do
  bodyRef <- lift - newIORef (Just body)

  let (rawPathInfo, rawQueryString) = B.break (== '?') uri
      (pathInfo, queryString) = HTTP.decodePath uri

  pure Wai.defaultRequest
    {
      Wai.requestMethod = method
    , Wai.httpVersion = version
    , Wai.rawPathInfo = rawPathInfo
    , Wai.rawQueryString = rawQueryString
    , Wai.requestHeaders = headers
    , Wai.pathInfo = pathInfo
    , Wai.queryString = queryString
    , Wai.requestBody = do
        bodyC <- readIORef bodyRef
        case bodyC of
          Just _body -> do
            r <- runSafeT - next _body
            case r of
              Right (x, bodyC) -> do
                writeIORef bodyRef (Just bodyC)
                pure x

              _ -> do
                writeIORef bodyRef Nothing
                pure mempty

          _ -> pure mempty
    }




fromWAI :: ( Wai.Request
                -> (Wai.Response -> IO ResponseReceived)
                -> IO ResponseReceived
              ) -> App (SafeT IO)
fromWAI app r = do
  waiRequest <- parseRequest r


  let waiC :: (Wai.Response -> IO ResponseReceived) -> IO ResponseReceived
      waiC = app waiRequest

  responseRef <- lift - newIORef Nothing

  let version = Wai.httpVersion waiRequest

  let callback :: Wai.Response -> IO ResponseReceived
      callback waiResponse = do
        let status = Wai.responseStatus waiResponse
            headers = Wai.responseHeaders waiResponse
            responseLine = (version, status)

        case waiResponse of
          ResponseBuilder _ _ builder -> do

            let p = fromLazy (toLazyByteString builder)
            writeIORef responseRef (Just ((responseLine, headers), p))
            pure ResponseReceived
          _ -> do
            pure ResponseReceived

  lift - waiC - callback

  maybeResponse <- lift - readIORef responseRef

  case maybeResponse of
    Just response -> do
      pure response
    _ -> do
      pure (((version, HTTP.status500), mempty), mempty)