{-# language DataKinds #-}

module Fedi.Requests where

import Data.List (intercalate)
import Data.Aeson qualified as A
import Fedi.Helpers
import Fedi.UserDetails
import Fedi.Signature.Sign
import Network.HTTP.Req qualified as Req
import Data.ByteString.Lazy qualified as BSL
import Text.URI qualified as URI
import Data.Text qualified as T

sendPost
  :: A.ToJSON input
  => UserDetails
  -> String
  -> input
  -> IO ByteString
sendPost details url payload = do
  uri <- URI.mkURI $ fromString url
  let encoded = BSL.toStrict $ A.encode payload
  httpSignature <- makeHttpSignature details uri encoded
  (url', scheme) <- maybe (throw "couldn't parse uri") pure (Req.useHttpsURI uri)
  Req.runReq Req.defaultHttpConfig do
    r <-
      Req.req
        Req.POST
        url'
        (Req.ReqBodyBs encoded)
        Req.bsResponse
        ( scheme
          <> sigHeaders httpSignature
        )
    pure $ Req.responseBody r

makeHttpSignature :: UserDetails -> URI.URI -> ByteString -> IO HttpSignature
makeHttpSignature details uri encoded = do
  host <- case uri.uriAuthority of
    Right u -> pure $ T.unpack $ URI.unRText u.authHost
    _ -> throw "no host in uri"
  -- We may want to add the uri path and uri query,
  -- but maybe later.
  let
    path = case uri.uriPath of
      Just (_, list) ->
        "/" <> intercalate "/" (map (T.unpack . URI.unRText) $ toList list)
      Nothing -> "/"
  signSignature details host ("post " <> path) encoded


sigHeaders :: HttpSignature -> Req.Option scheme
sigHeaders =
  foldMap (uncurry Req.header) . makeSigHeaders

makeSigHeaders :: HttpSignature -> [(ByteString, ByteString)]
makeSigHeaders httpSignature =
  [ ("ContentType", "application/activity+json")
  , ("Accept", "application/activity+json")
  , ("Digest", httpSignature.digest)
  , ("Host", fromString httpSignature.host)
  , ("Date", fromString httpSignature.date)
  , ("Signature", toSignature httpSignature.signatureHeader)
  ]

sendGet :: (A.FromJSON a) => String -> IO a
sendGet url = do
  uri <- URI.mkURI $ fromString url
  (url', scheme) <- maybe (throw "couldn't parse uri") pure (Req.useHttpsURI uri)

  Req.runReq Req.defaultHttpConfig do
    r <-
      Req.req
        Req.GET
        url'
        Req.NoReqBody
        Req.jsonResponse
        ( scheme
          <> Req.header "ContentType" "application/activity+json"
        )
    pure $ Req.responseBody r