-- | Utility functions for downloading remote entities and storing them locally in SQLite.
--
-- These are shared by commands like `pull` and `clone`.
module Unison.Cli.DownloadUtils
  ( downloadProjectBranchFromShare,
    downloadLooseCodeFromShare,
  )
where

import Control.Concurrent.STM (atomically)
import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVar, readTVarIO)
import Data.List.NonEmpty (pattern (:|))
import System.Console.Regions qualified as Console.Regions
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.Share.Projects qualified as Share
import Unison.Codebase.Editor.HandleInput.AuthLogin (ensureAuthenticatedWithCodeserver)
import Unison.Codebase.Editor.Output qualified as Output
import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode, shareUserHandleToText)
import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
import Unison.Codebase.Path qualified as Path
import Unison.Core.Project (ProjectAndBranch (..))
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Prelude
import Unison.Share.API.Hash qualified as Share
import Unison.Share.Codeserver qualified as Codeserver
import Unison.Share.Sync qualified as Share
import Unison.Share.Sync.Types qualified as Share
import Unison.Share.Types (codeserverBaseURL)
import Unison.Sync.Common qualified as Sync.Common
import Unison.Sync.Types qualified as Share

-- | Download a project/branch from Share.
downloadProjectBranchFromShare ::
  (HasCallStack) =>
  Share.IncludeSquashedHead ->
  Share.RemoteProjectBranch ->
  Cli (Either Output.ShareError CausalHash)
downloadProjectBranchFromShare :: HasCallStack =>
IncludeSquashedHead
-> RemoteProjectBranch -> Cli (Either ShareError CausalHash)
downloadProjectBranchFromShare IncludeSquashedHead
useSquashed RemoteProjectBranch
branch =
  ((forall void. ShareError -> Cli void) -> Cli CausalHash)
-> Cli (Either ShareError CausalHash)
forall a b.
((forall void. a -> Cli void) -> Cli b) -> Cli (Either a b)
Cli.labelE \forall void. ShareError -> Cli void
done -> do
    let remoteProjectBranchName :: ProjectBranchName
remoteProjectBranchName = RemoteProjectBranch
branch.branchName
    let repoInfo :: RepoInfo
repoInfo = Text -> RepoInfo
Share.RepoInfo (forall target source. From source target => source -> target
into @Text (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch RemoteProjectBranch
branch.projectName ProjectBranchName
remoteProjectBranchName))
    HashJWT
causalHashJwt <-
      case (IncludeSquashedHead
useSquashed, RemoteProjectBranch
branch.squashedBranchHead) of
        (IncludeSquashedHead
Share.IncludeSquashedHead, Maybe HashJWT
Nothing) -> ShareError -> Cli HashJWT
forall void. ShareError -> Cli void
done ShareError
Output.ShareExpectedSquashedHead
        (IncludeSquashedHead
Share.IncludeSquashedHead, Just HashJWT
squashedHead) -> HashJWT -> Cli HashJWT
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashJWT
squashedHead
        (IncludeSquashedHead
Share.NoSquashedHead, Maybe HashJWT
_) -> HashJWT -> Cli HashJWT
forall a. a -> Cli a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RemoteProjectBranch
branch.branchHead
    Bool
exists <- Transaction Bool -> Cli Bool
forall a. Transaction a -> Cli a
Cli.runTransaction (Hash32 -> Transaction Bool
Queries.causalExistsByHash32 (HashJWT -> Hash32
Share.hashJWTHash HashJWT
causalHashJwt))
    Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
exists) do
      (Either (SyncError DownloadEntitiesError) ()
result, Int
numDownloaded) <-
        (forall x. ((Int -> IO (), IO Int) -> IO x) -> IO x)
-> ((Int -> IO (), IO Int)
    -> Cli (Either (SyncError DownloadEntitiesError) (), Int))
-> Cli (Either (SyncError DownloadEntitiesError) (), Int)
forall a b.
(forall x. (a -> IO x) -> IO x) -> (a -> Cli b) -> Cli b
Cli.with ((Int -> IO (), IO Int) -> IO x) -> IO x
forall x. ((Int -> IO (), IO Int) -> IO x) -> IO x
withEntitiesDownloadedProgressCallback \(Int -> IO ()
downloadedCallback, IO Int
getNumDownloaded) -> do
          Either (SyncError DownloadEntitiesError) ()
result <- BaseUrl
-> RepoInfo
-> HashJWT
-> (Int -> IO ())
-> Cli (Either (SyncError DownloadEntitiesError) ())
Share.downloadEntities BaseUrl
Share.hardCodedBaseUrl RepoInfo
repoInfo HashJWT
causalHashJwt Int -> IO ()
downloadedCallback
          Int
numDownloaded <- IO Int -> Cli Int
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getNumDownloaded
          pure (Either (SyncError DownloadEntitiesError) ()
result, Int
numDownloaded)
      Either (SyncError DownloadEntitiesError) ()
result Either (SyncError DownloadEntitiesError) ()
-> (Either (SyncError DownloadEntitiesError) () -> Cli ())
-> Cli ()
forall a b. a -> (a -> b) -> b
& (SyncError DownloadEntitiesError -> Cli ())
-> Either (SyncError DownloadEntitiesError) () -> Cli ()
forall (m :: * -> *) a b.
Applicative m =>
(a -> m b) -> Either a b -> m b
onLeft \SyncError DownloadEntitiesError
err0 -> do
        ShareError -> Cli ()
forall void. ShareError -> Cli void
done case SyncError DownloadEntitiesError
err0 of
          Share.SyncError DownloadEntitiesError
err -> DownloadEntitiesError -> ShareError
Output.ShareErrorDownloadEntities DownloadEntitiesError
err
          Share.TransportError CodeserverTransportError
err -> CodeserverTransportError -> ShareError
Output.ShareErrorTransport CodeserverTransportError
err
      Output -> Cli ()
Cli.respond (Int -> Output
Output.DownloadedEntities Int
numDownloaded)
    pure (Hash32 -> CausalHash
Sync.Common.hash32ToCausalHash (HashJWT -> Hash32
Share.hashJWTHash HashJWT
causalHashJwt))

-- | Download loose code from Share.
downloadLooseCodeFromShare :: ReadShareLooseCode -> Cli (Either Output.ShareError CausalHash)
downloadLooseCodeFromShare :: ReadShareLooseCode -> Cli (Either ShareError CausalHash)
downloadLooseCodeFromShare ReadShareLooseCode
namespace = do
  let codeserver :: CodeserverURI
codeserver = ShareCodeserver -> CodeserverURI
Codeserver.resolveCodeserver ReadShareLooseCode
namespace.server
  let baseURL :: BaseUrl
baseURL = CodeserverURI -> BaseUrl
codeserverBaseURL CodeserverURI
codeserver

  -- Auto-login to share if pulling from a non-public path
  Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (ReadShareLooseCode -> Bool
RemoteRepo.isPublic ReadShareLooseCode
namespace)) do
    UserInfo
_userInfo <- CodeserverURI -> Cli UserInfo
ensureAuthenticatedWithCodeserver CodeserverURI
codeserver
    pure ()

  let shareFlavoredPath :: Path
shareFlavoredPath =
        NonEmpty Text -> Path
Share.Path (NonEmpty Text -> Path) -> NonEmpty Text -> Path
forall a b. (a -> b) -> a -> b
$
          ShareUserHandle -> Text
shareUserHandleToText ReadShareLooseCode
namespace.repo
            Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:| (NameSegment -> Text) -> [NameSegment] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NameSegment -> Text
NameSegment.toUnescapedText (Path -> [NameSegment]
Path.toList ReadShareLooseCode
namespace.path)

  ((forall void. ShareError -> Cli void) -> Cli CausalHash)
-> Cli (Either ShareError CausalHash)
forall a b.
((forall void. a -> Cli void) -> Cli b) -> Cli (Either a b)
Cli.labelE \forall void. ShareError -> Cli void
done -> do
    (CausalHash
causalHash, Int
numDownloaded) <-
      (forall x. ((Int -> IO (), IO Int) -> IO x) -> IO x)
-> ((Int -> IO (), IO Int) -> Cli (CausalHash, Int))
-> Cli (CausalHash, Int)
forall a b.
(forall x. (a -> IO x) -> IO x) -> (a -> Cli b) -> Cli b
Cli.with ((Int -> IO (), IO Int) -> IO x) -> IO x
forall x. ((Int -> IO (), IO Int) -> IO x) -> IO x
withEntitiesDownloadedProgressCallback \(Int -> IO ()
downloadedCallback, IO Int
getNumDownloaded) -> do
        CausalHash
causalHash <-
          BaseUrl
-> Path
-> (Int -> IO ())
-> Cli (Either (SyncError PullError) CausalHash)
Share.pull BaseUrl
baseURL Path
shareFlavoredPath Int -> IO ()
downloadedCallback Cli (Either (SyncError PullError) CausalHash)
-> (Cli (Either (SyncError PullError) CausalHash)
    -> Cli CausalHash)
-> Cli CausalHash
forall a b. a -> (a -> b) -> b
& (SyncError PullError -> Cli CausalHash)
-> Cli (Either (SyncError PullError) CausalHash) -> Cli CausalHash
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> m (Either a b) -> m b
onLeftM \SyncError PullError
err0 ->
            ShareError -> Cli CausalHash
forall void. ShareError -> Cli void
done case SyncError PullError
err0 of
              Share.SyncError PullError
err -> PullError -> ShareError
Output.ShareErrorPull PullError
err
              Share.TransportError CodeserverTransportError
err -> CodeserverTransportError -> ShareError
Output.ShareErrorTransport CodeserverTransportError
err
        Int
numDownloaded <- IO Int -> Cli Int
forall a. IO a -> Cli a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getNumDownloaded
        pure (CausalHash
causalHash, Int
numDownloaded)
    Output -> Cli ()
Cli.respond (Int -> Output
Output.DownloadedEntities Int
numDownloaded)
    pure CausalHash
causalHash

-- Provide the given action a callback that display to the terminal.
withEntitiesDownloadedProgressCallback :: ((Int -> IO (), IO Int) -> IO a) -> IO a
withEntitiesDownloadedProgressCallback :: forall x. ((Int -> IO (), IO Int) -> IO x) -> IO x
withEntitiesDownloadedProgressCallback (Int -> IO (), IO Int) -> IO a
action = do
  TVar Int
entitiesDownloadedVar <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
  IO a -> IO a
forall (m :: * -> *) a. (MonadIO m, MonadMask m) => m a -> m a
Console.Regions.displayConsoleRegions do
    RegionLayout -> (ConsoleRegion -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RegionLayout -> (ConsoleRegion -> m a) -> m a
Console.Regions.withConsoleRegion RegionLayout
Console.Regions.Linear \ConsoleRegion
region -> do
      ConsoleRegion -> STM Text -> IO ()
forall v (m :: * -> *).
(ToRegionContent v, LiftRegion m) =>
ConsoleRegion -> v -> m ()
Console.Regions.setConsoleRegion ConsoleRegion
region do
        Int
entitiesDownloaded <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
entitiesDownloadedVar
        pure $
          Text
"\n  Downloaded "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tShow Int
entitiesDownloaded
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" entities...\n\n"
      (Int -> IO (), IO Int) -> IO a
action ((\Int
n -> STM () -> IO ()
forall a. STM a -> IO a
atomically (TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
entitiesDownloadedVar (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))), TVar Int -> IO Int
forall a. TVar a -> IO a
readTVarIO TVar Int
entitiesDownloadedVar)