{-# LANGUAGE NoFieldSelectors #-}

module Okapi.HTTP.Response (
    response,
    status200,
    status201,
    status204,
    status404,
    status500,
    headers,
    body,
    extractWaiResBody,
    parseResponseResult,
    resultToValue,
    resultToError,
    parseResponse,
    printResponse,
) where

import Data.ByteString.Builder qualified as Builder
import Data.ByteString.Lazy qualified as LBS
import Network.HTTP.Types qualified as HTTP
import Network.Wai qualified as Wai
import Network.Wai.Internal qualified as WaiI
import Okapi.Record.Tree (Response (..))
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.Response.Body (Body)
import Okapi.HTTP.Response.Body qualified as Body
import Okapi.HTTP.Response.Headers (Headers)
import Okapi.HTTP.Response.Headers qualified as Headers
import Okapi.HTTP.Response.Status (S200, S201, S204, S404, S500)
import Okapi.HTTP.Response.Status qualified as Status
import Okapi.Tree (SymTree)

response :: Tree.Response HTTP.Status HTTP.ResponseHeaders (IO LBS.ByteString)
response :: Response Status ResponseHeaders (IO ByteString)
response = Response
    { status :: Status Status
status  = Status Status
Status.raw
    , headers :: SymTree Headers ResponseHeaders
headers = SymTree Headers ResponseHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

status200 :: Tree.Response S200 HTTP.ResponseHeaders (IO LBS.ByteString)
status200 :: Response S200 ResponseHeaders (IO ByteString)
status200 = Response
    { status :: Status S200
status  = S200 -> Status S200
forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
Status.status S200
Status.S200
    , headers :: SymTree Headers ResponseHeaders
headers = SymTree Headers ResponseHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

status201 :: Tree.Response S201 HTTP.ResponseHeaders (IO LBS.ByteString)
status201 :: Response S201 ResponseHeaders (IO ByteString)
status201 = Response
    { status :: Status S201
status  = S201 -> Status S201
forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
Status.status S201
Status.S201
    , headers :: SymTree Headers ResponseHeaders
headers = SymTree Headers ResponseHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

status204 :: Tree.Response S204 HTTP.ResponseHeaders (IO LBS.ByteString)
status204 :: Response S204 ResponseHeaders (IO ByteString)
status204 = Response
    { status :: Status S204
status  = S204 -> Status S204
forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
Status.status S204
Status.S204
    , headers :: SymTree Headers ResponseHeaders
headers = SymTree Headers ResponseHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

status404 :: Tree.Response S404 HTTP.ResponseHeaders (IO LBS.ByteString)
status404 :: Response S404 ResponseHeaders (IO ByteString)
status404 = Response
    { status :: Status S404
status  = S404 -> Status S404
forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
Status.status S404
Status.S404
    , headers :: SymTree Headers ResponseHeaders
headers = SymTree Headers ResponseHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

status500 :: Tree.Response S500 HTTP.ResponseHeaders (IO LBS.ByteString)
status500 :: Response S500 ResponseHeaders (IO ByteString)
status500 = Response
    { status :: Status S500
status  = S500 -> Status S500
forall (s :: Nat). KnownStatus s -> Status (KnownStatus s)
Status.status S500
Status.S500
    , headers :: SymTree Headers ResponseHeaders
headers = SymTree Headers ResponseHeaders
Headers.raw
    , body :: SymTree Body (IO ByteString)
body    = SymTree Body (IO ByteString)
Body.raw
    }

headers ::
    SymTree Headers headers ->
    Tree.Response status HTTP.ResponseHeaders body ->
    Tree.Response status headers body
headers :: forall headers status body.
SymTree Headers headers
-> Response status ResponseHeaders body
-> Response status headers body
headers SymTree Headers headers
c Response status ResponseHeaders body
r = Response status ResponseHeaders body
r { headers = c }

body ::
    SymTree Body body ->
    Tree.Response status headers (IO LBS.ByteString) ->
    Tree.Response status headers body
body :: forall body status headers.
SymTree Body body
-> Response status headers (IO ByteString)
-> Response status headers body
body SymTree Body body
c Response status headers (IO ByteString)
r = Response status headers (IO ByteString)
r { body = c }

extractWaiResBody :: Wai.Response -> IO LBS.ByteString
extractWaiResBody :: Response -> IO ByteString
extractWaiResBody (WaiI.ResponseBuilder Status
_ ResponseHeaders
_ Builder
b) = ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> ByteString
Builder.toLazyByteString Builder
b)
extractWaiResBody Response
_                            = ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
LBS.empty

parseResponseResult ::
    Tree.Response status headers body ->
    Wai.Response ->
    IO (Result.Response status headers body)
parseResponseResult :: forall status headers body.
Response status headers body
-> Response -> IO (Response status headers body)
parseResponseResult Response status headers body
codec Response
waiRes = do
    let httpStatus :: Status
httpStatus = Response -> Status
Wai.responseStatus Response
waiRes
        waiHeaders :: ResponseHeaders
waiHeaders = Response -> ResponseHeaders
Wai.responseHeaders Response
waiRes
        sr :: Either ParseError status
sr         = Status status -> Status -> Either ParseError status
forall status. Status status -> Status -> Either ParseError status
Status.parse Response status headers body
codec.status Status
httpStatus
        (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 Response status headers body
codec.headers ResponseHeaders
Context Headers
waiHeaders
        (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 Response status headers body
codec.body (Response -> IO ByteString
extractWaiResBody Response
waiRes)
    Response status headers body -> IO (Response status headers body)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response status headers body -> IO (Response status headers body))
-> Response status headers body
-> IO (Response status headers body)
forall a b. (a -> b) -> a -> b
$ Result.Response { status :: Either (Failure Status) status
status = Either (Failure Status) status
Either ParseError status
sr, headers :: Either (Failure Headers) headers
headers = Either (Failure Headers) headers
hr, body :: Either (Failure Body) body
body = Either (Failure Body) body
br }

resultToValue ::
    Result.Response status headers body ->
    Maybe (Data.Response status headers body)
resultToValue :: forall status headers body.
Response status headers body
-> Maybe (Response status headers body)
resultToValue Response status headers body
result = case (Response status headers body
result.status, Response status headers body
result.headers, Response status headers body
result.body) of
    (Right status
status, Right headers
headers, Right body
body) ->
        Response status headers body
-> Maybe (Response status headers body)
forall a. a -> Maybe a
Just (Response status headers body
 -> Maybe (Response status headers body))
-> Response status headers body
-> Maybe (Response status headers body)
forall a b. (a -> b) -> a -> b
$ Data.Response { status :: status
status = status
status, headers :: headers
headers = headers
headers, body :: body
body = body
body }
    (Either ParseError status, Either ParseError headers,
 Either ParseError body)
_ -> Maybe (Response status headers body)
forall a. Maybe a
Nothing

resultToError ::
    Result.Response status headers body ->
    Error.Response status headers body
resultToError :: forall status headers body.
Response status headers body -> Response status headers body
resultToError Response status headers body
result = Error.Response
    { status :: Maybe (Failure Status)
status  = (ParseError -> Maybe ParseError)
-> (status -> Maybe ParseError)
-> Either ParseError status
-> 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 -> status -> Maybe ParseError
forall a b. a -> b -> a
const Maybe ParseError
forall a. Maybe a
Nothing) Response status headers body
result.status
    , 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) Response status headers body
result.headers
    , 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) Response status headers body
result.body
    }

parseResponse ::
    Tree.Response status headers body ->
    Wai.Response ->
    IO (Either (Error.Response status headers body) (Data.Response status headers body))
parseResponse :: forall status headers body.
Response status headers body
-> Response
-> IO
     (Either
        (Response status headers body) (Response status headers body))
parseResponse Response status headers body
res Response
waiRes = do
    rr <- Response status headers body
-> Response -> IO (Response status headers body)
forall status headers body.
Response status headers body
-> Response -> IO (Response status headers body)
parseResponseResult Response status headers body
res Response
waiRes
    pure $ maybe (Left (resultToError rr)) Right (resultToValue rr)

printResponse ::
    Tree.Response status headers body ->
    Data.Response status headers body ->
    IO Wai.Response
printResponse :: forall status headers body.
Response status headers body
-> Response status headers body -> IO Response
printResponse Response status headers body
codec Response status headers body
value = do
    bodyBytes <- Tree Body body body -> Printer Body body
forall i o. Tree Body i o -> Printer Body i
Body.printer Response status headers body
codec.body Response status headers body
value.body
    let responseHeaders = Tree Headers headers headers -> Printer Headers headers
forall i o. Tree Headers i o -> Printer Headers i
Headers.printer Response status headers body
codec.headers Response status headers body
value.headers
    pure $ Wai.responseLBS (Status.print codec.status value.status) responseHeaders bodyBytes