Use shared authenticated http client

Author: ChrisPenner

unison-cli/src/Unison/Codebase/Transcript/Runner.hs

@@ -104,6 +104,9 @@ withRunner ::
   (Runner -> m r) ->
   m r
 withRunner isTest verbosity ucmVersion action = do
+  credMan <- AuthN.newCredentialManager
+  authenticatedHTTPClient <- initTranscriptAuthenticatedHTTPClient credMan
+
   -- If we're in a transcript test, configure the environment to use a non-existent fzf binary
   -- so that errors are consistent.
   -- This also prevents automated transcript tests from mistakenly opening fzf and waiting for user input.
@@ -121,19 +124,38 @@ withRunner isTest verbosity ucmVersion action = do
         (MCP.mcpServer mcpServerConfig)
         \case
           Nothing -> pure $ Left PortBindingFailure
-          Just baseUrl ->
-            either
-              (pure . Left . ParseError)
-              ( run isTest verbosity codebase runtime sbRuntime ucmVersion $
-                  tShow @Server.BaseUrl baseUrl
-              )
-              $ Transcript.parse transcriptName transcriptSrc
+          Just baseUrl -> do
+            let baseUrlText = tShow @Server.BaseUrl baseUrl
+            case (Transcript.parse transcriptName transcriptSrc) of
+              Left parseError -> pure $ Left (ParseError parseError)
+              Right stanzas ->
+                run
+                  isTest
+                  verbosity
+                  codebase
+                  runtime
+                  sbRuntime
+                  ucmVersion
+                  baseUrlText
+                  authenticatedHTTPClient
+                  credMan
+                  stanzas
   where
     withRuntimes :: (Runtime.Runtime Symbol -> Runtime.Runtime Symbol -> m a) -> m a
     withRuntimes action =
       RTI.withRuntime False RTI.Persistent ucmVersion \runtime ->
         RTI.withRuntime True RTI.Persistent ucmVersion \sbRuntime ->
           action runtime sbRuntime
+    initTranscriptAuthenticatedHTTPClient :: AuthN.CredentialManager -> m AuthN.AuthenticatedHttpClient
+    initTranscriptAuthenticatedHTTPClient credMan = liftIO $ do
+      mayShareAccessToken <- fmap Text.pack <$> lookupEnv accessTokenEnvVarKey
+      let tokenProvider :: AuthN.TokenProvider
+          tokenProvider =
+            maybe
+              (AuthN.newTokenProvider credMan)
+              (\accessToken _codeserverID -> pure $ Right accessToken)
+              mayShareAccessToken
+      AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion
 
 isGeneratedBlock :: ProcessedBlock -> Bool
 isGeneratedBlock = generated . getCommonInfoTags
@@ -147,9 +169,11 @@ run ::
   Runtime.Runtime Symbol ->
   UCMVersion ->
   Text ->
+  AuthN.AuthenticatedHttpClient ->
+  AuthN.CredentialManager ->
   Transcript ->
   IO (Either Error Transcript)
-run isTest verbosity codebase runtime sbRuntime ucmVersion baseURL transcript = UnliftIO.try do
+run isTest verbosity codebase runtime sbRuntime ucmVersion baseURL authenticatedHTTPClient credMan transcript = UnliftIO.try do
   let behaviors = extractBehaviors $ settings transcript
   let stanzas' = stanzas transcript
   httpManager <- HTTP.newManager HTTP.defaultManagerSettings
@@ -163,14 +187,6 @@ run isTest verbosity codebase runtime sbRuntime ucmVersion baseURL transcript =
         "Running the provided transcript file...",
         ""
       ]
-  mayShareAccessToken <- fmap Text.pack <$> lookupEnv accessTokenEnvVarKey
-  credMan <- AuthN.newCredentialManager
-  let tokenProvider :: AuthN.TokenProvider
-      tokenProvider =
-        maybe
-          (AuthN.newTokenProvider credMan)
-          (\accessToken _codeserverID -> pure $ Right accessToken)
-          mayShareAccessToken
   -- Queue of Stanzas and Just index, or Nothing if the stanza was programmatically generated
   -- e.g. a unison-file update by a command like 'edit'
   inputQueue <-
@@ -510,8 +526,6 @@ run isTest verbosity codebase runtime sbRuntime ucmVersion baseURL transcript =
               \issues."
           (_, _, _) -> pure ()
 
-  authenticatedHTTPClient <- AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion
-
   seedRef <- newIORef (0 :: Int)
 
   let env =