Type ordinary integration probe HTTP traffic

2026-07-20 23:06:01 +09:00 · 2026-07-20 23:06:01 +09:00 · cc5c47f2ce
commit cc5c47f2ce
parent 390434bed1
4 changed files with 1022 additions and 661 deletions
--- a/test/Nuthatch/Probe/Curl.hs
+++ b/test/Nuthatch/Probe/Curl.hs
@ -1,30 +1,21 @@
 module Nuthatch.Probe.Curl
-  ( CurlResponse (..)
-  , CurlTransportFailure (..)
-  , cookieValue
+  ( CurlTransportFailure (..)
  , curl
  , curlToFile
-  , headerValue
-  , headerValues
  ) where

 import           Control.Exception (Exception, throwIO)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
-import           Data.Char (toLower)
-import           Data.List (find)
+import qualified Data.CaseInsensitive as CI
 import           Data.Maybe (mapMaybe)
+import           Network.HTTP.Types (Header)
+import           Nuthatch.Probe.Http (ProbeResponse (..))
 import           System.Exit (ExitCode (..))
 import           System.IO.Temp (withSystemTempDirectory)
 import           System.Process (readProcessWithExitCode)
 import           Text.Read (readMaybe)

-data CurlResponse = CurlResponse
-  { curlStatus  :: Int
-  , curlHeaders :: [(BS.ByteString, BS.ByteString)]
-  , curlBody    :: BS.ByteString
-  } deriving stock (Eq, Show)
-
 data CurlTransportFailure = CurlTransportFailure
  { curlTransportExitCode :: Int
  , curlTransportStderr   :: String
@ -32,19 +23,19 @@ data CurlTransportFailure = CurlTransportFailure

 instance Exception CurlTransportFailure

-curl :: [String] -> IO CurlResponse
+curl :: [String] -> IO ProbeResponse
 curl arguments =
  withSystemTempDirectory "nuthatch-curl" $ \directory -> do
    let bodyPath = directory <> "/body"
    response <- runCurl bodyPath arguments
    body <- BS.readFile bodyPath
-    pure response { curlBody = body }
+    pure response { probeBody = body }

-curlToFile :: FilePath -> [String] -> IO CurlResponse
+curlToFile :: FilePath -> [String] -> IO ProbeResponse
 curlToFile outputPath arguments =
  runCurl outputPath arguments

-runCurl :: FilePath -> [String] -> IO CurlResponse
+runCurl :: FilePath -> [String] -> IO ProbeResponse
 runCurl outputPath arguments =
  withSystemTempDirectory "nuthatch-curl-headers" $ \directory -> do
    let headersPath = directory <> "/headers"
@ -70,13 +61,13 @@ runCurl outputPath arguments =
          , curlTransportStderr = stderrText
          }
    headers <- parseHeaders <$> BS.readFile headersPath
-    pure CurlResponse
-      { curlStatus = status
-      , curlHeaders = headers
-      , curlBody = BS.empty
+    pure ProbeResponse
+      { probeStatus = status
+      , probeHeaders = headers
+      , probeBody = BS.empty
      }

-parseHeaders :: BS.ByteString -> [(BS.ByteString, BS.ByteString)]
+parseHeaders :: BS.ByteString -> [Header]
 parseHeaders input =
  case filter (not . null) (splitBlocks (B8.lines input)) of
    [] -> []
@ -88,45 +79,15 @@ parseHeaders input =
      | otherwise = (stripCarriageReturn line : block) : blocks
    splitLine _ [] = []

-parseHeader :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)
+parseHeader :: BS.ByteString -> Maybe Header
 parseHeader line =
  case B8.break (== ':') line of
    (_, remainder) | BS.null remainder -> Nothing
    (name, remainder) ->
-      Just (lower name, B8.dropWhile (== ' ') (BS.drop 1 remainder))
-
-headerValue :: BS.ByteString -> CurlResponse -> Maybe BS.ByteString
-headerValue name response =
-  snd <$> find ((== lower name) . fst) (curlHeaders response)
-
-headerValues :: BS.ByteString -> CurlResponse -> [BS.ByteString]
-headerValues name response =
-  map snd (filter ((== lower name) . fst) (curlHeaders response))
-
-lower :: BS.ByteString -> BS.ByteString
-lower = B8.map toLower
+      Just (CI.mk name, B8.dropWhile (== ' ') (BS.drop 1 remainder))

 stripCarriageReturn :: BS.ByteString -> BS.ByteString
 stripCarriageReturn value =
  case B8.unsnoc value of
    Just (prefix, '\r') -> prefix
    _ -> value
-
-cookieValue :: FilePath -> BS.ByteString -> IO BS.ByteString
-cookieValue path expectedName = do
-  contents <- B8.lines <$> BS.readFile path
-  case mapMaybe parseCookie contents of
-    cookies ->
-      maybe
-        (fail ("cookie not found: " <> B8.unpack expectedName))
-        pure
-        (lookup expectedName cookies)
-
-parseCookie :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)
-parseCookie line =
-  let normalized =
-        maybe line id (BS.stripPrefix "#HttpOnly_" line)
-      fields = B8.split '\t' normalized
-  in case drop 5 fields of
-      name : value : _ -> Just (name, value)
-      _ -> Nothing
--- a/test/Nuthatch/Probe/Http.hs
+++ b/test/Nuthatch/Probe/Http.hs
@ -0,0 +1,258 @@
+module Nuthatch.Probe.Http
+  ( CookieSession
+  , HttpException
+  , ProbeClient
+  , ProbeResponse (..)
+  , RequestBody (..)
+  , RequestOptions (..)
+  , cookieHeader
+  , cookieValue
+  , defaultRequestOptions
+  , downloadTo
+  , get
+  , getWith
+  , headWith
+  , headerValue
+  , headerValues
+  , isConnectionFailure
+  , newCookieSession
+  , newProbeClient
+  , postWith
+  , putWith
+  ) where
+
+import           Control.Concurrent.MVar
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
+import qualified Data.ByteString.Lazy as BL
+import           Data.List (find)
+import qualified Data.CaseInsensitive as CI
+import           Network.Connection (TLSSettings (..))
+import           Network.HTTP.Client
+  ( Cookie (..)
+  , CookieJar
+  , HttpException (..)
+  , HttpExceptionContent (..)
+  , Manager
+  , Request
+  , Response
+  , brRead
+  , applyBasicAuth
+  , checkResponse
+  , cookieJar
+  , createCookieJar
+  , destroyCookieJar
+  , httpLbs
+  , method
+  , parseRequest
+  , redirectCount
+  , requestBody
+  , requestHeaders
+  , responseBody
+  , responseCookieJar
+  , responseHeaders
+  , responseStatus
+  , responseTimeout
+  , responseTimeoutMicro
+  , withResponse
+  )
+import qualified Network.HTTP.Client as HTTP
+import           Network.HTTP.Client.TLS (mkManagerSettings)
+import           Network.HTTP.Types
+  ( Header
+  , Method
+  , hContentType
+  , methodGet
+  , methodHead
+  , methodPost
+  , methodPut
+  , statusCode
+  )
+import           Network.HTTP.Types.URI (renderSimpleQuery)
+import           Network.TLS (defaultSupported)
+import           System.IO (IOMode (WriteMode), withBinaryFile)
+
+newtype ProbeClient = ProbeClient Manager
+
+newtype CookieSession = CookieSession (MVar CookieJar)
+
+data ProbeResponse = ProbeResponse
+  { probeStatus  :: Int
+  , probeHeaders :: [Header]
+  , probeBody    :: BS.ByteString
+  }
+  deriving stock (Eq, Show)
+
+data RequestBody
+  = NoBody
+  | ByteBody BS.ByteString
+  | FileBody FilePath
+  | FormBody [(BS.ByteString, BS.ByteString)]
+  deriving stock (Eq, Show)
+
+data RequestOptions = RequestOptions
+  { optionHeaders       :: [Header]
+  , optionBody          :: RequestBody
+  , optionCookies       :: Maybe CookieSession
+  , optionBasicAuth     :: Maybe (BS.ByteString, BS.ByteString)
+  , optionQuery         :: [(BS.ByteString, Maybe BS.ByteString)]
+  , optionTimeoutMicros :: Maybe Int
+  }
+
+defaultRequestOptions :: RequestOptions
+defaultRequestOptions = RequestOptions
+  { optionHeaders = []
+  , optionBody = NoBody
+  , optionCookies = Nothing
+  , optionBasicAuth = Nothing
+  , optionQuery = []
+  , optionTimeoutMicros = Nothing
+  }
+
+newProbeClient :: IO ProbeClient
+newProbeClient =
+  ProbeClient <$> HTTP.newManager
+    (mkManagerSettings
+      TLSSettingsSimple
+        { settingDisableCertificateValidation = True
+        , settingDisableSession = False
+        , settingUseServerName = True
+        , settingClientSupported = defaultSupported
+        }
+      Nothing)
+
+newCookieSession :: IO CookieSession
+newCookieSession = CookieSession <$> newMVar (createCookieJar [])
+
+get :: ProbeClient -> String -> IO ProbeResponse
+get client = getWith client defaultRequestOptions
+
+getWith :: ProbeClient -> RequestOptions -> String -> IO ProbeResponse
+getWith client = perform client methodGet
+
+postWith :: ProbeClient -> RequestOptions -> String -> IO ProbeResponse
+postWith client = perform client methodPost
+
+putWith :: ProbeClient -> RequestOptions -> String -> IO ProbeResponse
+putWith client = perform client methodPut
+
+headWith :: ProbeClient -> RequestOptions -> String -> IO ProbeResponse
+headWith client = perform client methodHead
+
+downloadTo
+  :: ProbeClient
+  -> RequestOptions
+  -> FilePath
+  -> String
+  -> IO ProbeResponse
+downloadTo (ProbeClient manager) options outputPath url = do
+  request <- buildRequest methodGet options url
+  withResponse request manager $ \response -> do
+    updateCookies options response
+    withBinaryFile outputPath WriteMode $ \handle ->
+      drain handle (responseBody response)
+    pure (responseWithoutBody response)
+  where
+    drain handle reader = do
+      chunk <- brRead reader
+      if BS.null chunk
+        then pure ()
+        else BS.hPut handle chunk >> drain handle reader
+
+perform
+  :: ProbeClient
+  -> Method
+  -> RequestOptions
+  -> String
+  -> IO ProbeResponse
+perform (ProbeClient manager) requestMethod options url = do
+  request <- buildRequest requestMethod options url
+  response <- httpLbs request manager
+  updateCookies options response
+  pure ProbeResponse
+    { probeStatus = statusCode (responseStatus response)
+    , probeHeaders = responseHeaders response
+    , probeBody = BL.toStrict (responseBody response)
+    }
+
+buildRequest :: Method -> RequestOptions -> String -> IO Request
+buildRequest requestMethod options url = do
+  initial <- parseRequest url
+  body <- toRequestBody (optionBody options)
+  storedCookies <- traverse readCookies (optionCookies options)
+  let formHeaders =
+        case optionBody options of
+          FormBody _ -> [(hContentType, "application/x-www-form-urlencoded")]
+          _ -> []
+      queried =
+        if null (optionQuery options)
+          then initial
+          else HTTP.setQueryString (optionQuery options) initial
+  let configured =
+        queried
+          { method = requestMethod
+          , requestHeaders = formHeaders <> optionHeaders options
+          , requestBody = body
+          , cookieJar = storedCookies
+          , redirectCount = 0
+          , checkResponse = \_ _ -> pure ()
+          , responseTimeout =
+              maybe
+                (responseTimeout initial)
+                responseTimeoutMicro
+                (optionTimeoutMicros options)
+          }
+  pure $ maybe configured
+    (\(username, password) -> applyBasicAuth username password configured)
+    (optionBasicAuth options)
+
+toRequestBody :: RequestBody -> IO HTTP.RequestBody
+toRequestBody NoBody = pure (HTTP.RequestBodyBS BS.empty)
+toRequestBody (ByteBody body) = pure (HTTP.RequestBodyBS body)
+toRequestBody (FileBody path) = HTTP.streamFile path
+toRequestBody (FormBody fields) =
+  pure . HTTP.RequestBodyBS $ renderSimpleQuery False fields
+
+updateCookies :: RequestOptions -> Response body -> IO ()
+updateCookies options response =
+  case optionCookies options of
+    Nothing -> pure ()
+    Just (CookieSession storage) -> do
+      _ <- swapMVar storage (responseCookieJar response)
+      pure ()
+
+readCookies :: CookieSession -> IO CookieJar
+readCookies (CookieSession storage) = readMVar storage
+
+cookieValue :: CookieSession -> BS.ByteString -> IO BS.ByteString
+cookieValue session expectedName = do
+  cookies <- destroyCookieJar <$> readCookies session
+  maybe
+    (fail ("cookie not found: " <> B8.unpack expectedName))
+    (pure . cookie_value)
+    (find ((== expectedName) . cookie_name) cookies)
+
+cookieHeader :: CookieSession -> IO BS.ByteString
+cookieHeader session = do
+  cookies <- destroyCookieJar <$> readCookies session
+  pure . B8.intercalate "; " $
+    [cookie_name cookie <> "=" <> cookie_value cookie | cookie <- cookies]
+
+headerValue :: BS.ByteString -> ProbeResponse -> Maybe BS.ByteString
+headerValue name response =
+  snd <$> find ((== CI.mk name) . fst) (probeHeaders response)
+
+headerValues :: BS.ByteString -> ProbeResponse -> [BS.ByteString]
+headerValues name response =
+  map snd (filter ((== CI.mk name) . fst) (probeHeaders response))
+
+responseWithoutBody :: Response body -> ProbeResponse
+responseWithoutBody response = ProbeResponse
+  { probeStatus = statusCode (responseStatus response)
+  , probeHeaders = responseHeaders response
+  , probeBody = BS.empty
+  }
+
+isConnectionFailure :: HttpException -> Bool
+isConnectionFailure (HttpExceptionRequest _ (ConnectionFailure _)) = True
+isConnectionFailure _ = False
--- a/test/Nuthatch/Probe/Oidc.hs
+++ b/test/Nuthatch/Probe/Oidc.hs
@ -20,13 +20,12 @@ import           Data.Char (toLower)
 import           Data.List (find)
 import           Data.Maybe (fromMaybe)
 import           Nuthatch.Probe.Assert
-import           Nuthatch.Probe.Curl
+import           Nuthatch.Probe.Http
 import           System.Environment (lookupEnv)
-import           System.FilePath ((</>))

 data ProbeContext = ProbeContext
-  { probeBase             :: String
-  , probeDirectory        :: FilePath
+  { probeClient           :: ProbeClient
+  , probeBase             :: String
  , probeOidcIssuer       :: String
  , probeOidcProvider     :: String
  , probeOidcPassword     :: String
@ -37,7 +36,7 @@ data ProbeContext = ProbeContext
  }

 data Session = Session
-  { sessionCookies :: FilePath
+  { sessionCookies :: CookieSession
  , sessionCsrf    :: BS.ByteString
  }

@ -64,8 +63,9 @@ instance FromJSON OidcDiscovery where
  parseJSON = withObject "OidcDiscovery" $ \object ->
    OidcDiscovery <$> object .: "token_endpoint"

-newProbeContext :: FilePath -> IO ProbeContext
-newProbeContext directory = do
+newProbeContext :: IO ProbeContext
+newProbeContext = do
+  client <- newProbeClient
  lane <- requireEnv "NUTHATCH_FIXTURE_LANE"
  issuer <- requireEnv "NUTHATCH_OIDC_ISSUER"
  provider <- requireEnv "NUTHATCH_OIDC_PROVIDER"
@ -75,8 +75,8 @@ newProbeContext directory = do
  clientSecret <- requireEnv "NUTHATCH_OIDC_CLIENT_SECRET"
  redirectUri <- requireEnv "NUTHATCH_OIDC_REDIRECT_URI"
  pure ProbeContext
-    { probeBase = "https://nuthatch-" <> lane <> ":8080"
-    , probeDirectory = directory
+    { probeClient = client
+    , probeBase = "https://nuthatch-" <> lane <> ":8080"
    , probeOidcIssuer = issuer
    , probeOidcProvider = provider
    , probeOidcPassword = password
@ -88,15 +88,15 @@ newProbeContext directory = do

 login :: ProbeContext -> Bool -> String -> String -> IO Session
 login context verifyBoundary user suffix = do
-  let cookies = probeDirectory context </> "cookies-" <> suffix
-      idpCookies = probeDirectory context </> "idp-" <> suffix
+  cookies <- newCookieSession
+  idpCookies <- newCookieSession
  started <-
    retryTransport 20 $
-      curl
-        [ "--cookie-jar", cookies
-        , probeBase context <> "/login"
-        ]
-  assertEqual "login redirect status" 303 (curlStatus started)
+      getWith
+        (probeClient context)
+        defaultRequestOptions { optionCookies = Just cookies }
+        (probeBase context <> "/login")
+  assertEqual "login redirect status" 303 (probeStatus started)
  authorizationUrl <-
    maybe (fail "login response omitted Location") (pure . B8.unpack) $
      headerValue "location" started
@ -109,12 +109,11 @@ login context verifyBoundary user suffix = do
    then verifyTransactionBoundary context cookies authorizationUrl state
    else pure ()
  callback <- completeAuthorization context idpCookies user suffix authorizationUrl
-  completed <- curl
-    [ "--cookie", cookies
-    , "--cookie-jar", cookies
-    , callback
-    ]
-  assertEqual "OIDC callback status" 303 (curlStatus completed)
+  completed <- getWith
+    (probeClient context)
+    defaultRequestOptions { optionCookies = Just cookies }
+    callback
+  assertEqual "OIDC callback status" 303 (probeStatus completed)
  assertEqual "OIDC callback location"
    (Just "/app")
    (B8.unpack <$> headerValue "location" completed)
@ -143,12 +142,12 @@ login context verifyBoundary user suffix = do

 verifyPkceBoundary :: ProbeContext -> String -> IO ()
 verifyPkceBoundary context user = do
-  let cookies = probeDirectory context </> "cookies-pkce"
-      idpCookies = probeDirectory context </> "idp-pkce"
-  started <- curl
-    [ "--cookie-jar", cookies
-    , probeBase context <> "/login"
-    ]
+  cookies <- newCookieSession
+  idpCookies <- newCookieSession
+  started <- getWith
+    (probeClient context)
+    defaultRequestOptions { optionCookies = Just cookies }
+    (probeBase context <> "/login")
  authorizationUrl <-
    maybe (fail "PKCE login omitted Location") (pure . B8.unpack) $
      headerValue "location" started
@ -159,62 +158,72 @@ verifyPkceBoundary context user = do
    "pkce"
    authorizationUrl
  code <- queryValue "code" callback
-  discoveryResponse <- curl
-    [probeOidcIssuer context <> "/.well-known/openid-configuration"]
-  assertEqual "OIDC discovery status" 200 (curlStatus discoveryResponse)
+  discoveryResponse <- get
+    (probeClient context)
+    (probeOidcIssuer context <> "/.well-known/openid-configuration")
+  assertEqual "OIDC discovery status" 200 (probeStatus discoveryResponse)
  OidcDiscovery tokenEndpoint <-
    decodeBody "OIDC discovery" discoveryResponse
-  rejected <- curl
-    [ "--user"
-    , probeOidcClientId context <> ":" <> probeOidcClientSecret context
-    , "--data-urlencode", "grant_type=authorization_code"
-    , "--data-urlencode", "code=" <> code
-    , "--data-urlencode", "redirect_uri=" <> probeOidcRedirectUri context
-    , "--data-urlencode"
-    , "code_verifier=aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-    , tokenEndpoint
-    ]
+  rejected <- postWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionBasicAuth = Just
+          ( B8.pack (probeOidcClientId context)
+          , B8.pack (probeOidcClientSecret context)
+          )
+      , optionBody = FormBody
+          [ ("grant_type", "authorization_code")
+          , ("code", B8.pack code)
+          , ("redirect_uri", B8.pack (probeOidcRedirectUri context))
+          , ( "code_verifier"
+            , "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+            )
+          ]
+      }
+    tokenEndpoint
  assert "provider accepted an invalid PKCE verifier" $
-    curlStatus rejected >= 400
+    probeStatus rejected >= 400

 verifyTransactionBoundary
  :: ProbeContext
-  -> FilePath
+  -> CookieSession
  -> String
  -> String
  -> IO ()
 verifyTransactionBoundary context cookies authorizationUrl state = do
-  wrongRedirect <- curl [replaceRedirectUri authorizationUrl]
+  wrongRedirect <- get (probeClient context) (replaceRedirectUri authorizationUrl)
  assert "provider accepted an unregistered redirect URI" $
-    curlStatus wrongRedirect >= 400
-  invalidState <- curl
-    [ "--cookie", cookies
-    , probeBase context
+    probeStatus wrongRedirect >= 400
+  invalidState <- getWith
+    (probeClient context)
+    defaultRequestOptions { optionCookies = Just cookies }
+    (probeBase context
      <> "/oidc/callback?code=unused&state=invalid-"
-      <> state
-    ]
+      <> state)
  assert "application accepted an invalid OIDC state" $
-    curlStatus invalidState >= 400
+    probeStatus invalidState >= 400
  transaction <- cookieValue cookies "nuthatch_oidc"
-  malformed <- curl
-    [ "--header", "Cookie: nuthatch_oidc=malformed"
-    , probeBase context
+  malformed <- getWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionHeaders = [("Cookie", "nuthatch_oidc=malformed")] }
+    (probeBase context
      <> "/oidc/callback?code=unused&state="
-      <> state
-    ]
-  assertEqual "malformed transaction cookie" 400 (curlStatus malformed)
+      <> state)
+  assertEqual "malformed transaction cookie" 400 (probeStatus malformed)
  let tampered = BS.cons 120 (BS.drop 1 transaction)
-  tamperedResponse <- curl
-    [ "--header", "Cookie: nuthatch_oidc=" <> B8.unpack tampered
-    , probeBase context
+  tamperedResponse <- getWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionHeaders = [("Cookie", "nuthatch_oidc=" <> tampered)] }
+    (probeBase context
      <> "/oidc/callback?code=unused&state="
-      <> state
-    ]
-  assertEqual "tampered transaction cookie" 400 (curlStatus tamperedResponse)
+      <> state)
+  assertEqual "tampered transaction cookie" 400 (probeStatus tamperedResponse)

 completeAuthorization
  :: ProbeContext
-  -> FilePath
+  -> CookieSession
  -> String
  -> String
  -> String
@ -230,25 +239,28 @@ completeAuthorization context idpCookies user suffix authorizationUrl =

 completeKeycloak
  :: ProbeContext
-  -> FilePath
+  -> CookieSession
  -> String
  -> String
  -> IO String
 completeKeycloak context idpCookies user authorizationUrl = do
-  form <- curl
-    [ "--cookie-jar", idpCookies
-    , authorizationUrl
-    ]
-  assertEqual "Keycloak authorization form" 200 (curlStatus form)
-  action <- htmlAttribute "action" (B8.unpack (curlBody form))
-  submitted <- curl
-    [ "--cookie", idpCookies
-    , "--cookie-jar", idpCookies
-    , "--data-urlencode", "username=" <> user
-    , "--data-urlencode", "password=" <> probeOidcPassword context
-    , "--data-urlencode", "credentialId="
-    , action
-    ]
+  form <- getWith
+    (probeClient context)
+    defaultRequestOptions { optionCookies = Just idpCookies }
+    authorizationUrl
+  assertEqual "Keycloak authorization form" 200 (probeStatus form)
+  action <- htmlAttribute "action" (B8.unpack (probeBody form))
+  submitted <- postWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionCookies = Just idpCookies
+      , optionBody = FormBody
+          [ ("username", B8.pack user)
+          , ("password", B8.pack (probeOidcPassword context))
+          , ("credentialId", "")
+          ]
+      }
+    action
  maybe
    (fail "Keycloak login omitted callback Location")
    (pure . B8.unpack)
@ -263,49 +275,57 @@ completeZitadel
 completeZitadel context user _ authorizationUrl = do
  pat <- maybe (fail "ZITADEL login PAT is missing") pure $
    probeOidcLoginPat context
-  started <- curl [authorizationUrl]
+  started <- get (probeClient context) authorizationUrl
  location <- maybe
    (fail "ZITADEL login omitted Location")
    (pure . B8.unpack)
    (headerValue "location" started)
  authRequest <- queryValue "authRequest" location
-  created <- curl
-    [ "--header", "Authorization: Bearer " <> pat
-    , "--header", "Content-Type: application/json"
-    , "--data"
-    , "{\"checks\":{\"user\":{\"userId\":\""
+  created <- postWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionHeaders =
+          [ ("Authorization", "Bearer " <> B8.pack pat)
+          , ("Content-Type", "application/json")
+          ]
+      , optionBody = ByteBody . B8.pack $
+          "{\"checks\":{\"user\":{\"userId\":\""
      <> user
      <> "\"},\"password\":{\"password\":\""
      <> probeOidcPassword context
      <> "\"}},\"lifetime\":\"300s\"}"
-    , probeOidcIssuer context <> "/v2/sessions"
-    ]
+      }
+    (probeOidcIssuer context <> "/v2/sessions")
  assert "ZITADEL session creation failed" $
-    curlStatus created >= 200 && curlStatus created < 300
+    probeStatus created >= 200 && probeStatus created < 300
  ZitadelSession {..} <- decodeBody "ZITADEL session" created
-  finalized <- curl
-    [ "--header", "Authorization: Bearer " <> pat
-    , "--header", "Content-Type: application/json"
-    , "--data"
-    , "{\"session\":{\"sessionId\":\""
+  finalized <- postWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionHeaders =
+          [ ("Authorization", "Bearer " <> B8.pack pat)
+          , ("Content-Type", "application/json")
+          ]
+      , optionBody = ByteBody . B8.pack $
+          "{\"session\":{\"sessionId\":\""
      <> zitadelSessionId
      <> "\",\"sessionToken\":\""
      <> zitadelSessionToken
      <> "\"}}"
-    , probeOidcIssuer context
+      }
+    (probeOidcIssuer context
      <> "/v2/oidc/auth_requests/"
-      <> authRequest
-    ]
-  assertEqual "ZITADEL authorization finalization" 200 (curlStatus finalized)
+      <> authRequest)
+  assertEqual "ZITADEL authorization finalization" 200 (probeStatus finalized)
  ZitadelCallback callback <- decodeBody "ZITADEL callback" finalized
  pure callback

-decodeBody :: FromJSON value => String -> CurlResponse -> IO value
+decodeBody :: FromJSON value => String -> ProbeResponse -> IO value
 decodeBody label response =
  either (fail . ((label <> ": ") <>)) pure $
-    eitherDecodeStrict' (curlBody response)
+    eitherDecodeStrict' (probeBody response)

-findCookie :: BS.ByteString -> CurlResponse -> BS.ByteString
+findCookie :: BS.ByteString -> ProbeResponse -> BS.ByteString
 findCookie name response =
  fromMaybe BS.empty $
    find (containsLower (lower name <> "=")) (headerValues "set-cookie" response)
--- a/test/Nuthatch/Probe/ProductClient.hs
+++ b/test/Nuthatch/Probe/ProductClient.hs
@ -2,10 +2,8 @@ module Nuthatch.Probe.ProductClient
  ( browse
  , deleteObject
  , download
-  , downloadFrom
  , sha256Hex
  , upload
-  , uploadTo
  ) where

 import           Crypto.Hash (Digest, SHA256, hash)
@ -16,49 +14,39 @@ import qualified Data.ByteString.Char8 as B8
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Network.HTTP.Types.URI (urlEncode)
-import           Nuthatch.Probe.Curl
+import           Nuthatch.Probe.Http
 import           Nuthatch.Probe.Oidc
-import           System.IO.Temp (withSystemTempFile)
-import           System.IO (hClose)

 browse
  :: ProbeContext
  -> Session
  -> String
-  -> IO CurlResponse
+  -> IO ProbeResponse
 browse context session query =
-  curl
-    [ "--cookie", sessionCookies session
-    , "--header", "Accept: application/json"
-    , probeBase context <> "/api/browse" <> query
-    ]
+  getWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionCookies = Just (sessionCookies session)
+      , optionHeaders = [("Accept", "application/json")]
+      }
+    (probeBase context <> "/api/browse" <> query)

 download
  :: ProbeContext
  -> Session
  -> String
  -> String
-  -> IO CurlResponse
-download context =
-  downloadFrom (probeBase context) []
-
-downloadFrom
-  :: String
-  -> [String]
-  -> Session
-  -> String
-  -> String
-  -> IO CurlResponse
-downloadFrom base extra session root path =
-  curl
-    ( extra
-    <> [ "--cookie", sessionCookies session
-       , base
-         <> "/api/download?root="
-         <> encode root
-         <> "&path="
-         <> encode path
-       ]
+  -> IO ProbeResponse
+download context session root path =
+  getWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionCookies = Just (sessionCookies session) }
+    ( probeBase context
+    <> "/api/download?root="
+    <> encode root
+    <> "&path="
+    <> encode path
    )

 upload
@ -68,41 +56,28 @@ upload
  -> String
  -> String
  -> BS.ByteString
-  -> IO CurlResponse
-upload context =
-  uploadTo (probeBase context) []
-
-uploadTo
-  :: String
-  -> [String]
-  -> Session
-  -> String
-  -> String
-  -> String
-  -> BS.ByteString
-  -> IO CurlResponse
-uploadTo base extra session root path operationId body =
-  withSystemTempFile "nuthatch-upload" $ \bodyPath handle -> do
-    BS.hPut handle body
-    hClose handle
-    curl
-      ( extra
-      <> [ "--cookie", sessionCookies session
-         , "--header", "Content-Type: application/octet-stream"
-         , "--header", "X-Declared-Size: " <> show (BS.length body)
-         , "--header", "X-Content-SHA256: " <> B8.unpack (sha256Hex body)
-         , "--header"
-         , "X-CSRF-Token: " <> B8.unpack (sessionCsrf session)
-         , "--data-binary", "@" <> bodyPath
-         , base
-           <> "/api/upload?root="
-           <> encode root
-           <> "&path="
-           <> encode path
-           <> "&operation_id="
-           <> encode operationId
-         ]
-      )
+  -> IO ProbeResponse
+upload context session root path operationId body =
+  postWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionCookies = Just (sessionCookies session)
+      , optionHeaders =
+          [ ("Content-Type", "application/octet-stream")
+          , ("X-Declared-Size", B8.pack (show (BS.length body)))
+          , ("X-Content-SHA256", sha256Hex body)
+          , ("X-CSRF-Token", sessionCsrf session)
+          ]
+      , optionBody = ByteBody body
+      }
+    ( probeBase context
+    <> "/api/upload?root="
+    <> encode root
+    <> "&path="
+    <> encode path
+    <> "&operation_id="
+    <> encode operationId
+    )

 deleteObject
  :: ProbeContext
@ -110,13 +85,15 @@ deleteObject
  -> String
  -> String
  -> String
-  -> IO CurlResponse
+  -> IO ProbeResponse
 deleteObject context session root path operationId =
-  curl
-    [ "--cookie", sessionCookies session
-    , "--header", "Content-Type: application/json"
-    , "--data"
-    , "{\"root\":\""
+  postWith
+    (probeClient context)
+    defaultRequestOptions
+      { optionCookies = Just (sessionCookies session)
+      , optionHeaders = [("Content-Type", "application/json")]
+      , optionBody = ByteBody . B8.pack $
+          "{\"root\":\""
      <> root
      <> "\",\"path\":\""
      <> path
@ -125,8 +102,8 @@ deleteObject context session root path operationId =
      <> "\",\"csrf\":\""
      <> B8.unpack (sessionCsrf session)
      <> "\"}"
-    , probeBase context <> "/api/delete"
-    ]
+      }
+    (probeBase context <> "/api/delete")

 sha256Hex :: BS.ByteString -> BS.ByteString
 sha256Hex input =