-- | Wai

{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP.Pony.Serve.Wai where

import           Blaze.ByteString.Builder (toLazyByteString)
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.Wai as Wai
import           Network.Wai.Internal hiding (Request, Response)
import           Pipes (yield, for, next)
import           Pipes.ByteString (fromLazy)
import qualified Network.HTTP.Types as HTTP

import           Network.HTTP.Pony.Serve.Wai.Helper ((-))
import           Network.HTTP.Pony.Serve.Wai.Parser
import           Network.HTTP.Pony.Serve.Wai.Type
import           Prelude hiding ((-))

parseRequest :: Request ByteString IO a -> IO (Either String Wai.Request)
parseRequest (requestLine, headers, body) = do
  bodyRef <- newIORef (Just body)

  let eitherRequest =
        do
          (method, uri, version) <- eitherResult (parse requestLineTokens requestLine)
          (pathInfo, queryString) <- parseRequestURITokens uri

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

                            _ -> do
                              writeIORef bodyRef Nothing
                              pure mempty

                        _ -> pure mempty
                  }

  pure (eitherRequest :: Either String Wai.Request)




fromWAI :: ( Wai.Request
                -> (Wai.Response -> IO ResponseReceived)
                -> IO ResponseReceived
              ) -> App
fromWAI app r = do
  eitherWaiRequest <- parseRequest r
  case eitherWaiRequest of
    Right waiRequest -> do
      let waiC :: (Wai.Response -> IO ResponseReceived) -> IO ResponseReceived
          waiC = app waiRequest

      responseRef <- newIORef Nothing

      let callback :: HTTP.HttpVersion -> Wai.Response -> IO ResponseReceived
          callback version waiResponse = do
            let (HTTP.Status code message) = Wai.responseStatus waiResponse
                headers = Wai.responseHeaders waiResponse
                responseLine =
                  B.pack (show version)
                    <> " "
                    <> B.pack (show code)
                    <> " "
                    <> message

            case waiResponse of
              ResponseBuilder _ _ builder -> do

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

      waiC - callback (httpVersion waiRequest)

      maybeResponse <- readIORef responseRef

      case maybeResponse of
        Just response -> do
          pure response
        _ -> do
          pure mempty
    Left err -> do
      pure mempty