{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Df1.Wai (request, response) where

import Data.ByteString.Builder qualified as BB
import Data.Functor
import Data.List qualified as List
import Data.Maybe
import Data.Text.Encoding qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL
import Df1
import Network.HTTP.Types
import Network.Wai

request :: Request -> [(Key, Value)]
request :: Request -> [(Key, Value)]
request Request
r =
   [[(Key, Value)]] -> [(Key, Value)]
forall a. Monoid a => [a] -> a
mconcat
      [ Maybe (Key, Value) -> [(Key, Value)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Key, Value) -> [(Key, Value)])
-> Maybe (Key, Value) -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
         Request -> Maybe ByteString
requestHeaderHost Request
r Maybe ByteString
-> (ByteString -> (Key, Value)) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
x ->
            (Key
"host", Text -> Value
forall a. ToValue a => a -> Value
value (ByteString -> Text
T.decodeUtf8 ByteString
x))
      ,
         [ (Key
"method", Text -> Value
forall a. ToValue a => a -> Value
value (ByteString -> Text
T.decodeUtf8 (Request -> ByteString
requestMethod Request
r)))
         ,
            ( Key
"path"
            , Text -> Value
forall a. ToValue a => a -> Value
value ([Text] -> Text
TL.fromChunks (Text
"/" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
List.intersperse Text
"/" (Request -> [Text]
pathInfo Request
r)))
            )
         ,
            ( Key
"query"
            , Text -> Value
forall a. ToValue a => a -> Value
value (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
               ByteString -> Text
TL.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$
                  Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
                     Builder
"?" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Query -> Builder
renderQueryBuilder Bool
False (Request -> Query
queryString Request
r)
            )
         , (Key
"peer", String -> Value
forall a. ToValue a => a -> Value
value (SockAddr -> String
forall a. Show a => a -> String
show (Request -> SockAddr
remoteHost Request
r)))
         ]
      , Maybe (Key, Value) -> [(Key, Value)]
forall a. Maybe a -> [a]
maybeToList (Maybe (Key, Value) -> [(Key, Value)])
-> Maybe (Key, Value) -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$
         Request -> Maybe ByteString
requestHeaderReferer Request
r Maybe ByteString
-> (ByteString -> (Key, Value)) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ByteString
x ->
            (Key
"referer", Text -> Value
forall a. ToValue a => a -> Value
value (ByteString -> Text
T.decodeUtf8 ByteString
x))
      ]

response :: Response -> [(Key, Value)]
response :: Response -> [(Key, Value)]
response Response
r =
   [ (Key
"status", Int -> Value
forall a. ToValue a => a -> Value
value (Status -> Int
statusCode (Response -> Status
responseStatus Response
r)))
   ]