From e5f97732d992287fb257bec5db892b17e8faf298 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 7 Dec 2021 17:44:10 -0600
Subject: [PATCH 01/10] WIP

---
 .../U/Codebase/Sqlite/Queries.hs              |  6 ++
 .../src/Unison/Codebase/Editor/Git.hs         | 42 ++++++--
 .../src/Unison/Codebase/GitError.hs           | 18 ++--
 .../src/Unison/Codebase/SqliteCodebase.hs     | 98 +++++++++++--------
 4 files changed, 105 insertions(+), 59 deletions(-)

diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
index 23a7d0245..401197e92 100644
--- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
+++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
@@ -115,6 +115,7 @@ module U.Codebase.Sqlite.Queries (
   release,
   rollbackRelease,
 
+  vacuumInto,
   setJournalMode,
   traceConnectionFile,
 ) where
@@ -243,6 +244,11 @@ setFlags = do
   execute_ "PRAGMA foreign_keys = ON;"
   setJournalMode JournalMode.WAL
 
+-- | Copy the database into the specified location, performing a VACUUM in the process.
+vacuumInto :: DB m => FilePath -> m ()
+vacuumInto dest = do
+  execute "VACUUM INTO ?" [dest]
+
 {- ORMOLU_DISABLE -} -- Remove this when the file is ready to be auto-formatted
 schemaVersion :: DB m => m SchemaVersion
 schemaVersion = queryAtoms_ sql >>= \case
diff --git a/parser-typechecker/src/Unison/Codebase/Editor/Git.hs b/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
index 145c744e6..1fbc19fb8 100644
--- a/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
@@ -2,7 +2,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
 
-module Unison.Codebase.Editor.Git (gitIn, gitTextIn, pullBranch, withIOError, withStatus) where
+module Unison.Codebase.Editor.Git
+  ( gitIn,
+    gitTextIn,
+    pullRepo,
+    withIOError,
+    withStatus,
+    withIsolatedRepo,
+  )
+where
 
 import Unison.Prelude
 
@@ -20,7 +28,8 @@ import UnliftIO.IO (hFlush, stdout)
 import qualified Data.ByteString.Base16 as ByteString
 import qualified Data.Char as Char
 import Unison.Codebase.GitError (GitProtocolError)
-import UnliftIO (handleIO)
+import UnliftIO (handleIO, MonadUnliftIO)
+import qualified UnliftIO
 
 
 -- https://superuser.com/questions/358855/what-characters-are-safe-in-cross-platform-file-names-for-linux-windows-and-os
@@ -37,8 +46,8 @@ encodeFileName = let
               encodeUtf8 . Text.pack
   in go
 
-tempGitDir :: MonadIO m => Text -> m FilePath
-tempGitDir url =
+gitCacheDir :: MonadIO m => Text -> m FilePath
+gitCacheDir url =
   getXdgDirectory XdgCache
     $   "unisonlanguage"
     </> "gitfiles"
@@ -55,12 +64,30 @@ withStatus str ma = do
     liftIO . putStr $ "  " ++ str ++ "\r"
     hFlush stdout
 
+-- | Run an action on an isolated copy of the provided repo. The repo is deleted when the
+-- action exits or fails.
+withIsolatedRepo ::
+  forall m r.
+  (MonadUnliftIO m) =>
+  FilePath ->
+  (FilePath -> m r) ->
+  m (Either GitProtocolError r)
+withIsolatedRepo srcPath action = do
+  UnliftIO.withSystemTempDirectory "ucm-isolated-repo" $ \tempDir -> do
+    (UnliftIO.tryIO $ copyCommand tempDir) >>= \case
+      Left gitErr -> pure $ Left (GitError.CopyException srcPath tempDir (show gitErr))
+      Right () -> Right <$> action tempDir
+  where
+    copyCommand :: FilePath -> m ()
+    copyCommand dest = liftIO $
+      "git" $^ (["clone", "--quiet"] ++ ["--depth", "1"] ++ [Text.pack srcPath, Text.pack dest])
+
 -- | Given a remote git repo url, and branch/commit hash (currently
 -- not allowed): checks for git, clones or updates a cached copy of the repo
-pullBranch :: (MonadIO m, MonadError GitProtocolError m) => ReadRepo -> m CodebasePath
-pullBranch repo@(ReadGitRepo uri) = do
+pullRepo :: (MonadIO m, MonadError GitProtocolError m) => ReadRepo -> m CodebasePath
+pullRepo repo@(ReadGitRepo uri) = do
   checkForGit
-  localPath <- tempGitDir uri
+  localPath <- gitCacheDir uri
   ifM (doesDirectoryExist localPath)
     -- try to update existing directory
     (ifM (isGitRepo localPath)
@@ -69,7 +96,6 @@ pullBranch repo@(ReadGitRepo uri) = do
     -- directory doesn't exist, so clone anew
     (checkOutNew localPath Nothing)
   pure localPath
-
   where
   -- | Do a `git clone` (for a not-previously-cached repo).
   checkOutNew :: (MonadIO m, MonadError GitProtocolError m) => CodebasePath -> Maybe Text -> m ()
diff --git a/parser-typechecker/src/Unison/Codebase/GitError.hs b/parser-typechecker/src/Unison/Codebase/GitError.hs
index 56a485af3..2f8eb18eb 100644
--- a/parser-typechecker/src/Unison/Codebase/GitError.hs
+++ b/parser-typechecker/src/Unison/Codebase/GitError.hs
@@ -1,11 +1,9 @@
-{- ORMOLU_DISABLE -} -- Remove this when the file is ready to be auto-formatted
 module Unison.Codebase.GitError where
 
-import Unison.Prelude
-
-import Unison.Codebase.ShortBranchHash (ShortBranchHash)
-import Unison.Codebase.Editor.RemoteRepo (ReadRepo, WriteRepo, ReadRemoteNamespace)
+import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, ReadRepo, WriteRepo)
 import Unison.Codebase.Path
+import Unison.Codebase.ShortBranchHash (ShortBranchHash)
+import Unison.Prelude
 
 type CodebasePath = FilePath
 
@@ -13,13 +11,15 @@ data GitProtocolError
   = NoGit
   | UnrecognizableCacheDir ReadRepo CodebasePath
   | UnrecognizableCheckoutDir ReadRepo CodebasePath
+  | --            srcPath  destPath error-description
+    CopyException FilePath FilePath String
   | CloneException ReadRepo String
   | PushException WriteRepo String
   | PushNoOp WriteRepo
-    -- url commit Diff of what would change on merge with remote
-  | PushDestinationHasNewStuff WriteRepo
+  | -- url commit Diff of what would change on merge with remote
+    PushDestinationHasNewStuff WriteRepo
   | CleanupError SomeException
-  deriving Show
+  deriving (Show)
 
 data GitCodebaseError h
   = NoRemoteNamespaceWithHash ReadRepo ShortBranchHash
@@ -27,4 +27,4 @@ data GitCodebaseError h
   | CouldntLoadRootBranch ReadRepo h
   | CouldntLoadSyncedBranch ReadRemoteNamespace h
   | CouldntFindRemoteBranch ReadRepo Path
-  deriving Show
+  deriving (Show)
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 5a6c7fa04..f0611bcee 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -70,7 +70,7 @@ import qualified Unison.Codebase as Codebase1
 import Unison.Codebase.Branch (Branch (..))
 import qualified Unison.Codebase.Branch as Branch
 import qualified Unison.Codebase.Causal as Causal
-import Unison.Codebase.Editor.Git (gitIn, gitTextIn, pullBranch)
+import Unison.Codebase.Editor.Git (gitIn, gitTextIn, pullRepo, withIsolatedRepo)
 import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, WriteRepo (WriteGitRepo), printWriteRepo, writeToRead)
 import qualified Unison.Codebase.GitError as GitError
 import qualified Unison.Codebase.Init as Codebase
@@ -91,7 +91,7 @@ import Unison.DataDeclaration (Decl)
 import qualified Unison.DataDeclaration as Decl
 import Unison.Hash (Hash)
 import Unison.Parser.Ann (Ann)
-import Unison.Prelude (MaybeT (runMaybeT), fromMaybe, isJust, trace, traceM)
+import Unison.Prelude
 import Unison.Reference (Reference)
 import qualified Unison.Reference as Reference
 import qualified Unison.Referent as Referent
@@ -110,6 +110,7 @@ import qualified UnliftIO
 import UnliftIO.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import UnliftIO.STM
 import UnliftIO.Exception (catch, bracket)
+import Data.Either.Extra (mapLeft)
 
 debug, debugProcessBranches, debugCommitFailedTransaction :: Bool
 debug = False
@@ -124,7 +125,7 @@ v2dir root = root </> ".unison" </> "v2"
 
 init :: HasCallStack => (MonadUnliftIO m) => Codebase.Init m Symbol Ann
 init = Codebase.Init
-  { withOpenCodebase=getCodebaseOrError
+  { withOpenCodebase=withCodebaseOrError
   , withCreatedCodebase=createCodebaseOrError
   , codebasePath=v2dir
   }
@@ -176,7 +177,7 @@ createCodebaseOrError' debugName path action = do
 withOpenOrCreateCodebaseConnection ::
   (MonadUnliftIO m) =>
   Codebase.DebugName ->
-  FilePath ->
+  CodebasePath ->
   (Connection -> m r) ->
   m r
 withOpenOrCreateCodebaseConnection debugName path action = do
@@ -186,14 +187,14 @@ withOpenOrCreateCodebaseConnection debugName path action = do
   withConnection debugName path action
 
 -- get the codebase in dir
-getCodebaseOrError ::
+withCodebaseOrError ::
   forall m r.
   (MonadUnliftIO m) =>
   Codebase.DebugName ->
   CodebasePath ->
   (Codebase m Symbol Ann -> m r) ->
   m (Either Codebase1.Pretty r)
-getCodebaseOrError debugName dir action = do
+withCodebaseOrError debugName dir action = do
   prettyDir <- liftIO $ P.string <$> canonicalizePath dir
   let prettyError v = P.wrap $ "I don't know how to handle " <> P.shown v <> "in" <> P.backticked' prettyDir "."
   doesFileExist (dir </> codebasePath) >>= \case
@@ -1047,7 +1048,7 @@ viewRemoteBranch' ::
   m (Either C.GitError r)
 viewRemoteBranch' (repo, sbh, path) action = UnliftIO.try do
   -- set up the cache dir
-  remotePath <- UnliftIO.fromEitherM . runExceptT . withExceptT C.GitProtocolError . time "Git fetch" $ pullBranch repo
+  remotePath <- UnliftIO.fromEitherM . runExceptT . withExceptT C.GitProtocolError . time "Git fetch" $ pullRepo repo
 
   -- Tickle the database before calling into `sqliteCodebase`; this covers the case that the database file either
   -- doesn't exist at all or isn't a SQLite database file, but does not cover the case that the database file itself is
@@ -1112,44 +1113,45 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = runExc
   -- otherwise, proceed: release the savepoint (commit it), clean up, and git-push the result
 
   -- set up the cache dir
-  remotePath <- time "Git fetch" $ withExceptT C.GitProtocolError $ pullBranch (writeToRead repo)
-  ExceptT . withOpenOrCreateCodebaseConnection "push.dest" remotePath $ \destConn -> do
-    flip runReaderT destConn $ Q.savepoint "push"
-    flip State.execStateT emptySyncProgressState $
-      syncInternal syncProgress srcConn destConn (Branch.transform lift branch)
-    flip runReaderT destConn do
-      result <- if setRoot
-        then do
-          let newRootHash = Branch.headHash branch
-          -- the call to runDB "handles" the possible DB error by bombing
-          (fmap . fmap) Cv.branchHash2to1 (runDB destConn Ops.loadMaybeRootCausalHash) >>= \case
-            Nothing -> do
-              setRepoRoot newRootHash
-              Q.release "push"
-              pure $ Right ()
-            Just oldRootHash -> do
-              before oldRootHash newRootHash >>= \case
-                Nothing ->
-                  error $
-                    "I couldn't find the hash " ++ show newRootHash
-                      ++ " that I just synced to the cached copy of "
-                      ++ repoString
-                      ++ " in "
-                      ++ show remotePath
-                      ++ "."
-                Just False -> do
-                  Q.rollbackRelease "push"
-                  pure . Left . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
-                Just True -> do
+  pathToCachedRemote <- time "Git fetch" $ withExceptT C.GitProtocolError $ pullRepo (writeToRead repo)
+  _ . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
+    withConnection "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
+      copyCodebase cachedRemoteConn tempRemotePath
+      withConnection "push.dest" repoPath $ \destConn -> do
+        flip runReaderT destConn $ Q.savepoint "push"
+        flip State.execStateT emptySyncProgressState $
+          syncInternal syncProgress srcConn destConn (Branch.transform lift branch)
+        flip runReaderT destConn do
+          result <- if setRoot
+            then do
+              let newRootHash = Branch.headHash branch
+              -- the call to runDB "handles" the possible DB error by bombing
+              (fmap . fmap) Cv.branchHash2to1 (runDB destConn Ops.loadMaybeRootCausalHash) >>= \case
+                Nothing -> do
                   setRepoRoot newRootHash
                   Q.release "push"
                   pure $ Right ()
-        else do
-          Q.release "push"
-          pure $ Right ()
-
-      Q.setJournalMode JournalMode.DELETE
-      pure result
+                Just oldRootHash -> do
+                  before oldRootHash newRootHash >>= \case
+                    Nothing ->
+                      error $
+                        "I couldn't find the hash " ++ show newRootHash
+                          ++ " that I just synced to the cached copy of "
+                          ++ repoString
+                          ++ " in "
+                          ++ show remotePath
+                          ++ "."
+                    Just False -> do
+                      Q.rollbackRelease "push"
+                      pure . Left . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
+                    Just True -> do
+                      setRepoRoot newRootHash
+                      Q.release "push"
+                      pure $ Right ()
+            else do
+              Q.release "push"
+              pure $ Right ()
+          pure result
   liftIO do
     void $ push remotePath repo
   where
@@ -1232,3 +1234,15 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = runExc
             -- Push our changes to the repo
             gitIn remotePath ["push", "--quiet", url]
             pure True
+
+
+-- -- | Execute the given block over an isolated instance of the given codebase.
+-- -- The codebase is ephemeral and will be deleted after the block is completed.
+-- withIsolatedRemote :: MonadUnliftIO m => Codebase.DebugName -> FilePath -> (Connection -> m r) -> m (Either C.GitError r)
+-- withIsolatedRemote debugName repoPath action = mapLeft C.GitProtocolError <$> do
+--   withIsolatedRepo repoPath $ \repoPath -> do
+--     withConnection debugName repoPath $ action
+
+copyCodebase :: MonadIO m => Connection -> CodebasePath -> m ()
+copyCodebase srcConn destPath = runDB srcConn $ do
+  Q.vacuumInto (destPath </> codebasePath)

From 059b7c287aded8de09bd622de435c2fae324b197 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Wed, 8 Dec 2021 11:47:53 -0600
Subject: [PATCH 02/10] WIP

---
 .../U/Codebase/Sqlite/Operations.hs           |   3 +
 .../U/Codebase/Sqlite/Queries.hs              |  10 ++
 .../src/Unison/Codebase/SqliteCodebase.hs     | 109 ++++++++++--------
 3 files changed, 76 insertions(+), 46 deletions(-)

diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs
index 080cadd06..40cca283d 100644
--- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs
+++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Operations.hs
@@ -199,6 +199,7 @@ import U.Util.Serialization (Get)
 import qualified U.Util.Serialization as S
 import qualified Unison.Util.Set as Set
 import qualified U.Util.Term as TermUtil
+import UnliftIO (Exception)
 
 -- * Error handling
 
@@ -241,6 +242,8 @@ data Error
   | NeedTypeForBuiltinMetadata Text
   deriving (Show)
 
+instance Exception Error
+
 getFromBytesOr :: Err m => DecodeError -> Get a -> ByteString -> m a
 getFromBytesOr e get bs = case runGetS get bs of
   Left err -> throwError (DecodeError e bs err)
diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
index 401197e92..8b5850b04 100644
--- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
+++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
@@ -114,6 +114,7 @@ module U.Codebase.Sqlite.Queries (
   savepoint,
   release,
   rollbackRelease,
+  withSavepoint,
 
   vacuumInto,
   setJournalMode,
@@ -181,6 +182,7 @@ import U.Util.Base32Hex (Base32Hex (..))
 import U.Util.Hash (Hash)
 import qualified U.Util.Hash as Hash
 import UnliftIO (MonadUnliftIO, throwIO, try, tryAny, withRunInIO)
+import qualified UnliftIO
 import UnliftIO.Concurrent (myThreadId)
 -- * types
 
@@ -892,6 +894,14 @@ release name = execute_ (fromString $ "RELEASE " ++ name)
 rollbackTo name = execute_ (fromString $ "ROLLBACK TO " ++ name)
 rollbackRelease name = rollbackTo name *> release name
 
+withSavepoint :: (MonadUnliftIO m, DB m) => String -> (m () -> m r) -> m r
+withSavepoint name action =
+  UnliftIO.bracket_
+    (savepoint name)
+    (release name)
+    (action (rollbackTo name) `UnliftIO.onException` rollbackTo name)
+
+
 -- * orphan instances
 
 deriving via Text instance ToField Base32Hex
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index f0611bcee..99a50225b 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -14,7 +14,7 @@ where
 
 import qualified Control.Concurrent
 import Control.Monad (filterM, unless, when, (>=>))
-import Control.Monad.Except (ExceptT (ExceptT), runExceptT, withExceptT)
+import Control.Monad.Except (ExceptT (ExceptT), runExceptT, withExceptT, throwError)
 import qualified Control.Monad.Except as Except
 import Control.Monad.Extra (ifM, unlessM)
 import qualified Control.Monad.Extra as Monad
@@ -110,7 +110,7 @@ import qualified UnliftIO
 import UnliftIO.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import UnliftIO.STM
 import UnliftIO.Exception (catch, bracket)
-import Data.Either.Extra (mapLeft)
+import Data.Either.Extra ()
 
 debug, debugProcessBranches, debugCommitFailedTransaction :: Bool
 debug = False
@@ -845,7 +845,7 @@ isCausalHash' (Causal.RawHash h) =
     Nothing -> pure False
     Just hId -> Q.isCausalHash hId
 
-before :: MonadIO m => Branch.Hash -> Branch.Hash -> ReaderT Connection m (Maybe Bool)
+before :: (MonadIO m, Q.DB m) => Branch.Hash -> Branch.Hash -> m (Maybe Bool)
 before h1 h2 =
   Ops.before (Cv.causalHash1to2 h1) (Cv.causalHash1to2 h2)
 
@@ -952,6 +952,12 @@ runDB conn = (runExceptT >=> err) . flip runReaderT conn
   where
     err = \case Left err -> error $ show err; Right a -> pure a
 
+runDBUnlifted :: (HasCallStack, MonadUnliftIO m) => Connection -> ReaderT Connection m a -> m a
+runDBUnlifted conn m =
+  UnliftIO.try (runReaderT m conn) >>= \case
+    Left (err :: Ops.Error) -> error $ show err
+    Right a -> pure a
+
 data Entity m
   = B Branch.Hash (m (Branch m))
   | O Hash
@@ -1095,13 +1101,14 @@ viewRemoteBranch' (repo, sbh, path) action = UnliftIO.try do
 -- Push a branch to a repo. Optionally attempt to set the branch as the new root, which fails if the branch is not after
 -- the existing root.
 pushGitBranch ::
+  forall m.
   (MonadUnliftIO m) =>
   Connection ->
   Branch m ->
   WriteRepo ->
   PushGitBranchOpts ->
   m (Either C.GitError ())
-pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = runExceptT @C.GitError do
+pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = UnliftIO.try $ do
   -- pull the remote repo to the staging directory
   -- open a connection to the staging codebase
   -- create a savepoint on the staging codebase
@@ -1113,50 +1120,52 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = runExc
   -- otherwise, proceed: release the savepoint (commit it), clean up, and git-push the result
 
   -- set up the cache dir
-  pathToCachedRemote <- time "Git fetch" $ withExceptT C.GitProtocolError $ pullRepo (writeToRead repo)
-  _ . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
+  pathToCachedRemote <- time "Git fetch" $ throwExceptT . withExceptT C.GitProtocolError $ pullRepo (writeToRead repo)
+  throwEither . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
+    -- Connect to codebase in the cached git repo so we can copy it over.
     withConnection "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
       copyCodebase cachedRemoteConn tempRemotePath
-      withConnection "push.dest" repoPath $ \destConn -> do
-        flip runReaderT destConn $ Q.savepoint "push"
-        flip State.execStateT emptySyncProgressState $
-          syncInternal syncProgress srcConn destConn (Branch.transform lift branch)
-        flip runReaderT destConn do
-          result <- if setRoot
-            then do
-              let newRootHash = Branch.headHash branch
-              -- the call to runDB "handles" the possible DB error by bombing
-              (fmap . fmap) Cv.branchHash2to1 (runDB destConn Ops.loadMaybeRootCausalHash) >>= \case
-                Nothing -> do
-                  setRepoRoot newRootHash
-                  Q.release "push"
-                  pure $ Right ()
-                Just oldRootHash -> do
-                  before oldRootHash newRootHash >>= \case
-                    Nothing ->
-                      error $
-                        "I couldn't find the hash " ++ show newRootHash
-                          ++ " that I just synced to the cached copy of "
-                          ++ repoString
-                          ++ " in "
-                          ++ show remotePath
-                          ++ "."
-                    Just False -> do
-                      Q.rollbackRelease "push"
-                      pure . Left . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
-                    Just True -> do
-                      setRepoRoot newRootHash
-                      Q.release "push"
-                      pure $ Right ()
-            else do
-              Q.release "push"
-              pure $ Right ()
-          pure result
-  liftIO do
-    void $ push remotePath repo
+      -- Connect to the newly copied database which we know has been properly closed and
+      -- nobody else could be using.
+      withConnection "push.dest" tempRemotePath $ \destConn -> do
+        result <- runDBUnlifted destConn $ Q.withSavepoint "push" \rollback -> do
+          throwExceptT $ doSync tempRemotePath srcConn destConn
+        void $ push tempRemotePath repo
+        pure result
   where
+    doSync :: FilePath -> Connection -> Connection -> ExceptT C.GitError m ()
+    doSync remotePath srcConn destConn = do
+      _ <- flip State.execStateT emptySyncProgressState $
+        syncInternal syncProgress srcConn destConn (Branch.transform (lift . lift) branch)
+      when setRoot $ overwriteRoot remotePath destConn
+    overwriteRoot :: forall m. MonadIO m => FilePath -> Connection -> ExceptT C.GitError m ()
+    overwriteRoot remotePath destConn = do
+      let newRootHash = Branch.headHash branch
+      -- the call to runDB "handles" the possible DB error by bombing
+      maybeOldRootHash <- fmap Cv.branchHash2to1 <$> runDB destConn Ops.loadMaybeRootCausalHash
+      case maybeOldRootHash of
+        Nothing -> runDB destConn $ do
+          setRepoRoot newRootHash
+          -- Q.release "push"
+        (Just oldRootHash) -> runDB destConn $ do
+          before oldRootHash newRootHash >>= \case
+            Nothing ->
+              error $
+                "I couldn't find the hash " ++ show newRootHash
+                  ++ " that I just synced to the cached copy of "
+                  ++ repoString
+                  ++ " in "
+                  ++ show remotePath
+                  ++ "."
+            Just False -> do
+              -- Q.rollbackRelease "push"
+              lift . lift . throwError . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
+            Just True -> do
+              setRepoRoot newRootHash
+              -- Q.release "push"
+
     repoString = Text.unpack $ printWriteRepo repo
-    setRepoRoot :: Q.DB m => Branch.Hash -> m ()
+    setRepoRoot :: forall m. Q.DB m => Branch.Hash -> m ()
     setRepoRoot h = do
       let h2 = Cv.causalHash1to2 h
           err = error $ "Called SqliteCodebase.setNamespaceRoot on unknown causal hash " ++ show h2
@@ -1203,7 +1212,7 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = runExc
         hasDeleteShm = any isShmDelete statusLines
 
     -- Commit our changes
-    push :: CodebasePath -> WriteRepo -> IO Bool -- withIOError needs IO
+    push :: forall m. MonadIO m => CodebasePath -> WriteRepo -> m Bool -- withIOError needs IO
     push remotePath (WriteGitRepo url) = time "SqliteCodebase.pushGitRootBranch.push" $ do
       -- has anything changed?
       -- note: -uall recursively shows status for all files in untracked directories
@@ -1242,7 +1251,15 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = runExc
 -- withIsolatedRemote debugName repoPath action = mapLeft C.GitProtocolError <$> do
 --   withIsolatedRepo repoPath $ \repoPath -> do
 --     withConnection debugName repoPath $ action
-
 copyCodebase :: MonadIO m => Connection -> CodebasePath -> m ()
 copyCodebase srcConn destPath = runDB srcConn $ do
   Q.vacuumInto (destPath </> codebasePath)
+
+throwExceptT :: (MonadIO m, Exception e) => ExceptT e m a -> m a
+throwExceptT action = runExceptT action >>= \case
+  Left e -> UnliftIO.throwIO e
+  Right a -> pure a
+
+
+throwEither :: (MonadIO m, Exception e) => m (Either e a) -> m a
+throwEither action = throwExceptT (ExceptT action)

From 0bb7e4553d1222754c67be0808f4ece60daba201 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Mon, 20 Dec 2021 13:49:19 -0600
Subject: [PATCH 03/10] Get copy codebase logic compiling

---
 .../U/Codebase/Sqlite/Queries.hs              |  3 +
 lib/unison-prelude/package.yaml               |  1 +
 lib/unison-prelude/src/Unison/Prelude.hs      | 21 +++++++
 lib/unison-prelude/unison-prelude.cabal       |  1 +
 .../src/Unison/Codebase/SqliteCodebase.hs     | 55 ++++---------------
 .../src/Unison/CommandLine/OutputMessages.hs  |  5 ++
 6 files changed, 42 insertions(+), 44 deletions(-)

diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
index 8b5850b04..0bf9def48 100644
--- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
+++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
@@ -115,6 +115,7 @@ module U.Codebase.Sqlite.Queries (
   release,
   rollbackRelease,
   withSavepoint,
+  withSavepoint_,
 
   vacuumInto,
   setJournalMode,
@@ -901,6 +902,8 @@ withSavepoint name action =
     (release name)
     (action (rollbackTo name) `UnliftIO.onException` rollbackTo name)
 
+withSavepoint_ :: (MonadUnliftIO m, DB m) => String -> m r -> m r
+withSavepoint_ name action = withSavepoint name (\_rollback -> action)
 
 -- * orphan instances
 
diff --git a/lib/unison-prelude/package.yaml b/lib/unison-prelude/package.yaml
index c7baff8df..d8fdc3032 100644
--- a/lib/unison-prelude/package.yaml
+++ b/lib/unison-prelude/package.yaml
@@ -15,6 +15,7 @@ dependencies:
   - safe
   - text
   - transformers
+  - unliftio
 
 ghc-options:
   -Wall
diff --git a/lib/unison-prelude/src/Unison/Prelude.hs b/lib/unison-prelude/src/Unison/Prelude.hs
index 6f63e5af3..4cce3d80a 100644
--- a/lib/unison-prelude/src/Unison/Prelude.hs
+++ b/lib/unison-prelude/src/Unison/Prelude.hs
@@ -14,6 +14,10 @@ module Unison.Prelude
 
     -- * @Either@ control flow
     whenLeft,
+    throwEitherM,
+    throwEitherMWith,
+    throwExceptT,
+    throwExceptTWith,
   )
 where
 
@@ -51,6 +55,8 @@ import GHC.Generics as X (Generic, Generic1)
 import GHC.Stack as X (HasCallStack)
 import Safe as X (atMay, headMay, lastMay, readMay)
 import Text.Read as X (readMaybe)
+import Control.Monad.Trans.Except (ExceptT (ExceptT), runExceptT, withExceptT)
+import qualified UnliftIO
 
 onNothing :: Applicative m => m a -> Maybe a -> m a
 onNothing x =
@@ -61,6 +67,21 @@ whenLeft = \case
   Left a -> \f -> f a
   Right b -> \_ -> pure b
 
+
+throwExceptT :: (MonadIO m, Exception e) => ExceptT e m a -> m a
+throwExceptT = throwExceptTWith id
+
+throwExceptTWith :: (MonadIO m, Exception e') => (e -> e') -> ExceptT e m a -> m a
+throwExceptTWith f action = runExceptT (withExceptT f action) >>= \case
+  Left e -> liftIO . UnliftIO.throwIO $ e
+  Right a -> pure a
+
+throwEitherM :: (MonadIO m, Exception e) => m (Either e a) -> m a
+throwEitherM = throwEitherMWith id
+
+throwEitherMWith :: (MonadIO m, Exception e') => (e -> e') -> m (Either e a) -> m a
+throwEitherMWith f action = throwExceptT . withExceptT f $ (ExceptT action)
+
 tShow :: Show a => a -> Text
 tShow = Text.pack . show
 
diff --git a/lib/unison-prelude/unison-prelude.cabal b/lib/unison-prelude/unison-prelude.cabal
index 356ae7fc6..c431150aa 100644
--- a/lib/unison-prelude/unison-prelude.cabal
+++ b/lib/unison-prelude/unison-prelude.cabal
@@ -48,4 +48,5 @@ library
     , safe
     , text
     , transformers
+    , unliftio
   default-language: Haskell2010
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 99a50225b..433247fe8 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -13,34 +13,22 @@ module Unison.Codebase.SqliteCodebase
 where
 
 import qualified Control.Concurrent
-import Control.Monad (filterM, unless, when, (>=>))
-import Control.Monad.Except (ExceptT (ExceptT), runExceptT, withExceptT, throwError)
+import Control.Monad.Except (runExceptT, withExceptT, throwError, ExceptT)
 import qualified Control.Monad.Except as Except
-import Control.Monad.Extra (ifM, unlessM)
 import qualified Control.Monad.Extra as Monad
 import Control.Monad.Reader (ReaderT (runReaderT))
 import Control.Monad.State (MonadState)
 import qualified Control.Monad.State as State
-import Control.Monad.Trans (MonadTrans (lift))
-import Control.Monad.Trans.Maybe (MaybeT (MaybeT))
 import Data.Bifunctor (Bifunctor (bimap), second)
 import qualified Data.Char as Char
 import qualified Data.Either.Combinators as Either
-import Data.Foldable (Foldable (toList), for_, traverse_)
-import Data.Functor (void, (<&>))
 import qualified Data.List as List
-import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe (fromJust)
-import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as TextIO
-import Data.Traversable (for)
-import Data.Word (Word64)
 import qualified Database.SQLite.Simple as Sqlite
-import GHC.Stack (HasCallStack)
 import qualified System.Console.ANSI as ANSI
 import System.FilePath ((</>))
 import qualified System.FilePath as FilePath
@@ -50,7 +38,6 @@ import qualified U.Codebase.Referent as C.Referent
 import U.Codebase.Sqlite.Connection (Connection (Connection))
 import qualified U.Codebase.Sqlite.Connection as Connection
 import U.Codebase.Sqlite.DbId (SchemaVersion (SchemaVersion), ObjectId)
-import qualified U.Codebase.Sqlite.JournalMode as JournalMode
 import qualified U.Codebase.Sqlite.ObjectType as OT
 import U.Codebase.Sqlite.Operations (EDB)
 import qualified U.Codebase.Sqlite.Operations as Ops
@@ -105,7 +92,7 @@ import Unison.Type (Type)
 import qualified Unison.Type as Type
 import qualified Unison.Util.Pretty as P
 import qualified Unison.WatchKind as UF
-import UnliftIO (MonadIO, catchIO, finally, liftIO, MonadUnliftIO, throwIO)
+import UnliftIO (catchIO, finally, MonadUnliftIO, throwIO)
 import qualified UnliftIO
 import UnliftIO.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
 import UnliftIO.STM
@@ -174,19 +161,8 @@ createCodebaseOrError' debugName path action = do
 
       fmap (Either.mapLeft CreateCodebaseUnknownSchemaVersion) (sqliteCodebase debugName path action)
 
-withOpenOrCreateCodebaseConnection ::
-  (MonadUnliftIO m) =>
-  Codebase.DebugName ->
-  CodebasePath ->
-  (Connection -> m r) ->
-  m r
-withOpenOrCreateCodebaseConnection debugName path action = do
-  unlessM
-    (doesFileExist $ path </> codebasePath)
-    (initSchemaIfNotExist path)
-  withConnection debugName path action
-
--- get the codebase in dir
+-- | Use the codebase in the provided path.
+-- The codebase is automatically closed when the action completes or throws an exception.
 withCodebaseOrError ::
   forall m r.
   (MonadUnliftIO m) =>
@@ -1120,23 +1096,23 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
   -- otherwise, proceed: release the savepoint (commit it), clean up, and git-push the result
 
   -- set up the cache dir
-  pathToCachedRemote <- time "Git fetch" $ throwExceptT . withExceptT C.GitProtocolError $ pullRepo (writeToRead repo)
-  throwEither . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
+  pathToCachedRemote <- time "Git fetch" $ throwExceptTWith C.GitProtocolError $ pullRepo (writeToRead repo)
+  throwEitherMWith C.GitProtocolError . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
     -- Connect to codebase in the cached git repo so we can copy it over.
-    withConnection "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
+    withConnection @m "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
       copyCodebase cachedRemoteConn tempRemotePath
       -- Connect to the newly copied database which we know has been properly closed and
       -- nobody else could be using.
-      withConnection "push.dest" tempRemotePath $ \destConn -> do
-        result <- runDBUnlifted destConn $ Q.withSavepoint "push" \rollback -> do
+      withConnection @m "push.dest" tempRemotePath $ \destConn -> do
+        result <- runDBUnlifted @m destConn $ Q.withSavepoint_ @(ReaderT _ m) "push" $ do
           throwExceptT $ doSync tempRemotePath srcConn destConn
         void $ push tempRemotePath repo
         pure result
   where
-    doSync :: FilePath -> Connection -> Connection -> ExceptT C.GitError m ()
+    doSync :: FilePath -> Connection -> Connection -> ExceptT C.GitError (ReaderT Connection m) ()
     doSync remotePath srcConn destConn = do
       _ <- flip State.execStateT emptySyncProgressState $
-        syncInternal syncProgress srcConn destConn (Branch.transform (lift . lift) branch)
+        syncInternal syncProgress srcConn destConn (Branch.transform (lift . lift . lift) branch)
       when setRoot $ overwriteRoot remotePath destConn
     overwriteRoot :: forall m. MonadIO m => FilePath -> Connection -> ExceptT C.GitError m ()
     overwriteRoot remotePath destConn = do
@@ -1254,12 +1230,3 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
 copyCodebase :: MonadIO m => Connection -> CodebasePath -> m ()
 copyCodebase srcConn destPath = runDB srcConn $ do
   Q.vacuumInto (destPath </> codebasePath)
-
-throwExceptT :: (MonadIO m, Exception e) => ExceptT e m a -> m a
-throwExceptT action = runExceptT action >>= \case
-  Left e -> UnliftIO.throwIO e
-  Right a -> pure a
-
-
-throwEither :: (MonadIO m, Exception e) => m (Either e a) -> m a
-throwEither action = throwExceptT (ExceptT action)
diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
index 0ff2bf7ac..d4dae43f7 100644
--- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs
+++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs
@@ -913,6 +913,11 @@ notifyUser dir o = case o of
           "I couldn't clone the repository at" <> prettyReadRepo repo <> ";"
             <> "the error was:"
             <> (P.indentNAfterNewline 2 . P.group . P.string) msg
+      CopyException srcRepoPath destPath msg ->
+        P.wrap $
+          "I couldn't copy the repository at" <> P.string srcRepoPath <> "into" <> P.string destPath <> ";"
+            <> "the error was:"
+            <> (P.indentNAfterNewline 2 . P.group . P.string) msg
       PushNoOp repo ->
         P.wrap $
           "The repository at" <> prettyWriteRepo repo <> "is already up-to-date."

From 3a6b6c5f80cccc130588cb9bb09ef28b2cb35bc4 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Mon, 20 Dec 2021 14:33:17 -0600
Subject: [PATCH 04/10] Clean up codebase path organization

---
 .../src/Unison/Codebase/Editor/Git.hs         |  2 +-
 .../src/Unison/Codebase/SqliteCodebase.hs     | 59 +++++++++++--------
 2 files changed, 36 insertions(+), 25 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase/Editor/Git.hs b/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
index 1fbc19fb8..fc6af8617 100644
--- a/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
@@ -80,7 +80,7 @@ withIsolatedRepo srcPath action = do
   where
     copyCommand :: FilePath -> m ()
     copyCommand dest = liftIO $
-      "git" $^ (["clone", "--quiet"] ++ ["--depth", "1"] ++ [Text.pack srcPath, Text.pack dest])
+      "git" $^ (["clone", "--quiet"] ++ ["file://" <> Text.pack srcPath, Text.pack dest])
 
 -- | Given a remote git repo url, and branch/commit hash (currently
 -- not allowed): checks for git, clones or updates a cached copy of the repo
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 433247fe8..8216e25df 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -31,7 +31,6 @@ import qualified Data.Text.IO as TextIO
 import qualified Database.SQLite.Simple as Sqlite
 import qualified System.Console.ANSI as ANSI
 import System.FilePath ((</>))
-import qualified System.FilePath as FilePath
 import U.Codebase.HashTags (CausalHash (CausalHash, unCausalHash))
 import qualified U.Codebase.Reference as C.Reference
 import qualified U.Codebase.Referent as C.Referent
@@ -94,7 +93,7 @@ import qualified Unison.Util.Pretty as P
 import qualified Unison.WatchKind as UF
 import UnliftIO (catchIO, finally, MonadUnliftIO, throwIO)
 import qualified UnliftIO
-import UnliftIO.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
+import UnliftIO.Directory (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, removePathForcibly)
 import UnliftIO.STM
 import UnliftIO.Exception (catch, bracket)
 import Data.Either.Extra ()
@@ -104,17 +103,21 @@ debug = False
 debugProcessBranches = False
 debugCommitFailedTransaction = False
 
+-- | Prefer makeCodebasePath or makeCodebaseDir when possible.
 codebasePath :: FilePath
 codebasePath = ".unison" </> "v2" </> "unison.sqlite3"
 
-v2dir :: FilePath -> FilePath
-v2dir root = root </> ".unison" </> "v2"
+makeCodebasePath :: FilePath -> FilePath
+makeCodebasePath root = makeCodebaseDir root </> "unison.sqlite3"
+
+makeCodebaseDir :: FilePath -> FilePath
+makeCodebaseDir root = root </> ".unison" </> "v2"
 
 init :: HasCallStack => (MonadUnliftIO m) => Codebase.Init m Symbol Ann
 init = Codebase.Init
   { withOpenCodebase=withCodebaseOrError
   , withCreatedCodebase=createCodebaseOrError
-  , codebasePath=v2dir
+  , codebasePath=makeCodebaseDir
   }
 
 createCodebaseOrError ::
@@ -146,10 +149,10 @@ createCodebaseOrError' ::
   m (Either CreateCodebaseError r)
 createCodebaseOrError' debugName path action = do
   ifM
-    (doesFileExist $ path </> codebasePath)
+    (doesFileExist $ makeCodebasePath path)
     (pure $ Left CreateCodebaseAlreadyExists)
     do
-      createDirectoryIfMissing True (path </> FilePath.takeDirectory codebasePath)
+      createDirectoryIfMissing True (makeCodebaseDir path)
       liftIO $
         withConnection (debugName ++ ".createSchema") path $
           ( runReaderT do
@@ -161,6 +164,18 @@ createCodebaseOrError' debugName path action = do
 
       fmap (Either.mapLeft CreateCodebaseUnknownSchemaVersion) (sqliteCodebase debugName path action)
 
+withOpenOrCreateCodebaseConnection ::
+  (MonadUnliftIO m) =>
+  Codebase.DebugName ->
+  FilePath ->
+  (Connection -> m r) ->
+  m r
+withOpenOrCreateCodebaseConnection debugName path action = do
+  unlessM
+    (doesFileExist $ makeCodebasePath path)
+    (initSchemaIfNotExist path)
+  withConnection debugName path action
+
 -- | Use the codebase in the provided path.
 -- The codebase is automatically closed when the action completes or throws an exception.
 withCodebaseOrError ::
@@ -173,7 +188,7 @@ withCodebaseOrError ::
 withCodebaseOrError debugName dir action = do
   prettyDir <- liftIO $ P.string <$> canonicalizePath dir
   let prettyError v = P.wrap $ "I don't know how to handle " <> P.shown v <> "in" <> P.backticked' prettyDir "."
-  doesFileExist (dir </> codebasePath) >>= \case
+  doesFileExist (makeCodebasePath dir) >>= \case
     -- If the codebase file doesn't exist, just return any string. The string is currently ignored (see
     -- Unison.Codebase.Init.getCodebaseOrExit).
     False -> pure (Left "codebase doesn't exist")
@@ -181,9 +196,9 @@ withCodebaseOrError debugName dir action = do
 
 initSchemaIfNotExist :: MonadIO m => FilePath -> m ()
 initSchemaIfNotExist path = liftIO do
-  unlessM (doesDirectoryExist $ path </> FilePath.takeDirectory codebasePath) $
-    createDirectoryIfMissing True (path </> FilePath.takeDirectory codebasePath)
-  unlessM (doesFileExist $ path </> codebasePath) $
+  unlessM (doesDirectoryExist $ makeCodebaseDir path) $
+    createDirectoryIfMissing True (makeCodebaseDir path)
+  unlessM (doesFileExist $ makeCodebasePath path) $
     withConnection "initSchemaIfNotExist" path $ runReaderT Q.createSchema
 
 -- 1) buffer up the component
@@ -247,7 +262,7 @@ unsafeGetConnection ::
   CodebasePath ->
   m (IO (), Connection)
 unsafeGetConnection name root = do
-  let path = root </> codebasePath
+  let path = makeCodebasePath root
   Monad.when debug $ traceM $ "unsafeGetconnection " ++ name ++ " " ++ root ++ " -> " ++ path
   (Connection name path -> conn) <- liftIO $ Sqlite.open path
   runReaderT Q.setFlags conn
@@ -1099,15 +1114,14 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
   pathToCachedRemote <- time "Git fetch" $ throwExceptTWith C.GitProtocolError $ pullRepo (writeToRead repo)
   throwEitherMWith C.GitProtocolError . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
     -- Connect to codebase in the cached git repo so we can copy it over.
-    withConnection @m "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
+    withOpenOrCreateCodebaseConnection @m "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
       copyCodebase cachedRemoteConn tempRemotePath
       -- Connect to the newly copied database which we know has been properly closed and
       -- nobody else could be using.
       withConnection @m "push.dest" tempRemotePath $ \destConn -> do
-        result <- runDBUnlifted @m destConn $ Q.withSavepoint_ @(ReaderT _ m) "push" $ do
+        runDBUnlifted @m destConn $ Q.withSavepoint_ @(ReaderT _ m) "push" $ do
           throwExceptT $ doSync tempRemotePath srcConn destConn
-        void $ push tempRemotePath repo
-        pure result
+    void $ push tempRemotePath repo
   where
     doSync :: FilePath -> Connection -> Connection -> ExceptT C.GitError (ReaderT Connection m) ()
     doSync remotePath srcConn destConn = do
@@ -1220,13 +1234,10 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
             gitIn remotePath ["push", "--quiet", url]
             pure True
 
-
--- -- | Execute the given block over an isolated instance of the given codebase.
--- -- The codebase is ephemeral and will be deleted after the block is completed.
--- withIsolatedRemote :: MonadUnliftIO m => Codebase.DebugName -> FilePath -> (Connection -> m r) -> m (Either C.GitError r)
--- withIsolatedRemote debugName repoPath action = mapLeft C.GitProtocolError <$> do
---   withIsolatedRepo repoPath $ \repoPath -> do
---     withConnection debugName repoPath $ action
+-- | Make a clean copy of the connected codebase into the provided path.
 copyCodebase :: MonadIO m => Connection -> CodebasePath -> m ()
 copyCodebase srcConn destPath = runDB srcConn $ do
-  Q.vacuumInto (destPath </> codebasePath)
+  -- remove any existing codebase at the destination location.
+  removePathForcibly (makeCodebaseDir destPath)
+  createDirectoryIfMissing True (makeCodebaseDir destPath)
+  Q.vacuumInto (makeCodebasePath destPath)

From 774b9f16678be4a98050557023d86a9f0aae28d8 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Mon, 20 Dec 2021 14:54:32 -0600
Subject: [PATCH 05/10] update docs

---
 .../src/Unison/Codebase/SqliteCodebase.hs         | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 8216e25df..79a225ecc 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -1100,16 +1100,19 @@ pushGitBranch ::
   PushGitBranchOpts ->
   m (Either C.GitError ())
 pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = UnliftIO.try $ do
-  -- pull the remote repo to the staging directory
-  -- open a connection to the staging codebase
-  -- create a savepoint on the staging codebase
+  -- Pull the latest remote into our git cache
+  -- Use a local git clone to copy this git repo into a temp-dir
+  -- Delete the codebase in our temp-dir
+  -- Use sqlite's VACUUM INTO command to make a copy of the remote codebase into our temp-dir
+  -- Connect to the copied codebase and sync whatever it is we want to push.
   -- sync the branch to the staging codebase using `syncInternal`, which probably needs to be passed in instead of `syncToDirectory`
   -- if setting the remote root,
   --   do a `before` check on the staging codebase
   --   if it passes, proceed (see below)
-  --   if it fails, rollback to the savepoint and clean up.
-  -- otherwise, proceed: release the savepoint (commit it), clean up, and git-push the result
-
+  --   if it fails, throw an exception (which will rollback) and clean up.
+  -- push from the temp-dir to the remote.
+  -- Delete the temp-dir.
+  --
   -- set up the cache dir
   pathToCachedRemote <- time "Git fetch" $ throwExceptTWith C.GitProtocolError $ pullRepo (writeToRead repo)
   throwEitherMWith C.GitProtocolError . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do

From 582335c008d5e4eea14471e98ec2029ee2c342e4 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 21 Dec 2021 10:47:41 -0600
Subject: [PATCH 06/10] Fix typo in codebase path creation

---
 parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 8d2349a9a..9200daa10 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -131,7 +131,7 @@ createCodebaseOrError debugName path action = do
     (doesFileExist $ makeCodebasePath path)
     (pure $ Left Codebase1.CreateCodebaseAlreadyExists)
     do
-      createDirectoryIfMissing True (makeCodebasePath path)
+      createDirectoryIfMissing True (makeCodebaseDir path)
       withConnection (debugName ++ ".createSchema") path $
         runReaderT do
           Q.createSchema

From 8226d609839ba592efad3b0b1a66073ce16a8489 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 21 Dec 2021 10:57:46 -0600
Subject: [PATCH 07/10] Simplify db connection running

---
 .../src/Unison/Codebase/Editor/Git.hs         |  6 ++--
 .../src/Unison/Codebase/SqliteCodebase.hs     | 28 ++++++++-----------
 2 files changed, 14 insertions(+), 20 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase/Editor/Git.hs b/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
index fc6af8617..a68072d9d 100644
--- a/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
+++ b/parser-typechecker/src/Unison/Codebase/Editor/Git.hs
@@ -74,12 +74,12 @@ withIsolatedRepo ::
   m (Either GitProtocolError r)
 withIsolatedRepo srcPath action = do
   UnliftIO.withSystemTempDirectory "ucm-isolated-repo" $ \tempDir -> do
-    (UnliftIO.tryIO $ copyCommand tempDir) >>= \case
+    copyCommand tempDir >>= \case
       Left gitErr -> pure $ Left (GitError.CopyException srcPath tempDir (show gitErr))
       Right () -> Right <$> action tempDir
   where
-    copyCommand :: FilePath -> m ()
-    copyCommand dest = liftIO $
+    copyCommand :: FilePath -> m (Either IOException ())
+    copyCommand dest = UnliftIO.tryIO . liftIO $
       "git" $^ (["clone", "--quiet"] ++ ["file://" <> Text.pack srcPath, Text.pack dest])
 
 -- | Given a remote git repo url, and branch/commit hash (currently
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 9200daa10..4e373457e 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -103,21 +103,21 @@ debug = False
 debugProcessBranches = False
 debugCommitFailedTransaction = False
 
--- | Prefer makeCodebasePath or makeCodebaseDir when possible.
+-- | Prefer makeCodebasePath or makeCodebaseDirPath when possible.
 codebasePath :: FilePath
 codebasePath = ".unison" </> "v2" </> "unison.sqlite3"
 
 makeCodebasePath :: FilePath -> FilePath
-makeCodebasePath root = makeCodebaseDir root </> "unison.sqlite3"
+makeCodebasePath root = makeCodebaseDirPath root </> "unison.sqlite3"
 
-makeCodebaseDir :: FilePath -> FilePath
-makeCodebaseDir root = root </> ".unison" </> "v2"
+makeCodebaseDirPath :: FilePath -> FilePath
+makeCodebaseDirPath root = root </> ".unison" </> "v2"
 
 init :: HasCallStack => (MonadUnliftIO m) => Codebase.Init m Symbol Ann
 init = Codebase.Init
   { withOpenCodebase=withCodebaseOrError
   , withCreatedCodebase=createCodebaseOrError
-  , codebasePath=makeCodebaseDir
+  , codebasePath=makeCodebaseDirPath
   }
 
 createCodebaseOrError ::
@@ -131,7 +131,7 @@ createCodebaseOrError debugName path action = do
     (doesFileExist $ makeCodebasePath path)
     (pure $ Left Codebase1.CreateCodebaseAlreadyExists)
     do
-      createDirectoryIfMissing True (makeCodebaseDir path)
+      createDirectoryIfMissing True (makeCodebaseDirPath path)
       withConnection (debugName ++ ".createSchema") path $
         runReaderT do
           Q.createSchema
@@ -172,8 +172,8 @@ withCodebaseOrError debugName dir action = do
 
 initSchemaIfNotExist :: MonadIO m => FilePath -> m ()
 initSchemaIfNotExist path = liftIO do
-  unlessM (doesDirectoryExist $ makeCodebaseDir path) $
-    createDirectoryIfMissing True (makeCodebaseDir path)
+  unlessM (doesDirectoryExist $ makeCodebaseDirPath path) $
+    createDirectoryIfMissing True (makeCodebaseDirPath path)
   unlessM (doesFileExist $ makeCodebasePath path) $
     withConnection "initSchemaIfNotExist" path $ runReaderT Q.createSchema
 
@@ -919,12 +919,6 @@ runDB conn = (runExceptT >=> err) . flip runReaderT conn
   where
     err = \case Left err -> error $ show err; Right a -> pure a
 
-runDBUnlifted :: (HasCallStack, MonadUnliftIO m) => Connection -> ReaderT Connection m a -> m a
-runDBUnlifted conn m =
-  UnliftIO.try (runReaderT m conn) >>= \case
-    Left (err :: Ops.Error) -> error $ show err
-    Right a -> pure a
-
 data Entity m
   = B Branch.Hash (m (Branch m))
   | O Hash
@@ -1098,7 +1092,7 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
       -- Connect to the newly copied database which we know has been properly closed and
       -- nobody else could be using.
       withConnection @m "push.dest" tempRemotePath $ \destConn -> do
-        runDBUnlifted @m destConn $ Q.withSavepoint_ @(ReaderT _ m) "push" $ do
+        flip runReaderT destConn $ Q.withSavepoint_ @(ReaderT _ m) "push" $ do
           throwExceptT $ doSync tempRemotePath srcConn destConn
     void $ push tempRemotePath repo
   where
@@ -1217,6 +1211,6 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
 copyCodebase :: MonadIO m => Connection -> CodebasePath -> m ()
 copyCodebase srcConn destPath = runDB srcConn $ do
   -- remove any existing codebase at the destination location.
-  removePathForcibly (makeCodebaseDir destPath)
-  createDirectoryIfMissing True (makeCodebaseDir destPath)
+  removePathForcibly (makeCodebaseDirPath destPath)
+  createDirectoryIfMissing True (makeCodebaseDirPath destPath)
   Q.vacuumInto (makeCodebasePath destPath)

From e3843dbed714003fa081124a86b7fad7159af0a5 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 21 Dec 2021 11:01:58 -0600
Subject: [PATCH 08/10] More simplification

---
 .../src/Unison/Codebase/SqliteCodebase.hs             | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 4e373457e..6b80a0ccd 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -1085,16 +1085,17 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
   --
   -- set up the cache dir
   pathToCachedRemote <- time "Git fetch" $ throwExceptTWith C.GitProtocolError $ pullRepo (writeToRead repo)
-  throwEitherMWith C.GitProtocolError . withIsolatedRepo pathToCachedRemote $ \tempRemotePath -> do
+  throwEitherMWith C.GitProtocolError . withIsolatedRepo pathToCachedRemote $ \isolatedRemotePath -> do
     -- Connect to codebase in the cached git repo so we can copy it over.
     withOpenOrCreateCodebaseConnection @m "push.cached" pathToCachedRemote $ \cachedRemoteConn -> do
-      copyCodebase cachedRemoteConn tempRemotePath
+      -- Copy our cached remote database cleanly into our isolated directory.
+      copyCodebase cachedRemoteConn isolatedRemotePath
       -- Connect to the newly copied database which we know has been properly closed and
       -- nobody else could be using.
-      withConnection @m "push.dest" tempRemotePath $ \destConn -> do
+      withConnection @m "push.dest" isolatedRemotePath $ \destConn -> do
         flip runReaderT destConn $ Q.withSavepoint_ @(ReaderT _ m) "push" $ do
-          throwExceptT $ doSync tempRemotePath srcConn destConn
-    void $ push tempRemotePath repo
+          throwExceptT $ doSync isolatedRemotePath srcConn destConn
+    void $ push isolatedRemotePath repo
   where
     doSync :: FilePath -> Connection -> Connection -> ExceptT C.GitError (ReaderT Connection m) ()
     doSync remotePath srcConn destConn = do

From 64f0a792e28457407470514ed9fe2bc9ab4a1762 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 4 Jan 2022 09:59:10 -0600
Subject: [PATCH 09/10] Clean up unused comments

---
 parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs | 3 ---
 1 file changed, 3 deletions(-)

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 6b80a0ccd..62b1defd0 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -1110,7 +1110,6 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
       case maybeOldRootHash of
         Nothing -> runDB destConn $ do
           setRepoRoot newRootHash
-          -- Q.release "push"
         (Just oldRootHash) -> runDB destConn $ do
           before oldRootHash newRootHash >>= \case
             Nothing ->
@@ -1122,11 +1121,9 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
                   ++ show remotePath
                   ++ "."
             Just False -> do
-              -- Q.rollbackRelease "push"
               lift . lift . throwError . C.GitProtocolError $ GitError.PushDestinationHasNewStuff repo
             Just True -> do
               setRepoRoot newRootHash
-              -- Q.release "push"
 
     repoString = Text.unpack $ printWriteRepo repo
     setRepoRoot :: forall m. Q.DB m => Branch.Hash -> m ()

From 6f29afe36b5f8b4233d4b5c7df582348b869bb01 Mon Sep 17 00:00:00 2001
From: Chris Penner <christopher.penner@gmail.com>
Date: Tue, 4 Jan 2022 16:53:17 -0600
Subject: [PATCH 10/10] Update
 parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs

Co-authored-by: Arya Irani <538571+aryairani@users.noreply.github.com>
---
 parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
index 62b1defd0..903225311 100644
--- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
+++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -1205,7 +1205,7 @@ pushGitBranch srcConn branch repo (PushGitBranchOpts setRoot _syncMode) = Unlift
             gitIn remotePath ["push", "--quiet", url]
             pure True
 
--- | Make a clean copy of the connected codebase into the provided path.
+-- | Make a clean copy of the connected codebase into the provided path. Destroys any existing `v2/` directory
 copyCodebase :: MonadIO m => Connection -> CodebasePath -> m ()
 copyCodebase srcConn destPath = runDB srcConn $ do
   -- remove any existing codebase at the destination location.