Sync to/from file

Author: ChrisPenner

.gitignore

@@ -27,6 +27,7 @@ dist-newstyle
 *.prof.html
 *.hp
 *.ps
+*.profiterole.*
 /.direnv/
 /.envrc
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Branch/Format.hs

@@ -101,7 +101,7 @@ data BranchLocalIds' t d p c = LocalIds
     branchPatchLookup :: Vector p,
     branchChildLookup :: Vector c
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 -- | Bytes encoding a LocalBranch
 newtype LocalBranchBytes = LocalBranchBytes ByteString
@@ -110,6 +110,7 @@ newtype LocalBranchBytes = LocalBranchBytes ByteString
 data SyncBranchFormat' parent text defn patch child
   = SyncFull (BranchLocalIds' text defn patch child) LocalBranchBytes
   | SyncDiff parent (BranchLocalIds' text defn patch child) LocalBranchBytes
+  deriving (Eq, Show)
 
 type SyncBranchFormat = SyncBranchFormat' BranchObjectId TextId ObjectId PatchObjectId (BranchObjectId, CausalHashId)
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Causal.hs

@@ -22,5 +22,6 @@ data SyncCausalFormat' causalHash valueHash = SyncCausalFormat
   { valueHash :: valueHash,
     parents :: Vector causalHash
   }
+  deriving stock (Eq, Show)
 
 type SyncCausalFormat = SyncCausalFormat' CausalHashId BranchHashId

codebase2/codebase-sqlite/U/Codebase/Sqlite/Decl/Format.hs

@@ -36,9 +36,11 @@ type SyncDeclFormat =
 
 data SyncDeclFormat' t d
   = SyncDecl (SyncLocallyIndexedComponent' t d)
+  deriving stock (Eq, Show)
 
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
+  deriving stock (Eq, Show)
 
 -- [OldDecl] ==map==> [NewDecl] ==number==> [(NewDecl, Int)] ==sort==> [(NewDecl, Int)] ==> permutation is map snd of that
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Entity.hs

@@ -24,6 +24,7 @@ data SyncEntity' text hash defn patch branchh branch causal
   | N (Namespace.SyncBranchFormat' branch text defn patch (branch, causal))
   | P (Patch.SyncPatchFormat' patch text hash defn)
   | C (Causal.SyncCausalFormat' causal branchh)
+  deriving stock (Eq, Show)
 
 entityType :: SyncEntity' text hash defn patch branchh branch causal -> TempEntityType
 entityType = \case

codebase2/codebase-sqlite/U/Codebase/Sqlite/LocalIds.hs

@@ -15,7 +15,7 @@ data LocalIds' t h = LocalIds
   { textLookup :: Vector t,
     defnLookup :: Vector h
   }
-  deriving (Functor, Show)
+  deriving stock (Functor, Show, Eq)
 
 type LocalIds = LocalIds' TextId ObjectId
 

codebase2/codebase-sqlite/U/Codebase/Sqlite/Patch/Format.hs

@@ -40,13 +40,15 @@ data PatchLocalIds' t h d = LocalIds
     patchHashLookup :: Vector h,
     patchDefnLookup :: Vector d
   }
+  deriving stock (Eq, Show)
 
 type SyncPatchFormat = SyncPatchFormat' PatchObjectId TextId HashId ObjectId
 
 data SyncPatchFormat' parent text hash defn
   = SyncFull (PatchLocalIds' text hash defn) ByteString
   | -- | p is the identity of the thing that the diff is relative to
     SyncDiff parent (PatchLocalIds' text hash defn) ByteString
+  deriving stock (Eq, Show)
 
 -- | Apply a list of patch diffs to a patch, left to right.
 applyPatchDiffs :: Patch -> [PatchDiff] -> Patch

codebase2/codebase-sqlite/U/Codebase/Sqlite/Term/Format.hs

@@ -49,6 +49,7 @@ newtype LocallyIndexedComponent' t d = LocallyIndexedComponent
 
 newtype SyncLocallyIndexedComponent' t d
   = SyncLocallyIndexedComponent (Vector (LocalIds' t d, ByteString))
+  deriving stock (Eq, Show)
 
 {-
 message = "hello, world"     -> ABT { ... { Term.F.Text "hello, world" } }    -> hashes to (#abc, 0)
@@ -127,6 +128,7 @@ data TermFormat' t d = Term (LocallyIndexedComponent' t d)
 type SyncTermFormat = SyncTermFormat' TextId ObjectId
 
 data SyncTermFormat' t d = SyncTerm (SyncLocallyIndexedComponent' t d)
+  deriving stock (Eq, Show)
 
 data WatchResultFormat
   = WatchResult WatchLocalIds Term

codebase2/codebase-sqlite/unison-codebase-sqlite.cabal

@@ -1,6 +1,6 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.36.0.
+-- This file has been generated from package.yaml by hpack version 0.37.0.
 --
 -- see: https://github.com/sol/hpack
 

hie.yaml

@@ -140,6 +140,9 @@ cradle:
     - path: "unison-share-api/src"
       component: "unison-share-api:lib"
 
+    - path: "unison-share-api/tests"
+      component: "unison-share-api:test:unison-share-api-tests"
+
     - path: "unison-share-projects-api/src"
       component: "unison-share-projects-api:lib"
 

lib/unison-sqlite/src/Unison/Sqlite.hs

@@ -19,6 +19,7 @@ module Unison.Sqlite
     Transaction,
     runTransaction,
     runTransactionWithRollback,
+    runTransactionExceptT,
     runReadOnlyTransaction,
     runWriteTransaction,
     cacheTransaction,

lib/unison-sqlite/src/Unison/Sqlite/Transaction.hs

@@ -3,6 +3,7 @@ module Unison.Sqlite.Transaction
     Transaction,
     runTransaction,
     runTransactionWithRollback,
+    runTransactionExceptT,
     runReadOnlyTransaction,
     runWriteTransaction,
     cacheTransaction,
@@ -44,6 +45,7 @@ where
 
 import Control.Concurrent (threadDelay)
 import Control.Exception (Exception (fromException), onException, throwIO)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import Control.Monad.Trans.Reader (ReaderT (..))
 import Data.Text qualified as Text
 import Data.Unique (Unique, newUnique)
@@ -130,6 +132,13 @@ runTransactionWithRollback conn transaction = liftIO do
     Right x -> pure x
 {-# SPECIALIZE runTransactionWithRollback :: Connection -> ((forall void. a -> Transaction void) -> Transaction a) -> IO a #-}
 
+-- | Run a transaction wrapped in an 'ExceptT'. If the ExceptT fails, the transaction is rolled back.
+runTransactionExceptT :: (MonadIO m, HasCallStack) => Connection -> ExceptT e Transaction a -> m (Either e a)
+runTransactionExceptT conn transaction = runTransactionWithRollback conn \rollback -> do
+  runExceptT transaction >>= \case
+    Left e -> rollback (Left e)
+    Right a -> pure (Right a)
+
 -- | Run a transaction that is known to only perform reads.
 --
 -- The action is provided a function that peels off the 'Transaction' newtype without sending the corresponding

parser-typechecker/src/Unison/Codebase.hs

@@ -99,6 +99,7 @@ module Unison.Codebase
     -- * Direct codebase access
     runTransaction,
     runTransactionWithRollback,
+    runTransactionExceptT,
     withConnection,
     withConnectionIO,
 
@@ -112,6 +113,7 @@ module Unison.Codebase
   )
 where
 
+import Control.Monad.Except (ExceptT)
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import U.Codebase.Branch qualified as V2Branch
@@ -174,6 +176,14 @@ runTransactionWithRollback ::
 runTransactionWithRollback Codebase {withConnection} action =
   withConnection \conn -> Sqlite.runTransactionWithRollback conn action
 
+runTransactionExceptT ::
+  (MonadIO m) =>
+  Codebase m v a ->
+  ExceptT e Sqlite.Transaction b ->
+  m (Either e b)
+runTransactionExceptT Codebase {withConnection} action =
+  withConnection \conn -> Sqlite.runTransactionExceptT conn action
+
 getShallowCausalAtPathFromRootHash ::
   -- Causal to start at, if Nothing use the codebase's root branch.
   CausalHash ->

unison-cli/package.yaml

@@ -20,6 +20,7 @@ library:
     - condition: "!os(windows)"
       dependencies: unix
   dependencies:
+    - attoparsec
     - Diff
     - IntervalMap
     - ListLike
@@ -32,7 +33,10 @@ library:
     - co-log-core
     - code-page
     - concurrent-output
+    - conduit
     - containers >= 0.6.3
+    - conduit
+    - conduit-extra
     - cryptonite
     - either
     - errors
@@ -65,8 +69,10 @@ library:
     - recover-rtti
     - regex-tdfa
     - semialign
+    - serialise
     - servant
     - servant-client
+    - servant-conduit
     - stm
     - temporary
     - text-ansi

unison-cli/src/Unison/Cli/DownloadUtils.hs

@@ -4,12 +4,14 @@
 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 Data.Set qualified as Set
 import System.Console.Regions qualified as Console.Regions
 import U.Codebase.HashTags (CausalHash)
 import U.Codebase.Sqlite.Queries qualified as Queries
@@ -28,37 +30,57 @@ 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
+
+data SyncVersion = SyncV1 | SyncV2
 
 -- | Download a project/branch from Share.
 downloadProjectBranchFromShare ::
   (HasCallStack) =>
+  SyncVersion ->
   Share.IncludeSquashedHead ->
   Share.RemoteProjectBranch ->
   Cli (Either Output.ShareError CausalHash)
-downloadProjectBranchFromShare useSquashed branch =
+downloadProjectBranchFromShare syncVersion useSquashed branch =
   Cli.labelE \done -> do
     let remoteProjectBranchName = branch.branchName
-    let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch branch.projectName remoteProjectBranchName))
     causalHashJwt <-
       case (useSquashed, branch.squashedBranchHead) of
         (Share.IncludeSquashedHead, Nothing) -> done Output.ShareExpectedSquashedHead
         (Share.IncludeSquashedHead, Just squashedHead) -> pure squashedHead
         (Share.NoSquashedHead, _) -> pure branch.branchHead
     exists <- Cli.runTransaction (Queries.causalExistsByHash32 (Share.hashJWTHash causalHashJwt))
     when (not exists) do
-      (result, numDownloaded) <-
-        Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
-          result <- Share.downloadEntities Share.hardCodedBaseUrl repoInfo causalHashJwt downloadedCallback
-          numDownloaded <- liftIO getNumDownloaded
-          pure (result, numDownloaded)
-      result & onLeft \err0 -> do
-        done case err0 of
-          Share.SyncError err -> Output.ShareErrorDownloadEntities err
-          Share.TransportError err -> Output.ShareErrorTransport err
-      Cli.respond (Output.DownloadedEntities numDownloaded)
+      case syncVersion of
+        SyncV1 -> do
+          let repoInfo = Share.RepoInfo (into @Text (ProjectAndBranch branch.projectName remoteProjectBranchName))
+          Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
+            result <- Share.downloadEntities Share.hardCodedBaseUrl repoInfo causalHashJwt downloadedCallback
+            numDownloaded <- liftIO getNumDownloaded
+            result & onLeft \err0 -> do
+              done case err0 of
+                Share.SyncError err -> Output.ShareErrorDownloadEntities err
+                Share.TransportError err -> Output.ShareErrorTransport err
+            Cli.respond (Output.DownloadedEntities numDownloaded)
+        SyncV2 -> do
+          -- Cli.with withEntitiesDownloadedProgressCallback \(downloadedCallback, getNumDownloaded) -> do
+          let branchRef = SyncV2.BranchRef (into @Text (ProjectAndBranch branch.projectName remoteProjectBranchName))
+          -- TODO: Fill this in.
+          let knownHashes = Set.empty
+          let downloadedCallback = \_ -> pure ()
+          let shouldValidate = not $ Codeserver.isCustomCodeserver Codeserver.defaultCodeserver
+          result <- SyncV2.syncFromCodeserver shouldValidate Share.hardCodedBaseUrl branchRef causalHashJwt knownHashes downloadedCallback
+          result & onLeft \err0 -> do
+            done case err0 of
+              Share.SyncError err ->
+                -- TODO: Fix this
+                error (show err)
+              -- Output.ShareErrorDownloadEntities err
+              Share.TransportError err -> Output.ShareErrorTransport err
     pure (Sync.Common.hash32ToCausalHash (Share.hashJWTHash causalHashJwt))
 
 -- | Download loose code from Share.

unison-cli/src/Unison/Cli/MonadUtils.hs

@@ -49,6 +49,7 @@ module Unison.Cli.MonadUtils
     stepManyAtM,
     updateProjectBranchRoot,
     updateProjectBranchRoot_,
+    setProjectBranchRootToCausalHash,
     updateAtM,
     updateAt,
     updateAndStepAt,
@@ -447,6 +448,13 @@ updateProjectBranchRoot projectBranch reason f = do
         Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) causalHashId
     pure result
 
+setProjectBranchRootToCausalHash :: ProjectBranch -> Text -> CausalHash -> Cli ()
+setProjectBranchRootToCausalHash projectBranch reason targetCH = do
+  Cli.time "setProjectBranchRootToCausalHash" do
+    Cli.runTransaction $ do
+      targetCHID <- Q.expectCausalHashIdByCausalHash targetCH
+      Q.setProjectBranchHead reason (projectBranch ^. #projectId) (projectBranch ^. #branchId) targetCHID
+
 updateProjectBranchRoot_ :: ProjectBranch -> Text -> (Branch IO -> Branch IO) -> Cli ()
 updateProjectBranchRoot_ projectBranch reason f = do
   updateProjectBranchRoot projectBranch reason (\b -> pure (f b, ()))

unison-cli/src/Unison/Codebase/Editor/HandleInput.hs

@@ -59,8 +59,8 @@ import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch)
 import Unison.Codebase.Editor.HandleInput.DeleteNamespace (getEndangeredDependents, handleDeleteNamespace)
 import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject)
 import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents)
-import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents)
+import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace)
 import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI)
 import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format
 import Unison.Codebase.Editor.HandleInput.Global qualified as Global
@@ -87,6 +87,7 @@ import Unison.Codebase.Editor.HandleInput.ReleaseDraft (handleReleaseDraft)
 import Unison.Codebase.Editor.HandleInput.Run (handleRun)
 import Unison.Codebase.Editor.HandleInput.RuntimeUtils qualified as RuntimeUtils
 import Unison.Codebase.Editor.HandleInput.ShowDefinition (handleShowDefinition)
+import Unison.Codebase.Editor.HandleInput.SyncV2 qualified as SyncV2
 import Unison.Codebase.Editor.HandleInput.TermResolution (resolveMainRef)
 import Unison.Codebase.Editor.HandleInput.Tests qualified as Tests
 import Unison.Codebase.Editor.HandleInput.Todo (handleTodo)
@@ -688,6 +689,17 @@ loop e = do
               Cli.respond Success
             PullI sourceTarget pullMode -> handlePull sourceTarget pullMode
             PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
+            SyncToFileI syncFileDest projectBranchName -> SyncV2.handleSyncToFile syncFileDest projectBranchName
+            SyncFromFileI syncFileSrc projectBranchName -> do
+              description <- inputDescription input
+              SyncV2.handleSyncFromFile description syncFileSrc projectBranchName
+            SyncFromCodebaseI srcCodebasePath srcBranch destBranch -> do
+              description <- inputDescription input
+              let srcBranch' =
+                    srcBranch & over #project \case
+                      Nothing -> error "todo"
+                      Just proj -> proj
+              SyncV2.handleSyncFromCodebase description srcCodebasePath srcBranch' destBranch
             ListDependentsI hq -> handleDependents hq
             ListDependenciesI hq -> handleDependencies hq
             NamespaceDependenciesI path -> handleNamespaceDependencies path
@@ -1012,6 +1024,11 @@ inputDescription input =
     ProjectsI -> wat
     PullI {} -> wat
     PushRemoteBranchI {} -> wat
+    SyncToFileI {} -> wat
+    SyncFromFileI fp pab ->
+      pure $ "sync.from-file " <> into @Text fp <> " " <> into @Text pab
+    SyncFromCodebaseI fp srcBranch destBranch -> do
+      pure $ "sync.from-file " <> into @Text fp <> " " <> into @Text srcBranch <> " " <> into @Text destBranch
     QuitI {} -> wat
     ReleaseDraftI {} -> wat
     ShowDefinitionI {} -> wat

unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs

@@ -60,7 +60,7 @@ handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBran
   Cli.Env {codebase} <- ask
 
   causalHash <-
-    downloadProjectBranchFromShare Share.IncludeSquashedHead libdepProjectBranch
+    downloadProjectBranchFromShare SyncV1 Share.IncludeSquashedHead libdepProjectBranch
       & onLeftM (Cli.returnEarly . Output.ShareError)
 
   remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase causalHash)

unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs

@@ -13,7 +13,7 @@ import U.Codebase.Sqlite.Project qualified as Sqlite (Project (..))
 import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite
 import U.Codebase.Sqlite.Queries qualified as Q
 import U.Codebase.Sqlite.Queries qualified as Queries
-import Unison.Cli.DownloadUtils (downloadProjectBranchFromShare)
+import Unison.Cli.DownloadUtils (SyncVersion (..), downloadProjectBranchFromShare)
 import Unison.Cli.Monad (Cli)
 import Unison.Cli.Monad qualified as Cli
 import Unison.Cli.MonadUtils qualified as Cli (getCurrentProjectAndBranch)
@@ -225,7 +225,7 @@ cloneInto localProjectBranch remoteProjectBranch = do
   let remoteProjectBranchNames = ProjectAndBranch remoteProjectName remoteBranchName
 
   branchHead <-
-    downloadProjectBranchFromShare Share.NoSquashedHead remoteProjectBranch
+    downloadProjectBranchFromShare SyncV1 Share.NoSquashedHead remoteProjectBranch
       & onLeftM (Cli.returnEarly . Output.ShareError)
 
   localProjectAndBranch <-