{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors #-}

module Okapi.HTTP.Request (
    request,
    methodGET,
    methodPOST,
    methodPUT,
    methodDELETE,
    method,
    path,
    query,
    headers,
    body,
    pathOf,
    queryOf,
    headersOf,
    parseRequest,
    parseRequestResult,
    printRequest,
    link,
) where

import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import GHC.Generics (Generic, Rep)
import Network.HTTP.Types qualified as HTTP
import Network.Wai qualified as Wai
import Okapi.Record.Tree (Request (..))
import Okapi.Record.Tree qualified as Tree
import Okapi.Record.Error    qualified as Error
import Okapi.Record.Result   qualified as Result
import Okapi.Record.Data    qualified as Data
import Okapi.HTTP.Request.Body (Body)
import Okapi.HTTP.Request.Body qualified as Body
import Okapi.HTTP.Request.Headers (GHeaders, Headers)
import Okapi.HTTP.Request.Headers qualified as Headers
import Okapi.HTTP.Request.Method (DELETE, GET, KnownMethod (..), POST, PUT)
import Okapi.HTTP.Request.Method qualified as Method
import Okapi.HTTP.Request.Path (GPath, Path)
import Okapi.HTTP.Request.Path qualified as Path
import Okapi.HTTP.Request.Query (GQuery, Query)
import Okapi.HTTP.Request.Query qualified as Query
import Okapi.Tree (SymTree)

request :: Tree.Request HTTP.Method [Text] HTTP.Query HTTP.RequestHeaders (IO LBS.ByteString)
request :: Request Method [Text] Query RequestHeaders (IO ByteString)
request = Request
    { method :: Method Method
method  = Method Method
Method.raw
    , path :: SymTree Path [Text]
path    = SymTree Path [Text]
Path.raw
    , query :: SymTree Query Query
query   = SymTree Query Query
Query.raw
    , headers :: SymTree Headers RequestHeaders
headers = SymTree Headers RequestHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

methodGET :: Tree.Request GET [Text] HTTP.Query HTTP.RequestHeaders (IO LBS.ByteString)
methodGET :: Request GET [Text] Query RequestHeaders (IO ByteString)
methodGET = Request Method [Text] Query RequestHeaders (IO ByteString)
request { method = Method.method GET }

methodPOST :: Tree.Request POST [Text] HTTP.Query HTTP.RequestHeaders (IO LBS.ByteString)
methodPOST :: Request POST [Text] Query RequestHeaders (IO ByteString)
methodPOST = Request Method [Text] Query RequestHeaders (IO ByteString)
request { method = Method.method POST }

methodPUT :: Tree.Request PUT [Text] HTTP.Query HTTP.RequestHeaders (IO LBS.ByteString)
methodPUT :: Request PUT [Text] Query RequestHeaders (IO ByteString)
methodPUT = Request Method [Text] Query RequestHeaders (IO ByteString)
request { method = Method.method PUT }

methodDELETE :: Tree.Request DELETE [Text] HTTP.Query HTTP.RequestHeaders (IO LBS.ByteString)
methodDELETE :: Request DELETE [Text] Query RequestHeaders (IO ByteString)
methodDELETE = Request Method [Text] Query RequestHeaders (IO ByteString)
request { method = Method.method DELETE }

method ::
    KnownMethod m ->
    Tree.Request HTTP.Method path query headers body ->
    Tree.Request (KnownMethod m) path query headers body
method :: forall (m :: Symbol) path query headers body.
KnownMethod m
-> Request Method path query headers body
-> Request (KnownMethod m) path query headers body
method KnownMethod m
km Request Method path query headers body
r = Request Method path query headers body
r { method = Method.method km }

path ::
    SymTree Path path ->
    Tree.Request method [Text] query headers body ->
    Tree.Request method path query headers body
path :: forall path method query headers body.
SymTree Path path
-> Request method [Text] query headers body
-> Request method path query headers body
path SymTree Path path
c Request method [Text] query headers body
r = Request method [Text] query headers body
r { path = c }

query ::
    SymTree Query query ->
    Tree.Request method path HTTP.Query headers body ->
    Tree.Request method path query headers body
query :: forall query method path headers body.
SymTree Query query
-> Request method path Query headers body
-> Request method path query headers body
query SymTree Query query
c Request method path Query headers body
r = Request method path Query headers body
r { query = c }

headers ::
    SymTree Headers headers ->
    Tree.Request method path query HTTP.RequestHeaders body ->
    Tree.Request method path query headers body
headers :: forall headers method path query body.
SymTree Headers headers
-> Request method path query RequestHeaders body
-> Request method path query headers body
headers SymTree Headers headers
c Request method path query RequestHeaders body
r = Request method path query RequestHeaders body
r { headers = c }

body ::
    SymTree Body body ->
    Tree.Request method path query headers (IO LBS.ByteString) ->
    Tree.Request method path query headers body
body :: forall body method path query headers.
SymTree Body body
-> Request method path query headers (IO ByteString)
-> Request method path query headers body
body SymTree Body body
c Request method path query headers (IO ByteString)
r = Request method path query headers (IO ByteString)
r { body = c }

pathOf ::
    forall path method query headers body.
    (Generic path, GPath (Rep path)) =>
    Tree.Request method [Text] query headers body ->
    Tree.Request method path query headers body
pathOf :: forall path method query headers body.
(Generic path, GPath (Rep path)) =>
Request method [Text] query headers body
-> Request method path query headers body
pathOf Request method [Text] query headers body
r = Request method [Text] query headers body
r { path = Path.pathCodec @path }

queryOf ::
    forall query method path headers body.
    (Generic query, GQuery (Rep query)) =>
    Tree.Request method path HTTP.Query headers body ->
    Tree.Request method path query headers body
queryOf :: forall query method path headers body.
(Generic query, GQuery (Rep query)) =>
Request method path Query headers body
-> Request method path query headers body
queryOf Request method path Query headers body
r = Request method path Query headers body
r { query = Query.queryCodec @query }

headersOf ::
    forall headers method path query body.
    (Generic headers, GHeaders (Rep headers)) =>
    Tree.Request method path query HTTP.RequestHeaders body ->
    Tree.Request method path query headers body
headersOf :: forall headers method path query body.
(Generic headers, GHeaders (Rep headers)) =>
Request method path query RequestHeaders body
-> Request method path query headers body
headersOf Request method path query RequestHeaders body
r = Request method path query RequestHeaders body
r { headers = Headers.headersCodec @headers }

parseRequest ::
    Tree.Request method path query headers body ->
    Wai.Request ->
    IO (Either (Error.Request method path query headers body) (Data.Request method path query headers body))
parseRequest :: forall method path query headers body.
Request method path query headers body
-> Request
-> IO
     (Either
        (Request method path query headers body)
        (Request method path query headers body))
parseRequest Request method path query headers body
req Request
waiReq = do
    let mr :: Either ParseError method
mr      = Method method -> Method -> Either ParseError method
forall method. Method method -> Method -> Either ParseError method
Method.parse Request method path query headers body
req.method  (Request -> Method
Wai.requestMethod  Request
waiReq)
        pr :: Either (Either ParseError [Text]) path
pr      = Tree Path path path
-> [Text] -> Either (Either ParseError [Text]) path
forall i o.
Tree Path i o -> [Text] -> Either (Either ParseError [Text]) o
Path.parseExact Request method path query headers body
req.path (Request -> [Text]
Wai.pathInfo       Request
waiReq)
        (Either (Failure Query) query
qr, Context Query
_) = Tree Query query query -> Parser Query query
forall i o. Tree Query i o -> Parser Query o
Query.parser   Request method path query headers body
req.query   (Request -> Query
Wai.queryString    Request
waiReq)
        (Either (Failure Headers) headers
hr, Context Headers
_) = Tree Headers headers headers -> Parser Headers headers
forall i o. Tree Headers i o -> Parser Headers o
Headers.parser Request method path query headers body
req.headers (Request -> RequestHeaders
Wai.requestHeaders Request
waiReq)
        bodyIO :: IO ByteString
bodyIO  = Request -> IO ByteString
Wai.strictRequestBody Request
waiReq
        (Either (Failure Body) body
br, Context Body
_) = Tree Body body body -> Parser Body body
forall i o. Tree Body i o -> Parser Body o
Body.parser    Request method path query headers body
req.body    IO ByteString
Context Body
bodyIO
    Either
  (Request method path query headers body)
  (Request method path query headers body)
-> IO
     (Either
        (Request method path query headers body)
        (Request method path query headers body))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either
   (Request method path query headers body)
   (Request method path query headers body)
 -> IO
      (Either
         (Request method path query headers body)
         (Request method path query headers body)))
-> Either
     (Request method path query headers body)
     (Request method path query headers body)
-> IO
     (Either
        (Request method path query headers body)
        (Request method path query headers body))
forall a b. (a -> b) -> a -> b
$ case (Either ParseError method
mr, Either (Either ParseError [Text]) path
pr, Either (Failure Query) query
Either ParseError query
qr, Either (Failure Headers) headers
Either ParseError headers
hr, Either (Failure Body) body
Either ParseError body
br) of
        (Right method
method, Right path
path, Right query
query, Right headers
headers, Right body
body) ->
            Request method path query headers body
-> Either
     (Request method path query headers body)
     (Request method path query headers body)
forall a b. b -> Either a b
Right (Request method path query headers body
 -> Either
      (Request method path query headers body)
      (Request method path query headers body))
-> Request method path query headers body
-> Either
     (Request method path query headers body)
     (Request method path query headers body)
forall a b. (a -> b) -> a -> b
$ Data.Request { method
method :: method
method :: method
method, path
path :: path
path :: path
path, query
query :: query
query :: query
query, headers
headers :: headers
headers :: headers
headers, body
body :: body
body :: body
body }
        (Either ParseError method, Either (Either ParseError [Text]) path,
 Either ParseError query, Either ParseError headers,
 Either ParseError body)
_ ->
            Request method path query headers body
-> Either
     (Request method path query headers body)
     (Request method path query headers body)
forall a b. a -> Either a b
Left (Request method path query headers body
 -> Either
      (Request method path query headers body)
      (Request method path query headers body))
-> Request method path query headers body
-> Either
     (Request method path query headers body)
     (Request method path query headers body)
forall a b. (a -> b) -> a -> b
$ Error.Request
                { method :: Maybe (Failure Method)
method  = (ParseError -> Maybe ParseError)
-> (method -> Maybe ParseError)
-> Either ParseError method
-> Maybe ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Maybe ParseError
forall a. a -> Maybe a
Just                            (Maybe ParseError -> method -> Maybe ParseError
forall a b. a -> b -> a
const Maybe ParseError
forall a. Maybe a
Nothing) Either ParseError method
mr
                , path :: Maybe (Failure Path)
path    = (Either ParseError [Text] -> Maybe ParseError)
-> (path -> Maybe ParseError)
-> Either (Either ParseError [Text]) path
-> Maybe ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> Maybe ParseError
forall a. a -> Maybe a
Just (ParseError -> Maybe ParseError)
-> (Either ParseError [Text] -> ParseError)
-> Either ParseError [Text]
-> Maybe ParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> ParseError)
-> ([Text] -> ParseError) -> Either ParseError [Text] -> ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> ParseError
forall a. a -> a
id (ParseError -> [Text] -> ParseError
forall a b. a -> b -> a
const ParseError
Path.ParseError)) (Maybe ParseError -> path -> Maybe ParseError
forall a b. a -> b -> a
const Maybe ParseError
forall a. Maybe a
Nothing) Either (Either ParseError [Text]) path
pr
                , query :: Maybe (Failure Query)
query   = (ParseError -> Maybe ParseError)
-> (query -> Maybe ParseError)
-> Either ParseError query
-> Maybe ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Maybe ParseError
forall a. a -> Maybe a
Just                            (Maybe ParseError -> query -> Maybe ParseError
forall a b. a -> b -> a
const Maybe ParseError
forall a. Maybe a
Nothing) Either (Failure Query) query
Either ParseError query
qr
                , headers :: Maybe (Failure Headers)
headers = (ParseError -> Maybe ParseError)
-> (headers -> Maybe ParseError)
-> Either ParseError headers
-> Maybe ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Maybe ParseError
forall a. a -> Maybe a
Just                            (Maybe ParseError -> headers -> Maybe ParseError
forall a b. a -> b -> a
const Maybe ParseError
forall a. Maybe a
Nothing) Either (Failure Headers) headers
Either ParseError headers
hr
                , body :: Maybe (Failure Body)
body    = (ParseError -> Maybe ParseError)
-> (body -> Maybe ParseError)
-> Either ParseError body
-> Maybe ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> Maybe ParseError
forall a. a -> Maybe a
Just                            (Maybe ParseError -> body -> Maybe ParseError
forall a b. a -> b -> a
const Maybe ParseError
forall a. Maybe a
Nothing) Either (Failure Body) body
Either ParseError body
br
                }

parseRequestResult ::
    Tree.Request method path query headers body ->
    Wai.Request ->
    IO (Result.Request method path query headers body)
parseRequestResult :: forall method path query headers body.
Request method path query headers body
-> Request -> IO (Request method path query headers body)
parseRequestResult Request method path query headers body
req Request
waiReq = do
    let mr :: Either ParseError method
mr      = Method method -> Method -> Either ParseError method
forall method. Method method -> Method -> Either ParseError method
Method.parse Request method path query headers body
req.method  (Request -> Method
Wai.requestMethod  Request
waiReq)
        pr :: Either (Either ParseError [Text]) path
pr      = Tree Path path path
-> [Text] -> Either (Either ParseError [Text]) path
forall i o.
Tree Path i o -> [Text] -> Either (Either ParseError [Text]) o
Path.parseExact Request method path query headers body
req.path (Request -> [Text]
Wai.pathInfo       Request
waiReq)
        (Either (Failure Query) query
qr, Context Query
_) = Tree Query query query -> Parser Query query
forall i o. Tree Query i o -> Parser Query o
Query.parser   Request method path query headers body
req.query   (Request -> Query
Wai.queryString    Request
waiReq)
        (Either (Failure Headers) headers
hr, Context Headers
_) = Tree Headers headers headers -> Parser Headers headers
forall i o. Tree Headers i o -> Parser Headers o
Headers.parser Request method path query headers body
req.headers (Request -> RequestHeaders
Wai.requestHeaders Request
waiReq)
        bodyIO :: IO ByteString
bodyIO  = Request -> IO ByteString
Wai.strictRequestBody Request
waiReq
        (Either (Failure Body) body
br, Context Body
_) = Tree Body body body -> Parser Body body
forall i o. Tree Body i o -> Parser Body o
Body.parser    Request method path query headers body
req.body    IO ByteString
Context Body
bodyIO
    Request method path query headers body
-> IO (Request method path query headers body)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Request method path query headers body
 -> IO (Request method path query headers body))
-> Request method path query headers body
-> IO (Request method path query headers body)
forall a b. (a -> b) -> a -> b
$ Result.Request
        { method :: Either (Failure Method) method
method  = Either (Failure Method) method
Either ParseError method
mr
        , path :: Either (Failure Path) path
path    = (Either ParseError [Text] -> Either ParseError path)
-> (path -> Either ParseError path)
-> Either (Either ParseError [Text]) path
-> Either ParseError path
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> Either ParseError path
forall a b. a -> Either a b
Left (ParseError -> Either ParseError path)
-> (Either ParseError [Text] -> ParseError)
-> Either ParseError [Text]
-> Either ParseError path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParseError -> ParseError)
-> ([Text] -> ParseError) -> Either ParseError [Text] -> ParseError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ParseError -> ParseError
forall a. a -> a
id (ParseError -> [Text] -> ParseError
forall a b. a -> b -> a
const ParseError
Path.ParseError)) path -> Either ParseError path
forall a b. b -> Either a b
Right Either (Either ParseError [Text]) path
pr
        , query :: Either (Failure Query) query
query   = Either (Failure Query) query
qr
        , headers :: Either (Failure Headers) headers
headers = Either (Failure Headers) headers
hr
        , body :: Either (Failure Body) body
body    = Either (Failure Body) body
br
        }

printRequest ::
    Tree.Request method path query headers body ->
    Data.Request method path query headers body ->
    IO Wai.Request
printRequest :: forall method path query headers body.
Request method path query headers body
-> Request method path query headers body -> IO Request
printRequest Request method path query headers body
req Request method path query headers body
rv = do
    bodyBytes <- Tree Body body body -> Printer Body body
forall i o. Tree Body i o -> Printer Body i
Body.printer Request method path query headers body
req.body Request method path query headers body
rv.body
    bodyRef   <- newIORef (LBS.toChunks bodyBytes)
    let streamBody = do
            chunks <- IORef [Method] -> IO [Method]
forall a. IORef a -> IO a
readIORef IORef [Method]
bodyRef
            case chunks of
                []     -> Method -> IO Method
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Method
BS.empty
                (Method
c:[Method]
cs) -> IORef [Method] -> [Method] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [Method]
bodyRef [Method]
cs IO () -> IO Method -> IO Method
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Method -> IO Method
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Method
c
    let baseReq = Request
Wai.defaultRequest
            { Wai.requestMethod  = Method.print                            req.method  rv.method
            , Wai.pathInfo       = Path.printer    req.path    rv.path
            , Wai.queryString    = Query.printer   req.query   rv.query
            , Wai.requestHeaders = Headers.coalesceCookies (Headers.printer  req.headers rv.headers)
            }
    pure (Wai.setRequestBodyChunks streamBody baseReq)

link ::
    Tree.Request method path query headers body ->
    path ->
    query ->
    Text
link :: forall method path query headers body.
Request method path query headers body -> path -> query -> Text
link Request method path query headers body
req path
pathVal query
queryVal =
    let segs :: Context Path
segs = Tree Path path path -> Printer Path path
forall i o. Tree Path i o -> Printer Path i
Path.printer  Request method path query headers body
req.path  path
pathVal
        qs :: Context Query
qs   = Tree Query query query -> Printer Query query
forall i o. Tree Query i o -> Printer Query i
Query.printer Request method path query headers body
req.query query
queryVal
    in Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
"/" [Text]
Context Path
segs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Method -> Text
decodeUtf8 (Bool -> Query -> Method
HTTP.renderQuery Bool
True Query
Context Query
qs)