{-# LANGUAGE CPP #-} module HTTP.DemoUtils where import Config (Config (..)) import ConfigLoader (loadConfig) import Const (milliseconds) import Control.Exception (bracket) import Data.Text (Text) import HTTP.Actions (HttpActions (..)) import IOUtils (DemoActions (..), Logger, logNothingLogger, mkDemoActions) import Logger (withChannelFileLogger) import Network.HTTP.Req (http) import RuntimeConst (httpFullCapabilities) import WebDriverPreCore.HTTP.Protocol (FullCapabilities, Session, SessionResponse (..)) #ifdef LEGACY_TEST import HTTP.HttpActionsDeprecated qualified as Legacy import HTTP.HttpRunnerDeprecated qualified as Legacy #else import HTTP.Runner (mkRunner) import HTTP.Actions (mkActions) #endif data HttpDemo = Demo { name :: Text, action :: DemoActions -> HttpActions -> IO () } | SessionDemo { name :: Text, sessionAction :: Session -> DemoActions -> HttpActions -> IO () } demo :: Text -> (DemoActions -> HttpActions -> IO ()) -> HttpDemo demo = Demo sessionDemo :: Text -> (Session -> DemoActions -> HttpActions -> IO ()) -> HttpDemo sessionDemo = SessionDemo runDemo :: HttpDemo -> IO () runDemo demo' = do cfg <- loadConfig runDemoWithConfig cfg demo' runDemoWithConfig :: Config -> HttpDemo -> IO () runDemoWithConfig cfg demo' = do let run lgr = runDemo' cfg lgr demo' if cfg.logging then withChannelFileLogger run else run logNothingLogger runDemo' :: Config -> Logger -> HttpDemo -> IO () runDemo' cfg@MkConfig {httpUrl, httpPort, pauseMS} lgr demo' = do demoActions.logTxt demo'.name case demo' of Demo _ action -> action demoActions httpActions SessionDemo _ action -> withSession capabilities httpActions $ \ses -> action ses.sessionId demoActions httpActions where capabilities = httpFullCapabilities cfg demoActions = mkDemoActions lgr $ fromIntegral pauseMS * milliseconds #ifdef LEGACY_TEST runner = Legacy.mkRunner (http httpUrl) (fromIntegral httpPort) demoActions httpActions = Legacy.mkDeprecatedActions runner #else runner = mkRunner (http httpUrl) (fromIntegral httpPort) demoActions httpActions = mkActions runner #endif withSession :: FullCapabilities -> HttpActions -> (SessionResponse -> IO ()) -> IO () withSession capabilities http' action = do bracket (http'.newSession capabilities) (http'.deleteSession . (.sessionId)) action