mirror of
https://github.com/unisonweb/unison.git
synced 2024-11-10 11:15:08 +03:00
add unison share url to loop state env
This commit is contained in:
parent
2bbeeaca0e
commit
5e8f1101f9
@ -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,
|
||||
|
@ -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}
|
||||
|
@ -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))
|
||||
|
@ -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 =
|
||||
|
Loading…
Reference in New Issue
Block a user