HttpRunnerDeprecated.hs

module HTTP.HttpRunnerDeprecated
  ( run,
    mkRunner,
    HttpRunnerDeprecated (..),
  )
where

import Const (ReqRequestParams (..))
import Control.Exception (throw)
import Data.Aeson (Result (..), Value, object, withObject, (.:))
import Data.Aeson.Types (Parser, parseMaybe)
import Data.Function ((&))
import HTTP.HttpClient (callWebDriver, fullCommandPath)
import IOUtils (DemoActions (..))
import Network.HTTP.Req (Scheme (Http), Url)
import Network.HTTP.Req as R
  ( DELETE (DELETE),
    GET (GET),
    NoReqBody (NoReqBody),
    POST (POST),
    ReqBodyJson (ReqBodyJson),
  )
import Utils (UrlPath (..))
import WebDriverPreCore.Http
  ( HttpSpec (..),
  )
import WebDriverPreCore.Http qualified as W
import WebDriverPreCore.HTTP.Protocol (parseWebDriverException, WebDriverException(..))
import Prelude hiding (log)

-- ############# Runner #############

newtype HttpRunnerDeprecated = MkHttpRunnerDeprecated {run :: forall r. (Show r) => HttpSpec r -> IO r}

mkRunner :: Url 'Http -> Int -> DemoActions -> HttpRunnerDeprecated
mkRunner driverUrl port da = MkHttpRunnerDeprecated $ run driverUrl port da

run :: forall r. (Show r) => Url 'Http -> Int -> DemoActions -> HttpSpec r -> IO r
run url port da spec = do
  logSpec da spec
  callWebDriver da (mkRequest url port spec) >>= parseIO spec

logSpec :: (Show a) => DemoActions -> HttpSpec a -> IO ()
logSpec MkDemoActions {logTxt, logShow, logJSON} spec = do
  logTxt "Request"
  logShow "HttpSpec" spec
  case spec of
    Get {} -> pure ()
    Post {body} -> do
      logJSON "body PP" body
    PostEmpty {} -> pure ()
    Delete {} -> pure ()

mkRequest :: forall r. Url 'Http -> Int -> HttpSpec r -> ReqRequestParams
mkRequest driverUrl port spec = case spec of
  Get {} -> MkRequestParams url GET NoReqBody port
  Post {body} -> MkRequestParams url POST (ReqBodyJson body) port
  PostEmpty {} -> MkRequestParams url POST (ReqBodyJson $ object []) port
  Delete {} -> MkRequestParams url DELETE NoReqBody port
  where
    url = fullCommandPath driverUrl spec.path.segments

parseIO :: HttpSpec a -> W.HttpResponse -> IO a
parseIO spec r =
  spec.parser r
    & \case
      Error _ -> throwFailure r.body
      Success a -> pure a

throwFailure :: Value -> IO a
throwFailure body =
  parseMaybe valueParser body
    & maybe
      (throw $ ResponseParseException "No value property found in WebDriver response" body)
      (throw . parseWebDriverException "Could not find body property")

valueParser :: Value -> Parser Value
valueParser body = body & withObject "body value" (.: "value")