-- | 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,
    SyncVersion (..),
  )
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 System.IO.Unsafe (unsafePerformIO)
import U.Codebase.HashTags (CausalHash)
import U.Codebase.Sqlite.Operations qualified as Ops
import U.Codebase.Sqlite.Queries qualified as Queries
import Unison.Cli.Monad (Cli)
import Unison.Cli.Monad qualified as Cli
import Unison.Cli.MonadUtils 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.Codebase.ProjectPath (ProjectBranch (..))
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.SyncV2 qualified as SyncV2
import Unison.Share.Types (codeserverBaseURL)
import Unison.Sync.Common qualified as Sync.Common
import Unison.Sync.Types qualified as Share
import Unison.SyncV2.Types qualified as SyncV2
import UnliftIO.Environment qualified as UnliftIO

data SyncVersion = SyncV1 | SyncV2
  deriving (SyncVersion -> SyncVersion -> Bool
(SyncVersion -> SyncVersion -> Bool)
-> (SyncVersion -> SyncVersion -> Bool) -> Eq SyncVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SyncVersion -> SyncVersion -> Bool
== :: SyncVersion -> SyncVersion -> Bool
$c/= :: SyncVersion -> SyncVersion -> Bool
/= :: SyncVersion -> SyncVersion -> Bool
Eq, Int -> SyncVersion -> ShowS
[SyncVersion] -> ShowS
SyncVersion -> String
(Int -> SyncVersion -> ShowS)
-> (SyncVersion -> String)
-> ([SyncVersion] -> ShowS)
-> Show SyncVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SyncVersion -> ShowS
showsPrec :: Int -> SyncVersion -> ShowS
$cshow :: SyncVersion -> String
show :: SyncVersion -> String
$cshowList :: [SyncVersion] -> ShowS
showList :: [SyncVersion] -> ShowS
Show)

-- | The version of the sync protocol to use.
syncVersion :: SyncVersion
syncVersion :: SyncVersion
syncVersion = IO SyncVersion -> SyncVersion
forall a. IO a -> a
unsafePerformIO do
  String -> IO (Maybe String)
forall (m :: * -> *). MonadIO m => String -> m (Maybe String)
UnliftIO.lookupEnv String
"UNISON_SYNC_VERSION"
    IO (Maybe String)
-> (Maybe String -> SyncVersion) -> IO SyncVersion
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just String
"1" -> SyncVersion
SyncV1
      Maybe String
_ -> SyncVersion
SyncV2

-- | Download a project/branch from Share.
downloadProjectBranchFromShare ::
  (HasCallStack) =>
  Share.IncludeSquashedHead ->
  Share.RemoteProjectBranch ->
  -- | Whether this download is part of a pull operation. If 'True', we will
  --   show the from and to causal hashes.
  Bool ->
  Cli (Either Output.ShareError CausalHash)
downloadProjectBranchFromShare :: HasCallStack =>
IncludeSquashedHead
-> RemoteProjectBranch
-> Bool
-> Cli (Either ShareError CausalHash)
downloadProjectBranchFromShare IncludeSquashedHead
useSquashed RemoteProjectBranch
branch Bool
isPull =
  ((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
    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
    let causalHash32 = HashJWT -> Hash32
Share.hashJWTHash HashJWT
causalHashJwt
    exists <- Cli.runTransaction (Queries.causalExistsByHash32 causalHash32)
    when (not exists) do
      case syncVersion of
        SyncVersion
SyncV1 -> do
          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))
          (forall x. ((Int -> IO (), IO Int) -> IO x) -> IO x)
-> ((Int -> IO (), IO Int) -> Cli ()) -> Cli ()
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
            result <- BaseUrl
-> RepoInfo
-> HashJWT
-> (Int -> IO ())
-> Cli (Either (SyncError DownloadEntitiesError) ())
Share.downloadEntities BaseUrl
Share.hardCodedBaseUrl RepoInfo
repoInfo HashJWT
causalHashJwt Int -> IO ()
downloadedCallback
            numDownloaded <- liftIO getNumDownloaded
            result & 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
            Cli.respond (Output.DownloadedEntities numDownloaded)
        SyncVersion
SyncV2 -> do
          let branchRef :: BranchRef
branchRef = Text -> BranchRef
SyncV2.BranchRef (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))
          let shouldValidate :: Bool
shouldValidate = CodeserverURI -> Bool
Codeserver.isCustomCodeserver CodeserverURI
Codeserver.defaultCodeserver
          Bool -> Cli () -> Cli ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isPull (Cli () -> Cli ()) -> Cli () -> Cli ()
forall a b. (a -> b) -> a -> b
$ do
            pb <- Cli ProjectBranch
Cli.getCurrentProjectBranch
            currentCausalHash <- Cli.runTransaction $ Ops.expectProjectBranchHead pb.projectId pb.branchId
            Cli.respond $ Output.SyncingFromTo currentCausalHash (Sync.Common.hash32ToCausalHash causalHash32)
          result <- Bool
-> BaseUrl
-> BranchRef
-> HashJWT
-> Cli (Either (SyncError PullError) (CausalHash, CausalHashId))
SyncV2.syncFromCodeserver Bool
shouldValidate BaseUrl
Share.hardCodedBaseUrl BranchRef
branchRef HashJWT
causalHashJwt
          void result & onLeft \SyncError PullError
err0 -> do
            ShareError -> Cli ()
forall void. ShareError -> Cli void
done case SyncError PullError
err0 of
              Share.SyncError PullError
pullErr ->
                PullError -> ShareError
Output.ShareErrorPullV2 PullError
pullErr
              Share.TransportError CodeserverTransportError
err -> CodeserverTransportError -> ShareError
Output.ShareErrorTransport CodeserverTransportError
err
    pure (Sync.Common.hash32ToCausalHash (Share.hashJWTHash 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 <- 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, 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 <-
          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
        numDownloaded <- liftIO getNumDownloaded
        pure (causalHash, numDownloaded)
    Cli.respond (Output.DownloadedEntities numDownloaded)
    pure 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
  entitiesDownloadedVar <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0
  Console.Regions.displayConsoleRegions do
    Console.Regions.withConsoleRegion 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
        entitiesDownloaded <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
entitiesDownloadedVar
        pure $
          "\n  Downloaded "
            <> tShow entitiesDownloaded
            <> " 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)