-- | A wrapper request that adds a reson to a request
module Calamity.HTTP.Reason (
  Reason (..),
  reason,
) where

import Calamity.HTTP.Internal.Request
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Network.HTTP.Req

data Reason a = Reason a Text
  deriving (Int -> Reason a -> ShowS
[Reason a] -> ShowS
Reason a -> String
(Int -> Reason a -> ShowS)
-> (Reason a -> String) -> ([Reason a] -> ShowS) -> Show (Reason a)
forall a. Show a => Int -> Reason a -> ShowS
forall a. Show a => [Reason a] -> ShowS
forall a. Show a => Reason a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Reason a -> ShowS
showsPrec :: Int -> Reason a -> ShowS
$cshow :: forall a. Show a => Reason a -> String
show :: Reason a -> String
$cshowList :: forall a. Show a => [Reason a] -> ShowS
showList :: [Reason a] -> ShowS
Show, Reason a -> Reason a -> Bool
(Reason a -> Reason a -> Bool)
-> (Reason a -> Reason a -> Bool) -> Eq (Reason a)
forall a. Eq a => Reason a -> Reason a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Reason a -> Reason a -> Bool
== :: Reason a -> Reason a -> Bool
$c/= :: forall a. Eq a => Reason a -> Reason a -> Bool
/= :: Reason a -> Reason a -> Bool
Eq)

-- | Attach a reason to a request
reason :: Request a => Text -> a -> Reason a
reason :: forall a. Request a => Text -> a -> Reason a
reason = (a -> Text -> Reason a) -> Text -> a -> Reason a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Text -> Reason a
forall a. a -> Text -> Reason a
Reason

instance Request a => Request (Reason a) where
  type Result (Reason a) = Result a

  route :: Reason a -> Route
route (Reason a
a Text
_) = a -> Route
forall a. Request a => a -> Route
route a
a

  action :: Reason a -> Url 'Https -> Option 'Https -> Req LbsResponse
action (Reason a
a Text
r) Url 'Https
u Option 'Https
o = a -> Url 'Https -> Option 'Https -> Req LbsResponse
forall a.
Request a =>
a -> Url 'Https -> Option 'Https -> Req LbsResponse
action a
a Url 'Https
u (Option 'Https
o Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString -> Option 'Https
forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header ByteString
"X-Audit-Log-Reason" (Text -> ByteString
encodeUtf8 Text
r))