add unison share url to loop state env

This commit is contained in:
Mitchell Rosen 2022-04-28 12:00:44 -04:00
parent 2bbeeaca0e
commit 5e8f1101f9
4 changed files with 12 additions and 7 deletions

View File

@ -16,14 +16,14 @@ newtype AuthorizedHttpClient = AuthorizedHttpClient HTTP.Manager
-- | Returns a new http manager which applies the appropriate Authorization header to
-- any hosts our UCM is authenticated with.
newAuthorizedHTTPClient :: MonadIO m => CredentialManager -> UCMVersion -> m HTTP.Manager
newAuthorizedHTTPClient :: MonadIO m => CredentialManager -> UCMVersion -> m AuthorizedHttpClient
newAuthorizedHTTPClient credsMan ucmVersion = liftIO $ do
let tokenProvider = newTokenProvider credsMan
let managerSettings =
HTTP.tlsManagerSettings
& HTTP.addRequestMiddleware (authMiddleware tokenProvider)
& HTTP.setUserAgent (HTTP.ucmUserAgent ucmVersion)
HTTP.newTlsManagerWith managerSettings
AuthorizedHttpClient <$> HTTP.newTlsManagerWith managerSettings
-- | Adds Bearer tokens to requests according to their host.
-- If a CredentialFailure occurs (failure to refresh a token), auth is simply omitted,

View File

@ -11,8 +11,9 @@ import Control.Monad.State
import Data.Configurator ()
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as Nel
import qualified Network.HTTP.Client as HTTP
import Servant.Client (BaseUrl)
import Unison.Auth.CredentialManager (CredentialManager)
import Unison.Auth.HTTPClient (AuthorizedHttpClient)
import Unison.Codebase (Codebase)
import Unison.Codebase.Branch
( Branch (..),
@ -30,9 +31,11 @@ import qualified Unison.Util.Free as Free
type F m i v = Free (Command m i v)
data Env m v = Env
{ authHTTPClient :: HTTP.Manager,
{ authHTTPClient :: AuthorizedHttpClient,
codebase :: Codebase m v Ann,
credentialManager :: CredentialManager
credentialManager :: CredentialManager,
-- | The URL to Unison Share
unisonShareUrl :: BaseUrl
}
newtype Action m i v a = Action {unAction :: MaybeT (ReaderT (Env m v) (StateT (LoopState m v) (F m i v))) a}

View File

@ -379,7 +379,8 @@ run dir stanzas codebase runtime config ucmVersion = UnliftIO.try $ do
LoopState.Env
{ LoopState.authHTTPClient = error "Error: No access to authorized requests from transcripts.",
LoopState.codebase = codebase,
LoopState.credentialManager = error "Error: No access to credentials from transcripts."
LoopState.credentialManager = error "Error: No access to credentials from transcripts.",
LoopState.unisonShareUrl = error "Error: No access to Unison Share from transcripts."
}
let free = LoopState.runAction env state $ HandleInput.loop
rng i = pure $ Random.drgNewSeed (Random.seedFromInteger (fromIntegral i))

View File

@ -197,7 +197,8 @@ main dir welcome initialPath (config, cancelConfig) initialInputs runtime codeba
LoopState.Env
{ LoopState.authHTTPClient = authorizedHTTPClient,
LoopState.codebase = codebase,
LoopState.credentialManager = credMan
LoopState.credentialManager = credMan,
LoopState.unisonShareUrl = error "TODO: wire in Unison Share URL"
}
let free = LoopState.runAction env state HandleInput.loop
let handleCommand =