Add SyncV2 protocol

lib/unison-sqlite/package.yaml

@@ -9,6 +9,7 @@ library:
 
   dependencies:
     - base
+    - containers
     - direct-sqlite
     - megaparsec
     - pretty-simple

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

@@ -58,6 +58,7 @@ module Unison.Sqlite.Connection
   )
 where
 
+import Data.Map qualified as Map
 import Database.SQLite.Simple qualified as Sqlite
 import Database.SQLite.Simple.FromField qualified as Sqlite
 import Database.SQLite3 qualified as Direct.Sqlite
@@ -71,7 +72,10 @@ import Unison.Sqlite.Connection.Internal (Connection (..))
 import Unison.Sqlite.Exception
 import Unison.Sqlite.Sql (Sql (..))
 import Unison.Sqlite.Sql qualified as Sql
+import UnliftIO (atomically)
 import UnliftIO.Exception
+import UnliftIO.STM (readTVar)
+import UnliftIO.STM qualified as STM
 
 -- | Perform an action with a connection to a SQLite database.
 --
@@ -103,19 +107,47 @@ openConnection name file = do
       Just "" -> file
       _ -> "file:" <> file <> "?mode=ro"
   conn0 <- Sqlite.open sqliteURI `catch` rethrowAsSqliteConnectException name file
-  let conn = Connection {conn = conn0, file, name}
+  statementCache <- STM.newTVarIO Map.empty
+  let conn = Connection {conn = conn0, file, name, statementCache}
   execute conn [Sql.sql| PRAGMA foreign_keys = ON |]
   execute conn [Sql.sql| PRAGMA busy_timeout = 60000 |]
+  execute conn [Sql.sql| PRAGMA synchronous = normal |]
+  execute conn [Sql.sql| PRAGMA journal_size_limit = 6144000 |]
+  execute conn [Sql.sql| PRAGMA cache_size = -64000 |]
+  execute conn [Sql.sql| PRAGMA temp_store = 2 |]
+
   pure conn
 
 -- Close a connection opened with 'openConnection'.
 closeConnection :: Connection -> IO ()
-closeConnection (Connection _ _ conn) =
+closeConnection conn@(Connection {conn = conn0}) = do
   -- FIXME if this throws an exception, it won't be under `SomeSqliteException`
   -- Possible fixes:
   --   1. Add close exception to the hierarchy, e.g. `SqliteCloseException`
   --   2. Always ignore exceptions thrown by `close` (Mitchell prefers this one)
-  Sqlite.close conn
+  closeAllStatements conn
+  Sqlite.close conn0
+
+withStatement :: Connection -> Text -> (Sqlite.Statement -> IO a) -> IO a
+withStatement conn sql action = do
+  bracket (prepareStatement conn sql) Sqlite.reset action
+  where
+    prepareStatement :: Connection -> Text -> IO Sqlite.Statement
+    prepareStatement Connection {conn, statementCache} sql = do
+      cached <- atomically $ do
+        cache <- STM.readTVar statementCache
+        pure $ Map.lookup sql cache
+      case cached of
+        Just stmt -> pure stmt
+        Nothing -> do
+          stmt <- Sqlite.openStatement conn (coerce @Text @Sqlite.Query sql)
+          atomically $ STM.modifyTVar statementCache (Map.insert sql stmt)
+          pure stmt
+
+closeAllStatements :: Connection -> IO ()
+closeAllStatements Connection {statementCache} = do
+  cache <- atomically $ readTVar statementCache
+  for_ cache Sqlite.closeStatement
 
 -- An internal type, for making prettier debug logs
 
@@ -152,7 +184,7 @@ logQuery (Sql sql params) result =
 -- Without results
 
 execute :: (HasCallStack) => Connection -> Sql -> IO ()
-execute conn@(Connection _ _ conn0) sql@(Sql s params) = do
+execute conn sql@(Sql s params) = do
   logQuery sql Nothing
   doExecute `catch` \(exception :: Sqlite.SQLError) ->
     throwSqliteQueryException
@@ -163,16 +195,16 @@ execute conn@(Connection _ _ conn0) sql@(Sql s params) = do
         }
   where
     doExecute :: IO ()
-    doExecute =
-      Sqlite.withStatement conn0 (coerce s) \(Sqlite.Statement statement) -> do
-        bindParameters statement params
-        void (Direct.Sqlite.step statement)
+    doExecute = do
+      withStatement conn s \statement -> do
+        bindParameters (coerce statement) params
+        void (Direct.Sqlite.step $ coerce statement)
 
 -- | Execute one or more semicolon-delimited statements.
 --
 -- This function does not support parameters, and is mostly useful for executing DDL and migrations.
 executeStatements :: (HasCallStack) => Connection -> Text -> IO ()
-executeStatements conn@(Connection _ _ (Sqlite.Connection database _tempNameCounter)) sql = do
+executeStatements conn@(Connection {conn = Sqlite.Connection database _tempNameCounter}) sql = do
   logQuery (Sql sql []) Nothing
   Direct.Sqlite.exec database sql `catch` \(exception :: Sqlite.SQLError) ->
     throwSqliteQueryException
@@ -185,7 +217,7 @@ executeStatements conn@(Connection _ _ (Sqlite.Connection database _tempNameCoun
 -- With results, without checks
 
 queryStreamRow :: (HasCallStack, Sqlite.FromRow a) => Connection -> Sql -> (IO (Maybe a) -> IO r) -> IO r
-queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback =
+queryStreamRow conn sql@(Sql s params) callback =
   run `catch` \(exception :: Sqlite.SQLError) ->
     throwSqliteQueryException
       SqliteQueryExceptionInfo
@@ -194,8 +226,8 @@ queryStreamRow conn@(Connection _ _ conn0) sql@(Sql s params) callback =
           sql
         }
   where
-    run =
-      bracket (Sqlite.openStatement conn0 (coerce s)) Sqlite.closeStatement \statement -> do
+    run = do
+      withStatement conn s \statement -> do
         Sqlite.bind statement params
         callback (Sqlite.nextRow statement)
 
@@ -213,7 +245,7 @@ queryStreamCol =
     queryStreamRow
 
 queryListRow :: forall a. (Sqlite.FromRow a, HasCallStack) => Connection -> Sql -> IO [a]
-queryListRow conn@(Connection _ _ conn0) sql@(Sql s params) = do
+queryListRow conn sql@(Sql s params) = do
   result <-
     doQuery
       `catch` \(exception :: Sqlite.SQLError) ->
@@ -228,7 +260,7 @@ queryListRow conn@(Connection _ _ conn0) sql@(Sql s params) = do
   where
     doQuery :: IO [a]
     doQuery =
-      Sqlite.withStatement conn0 (coerce s) \statement -> do
+      withStatement conn (coerce s) \statement -> do
         bindParameters (coerce statement) params
         let loop :: [a] -> IO [a]
             loop rows =
@@ -347,7 +379,7 @@ queryOneColCheck conn s check =
 -- Rows modified
 
 rowsModified :: Connection -> IO Int
-rowsModified (Connection _ _ conn) =
+rowsModified (Connection {conn}) =
   Sqlite.changes conn
 
 -- Vacuum

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

@@ -3,15 +3,19 @@ module Unison.Sqlite.Connection.Internal
   )
 where
 
+import Data.Map (Map)
+import Data.Text (Text)
 import Database.SQLite.Simple qualified as Sqlite
+import UnliftIO.STM (TVar)
 
 -- | A /non-thread safe/ connection to a SQLite database.
 data Connection = Connection
   { name :: String,
     file :: FilePath,
-    conn :: Sqlite.Connection
+    conn :: Sqlite.Connection,
+    statementCache :: TVar (Map Text Sqlite.Statement)
   }
 
 instance Show Connection where
-  show (Connection name file _conn) =
+  show (Connection name file _conn _statementCache) =
     "Connection { name = " ++ show name ++ ", file = " ++ show file ++ " }"

lib/unison-sqlite/unison-sqlite.cabal

@@ -65,6 +65,7 @@ library
   ghc-options: -Wall
   build-depends:
       base
+    , containers
     , direct-sqlite
     , megaparsec
     , pretty-simple

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

@@ -4,19 +4,22 @@
 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
 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.Input (SyncVersion (..))
 import Unison.Codebase.Editor.Output qualified as Output
 import Unison.Codebase.Editor.RemoteRepo (ReadShareLooseCode, shareUserHandleToText)
 import Unison.Codebase.Editor.RemoteRepo qualified as RemoteRepo
@@ -28,37 +31,54 @@ 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
 
 -- | 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
+          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/Codebase/Editor/HandleInput.hs

@@ -667,7 +667,7 @@ loop e = do
               _ <- Cli.updateAtM description pp \destb ->
                 liftIO (Branch.merge'' (Codebase.lca codebase) Branch.RegularMerge srcb destb)
               Cli.respond Success
-            PullI sourceTarget pullMode -> handlePull sourceTarget pullMode
+            PullI syncVersion sourceTarget pullMode -> handlePull syncVersion sourceTarget pullMode
             PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput
             SyncToFileI syncFileDest projectBranchName -> SyncV2.handleSyncToFile syncFileDest projectBranchName
             SyncFromFileI syncFileSrc projectBranchName -> do

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 <-

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

@@ -13,7 +13,7 @@ import U.Codebase.Sqlite.Project (Project (..))
 import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..))
 import U.Codebase.Sqlite.Queries (expectCausalHashIdByCausalHash)
 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.Share.Projects qualified as Share
@@ -108,7 +108,7 @@ projectCreate tryDownloadingBase maybeProjectName = do
                 Share.GetProjectBranchResponseBranchNotFound -> done Nothing
                 Share.GetProjectBranchResponseProjectNotFound -> done Nothing
                 Share.GetProjectBranchResponseSuccess branch -> pure branch
-            downloadProjectBranchFromShare Share.NoSquashedHead baseLatestReleaseBranch
+            downloadProjectBranchFromShare SyncV1 Share.NoSquashedHead baseLatestReleaseBranch
               & onLeftM (Cli.returnEarly . Output.ShareError)
             Cli.Env {codebase} <- ask
             baseLatestReleaseBranchObject <-

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

@@ -46,8 +46,8 @@ import Unison.Prelude
 import Unison.Project (ProjectAndBranch (..), ProjectBranchNameOrLatestRelease (..), ProjectName)
 import Witch (unsafeFrom)
 
-handlePull :: PullSourceTarget -> PullMode -> Cli ()
-handlePull unresolvedSourceAndTarget pullMode = do
+handlePull :: SyncVersion -> PullSourceTarget -> PullMode -> Cli ()
+handlePull syncVersion unresolvedSourceAndTarget pullMode = do
   let includeSquashed = case pullMode of
         Input.PullWithHistory -> Share.NoSquashedHead
         Input.PullWithoutHistory -> Share.IncludeSquashedHead
@@ -59,6 +59,7 @@ handlePull unresolvedSourceAndTarget pullMode = do
       ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError)
       ReadShare'ProjectBranch remoteBranch ->
         downloadProjectBranchFromShare
+          syncVersion
           ( case pullMode of
               Input.PullWithHistory -> Share.NoSquashedHead
               Input.PullWithoutHistory -> Share.IncludeSquashedHead

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

@@ -2,16 +2,20 @@ module Unison.Codebase.Editor.HandleInput.SyncV2
   ( handleSyncToFile,
     handleSyncFromFile,
     handleSyncFromCodebase,
+    handleSyncFromCodeserver,
   )
 where
 
 import Control.Lens
 import Control.Monad.Reader (MonadReader (..))
+import U.Codebase.HashTags (CausalHash)
 import U.Codebase.Sqlite.Queries qualified as Q
+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
 import Unison.Cli.ProjectUtils qualified as Project
+import Unison.Cli.Share.Projects qualified as Projects
 import Unison.Codebase (CodebasePath)
 import Unison.Codebase qualified as Codebase
 import Unison.Codebase.Editor.Output qualified as Output
@@ -69,3 +73,6 @@ handleSyncFromCodebase description srcCodebasePath srcBranch destBranch = do
       Cli.setProjectBranchRootToCausalHash (projectBranch ^. #branch) description causalHash
     Right (Right (Left syncErr)) -> do
       Cli.respond (Output.SyncPullError syncErr)
+
+handleSyncFromCodeserver :: Projects.IncludeSquashedHead -> Projects.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash)
+handleSyncFromCodeserver = downloadProjectBranchFromShare SyncV2