From 0a7ef4fa3dda54dd0ecc53732b4d9271985db22d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 17 Jan 2025 10:35:59 -0800 Subject: [PATCH 01/25] PR cleanup --- unison-cli/package.yaml | 1 - .../src/Unison/Codebase/Editor/Input.hs | 3 +- .../src/Unison/CommandLine/InputPatterns.hs | 6 +- unison-cli/src/Unison/Share/SyncV2.hs | 231 +++++++++--------- unison-cli/unison-cli.cabal | 1 - unison-share-api/src/Unison/SyncV2/Types.hs | 10 +- 6 files changed, 119 insertions(+), 133 deletions(-) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index d3d48f2c8a..d81ba052f7 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -20,7 +20,6 @@ library: - condition: "!os(windows)" dependencies: unix dependencies: - - attoparsec - Diff - IntervalMap - ListLike diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index c496b5ba0d..e4015b64fe 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -128,7 +128,8 @@ data Input | PushRemoteBranchI PushRemoteBranchInput | SyncToFileI FilePath (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)) | SyncFromFileI FilePath UnresolvedProjectBranch - | SyncFromCodebaseI FilePath (ProjectAndBranch ProjectName ProjectBranchName) UnresolvedProjectBranch + | -- | Sync from a codebase project branch to this codebase's project branch + SyncFromCodebaseI FilePath (ProjectAndBranch ProjectName ProjectBranchName) UnresolvedProjectBranch | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) | -- | used in Welcome module to give directions to user -- diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 40a82c2241..0d0022da05 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2205,11 +2205,13 @@ syncFromCodebase = args = [("codebase-location", Required, filePathArg), ("branch-to-sync", Required, projectAndBranchNamesArg suggestionsConfig), ("destination-branch", Optional, projectAndBranchNamesArg suggestionsConfig)], help = ( P.wrapColumn2 - [ (makeExample syncFromCodebase ["./codebase", "/feature", "/main"], "Sets the /feature branch to the contents of the codebase at ./codebase.") + [ ( makeExample syncFromCodebase ["./codebase", "srcProject/main", "destProject/main"], + "Imports srcProject/main from the specified codebase, then sets destProject/main to the imported branch." + ) ] ), parse = \case - [codebaseLocation, branchToSync, destinationBranch] -> Input.SyncFromCodebaseI <$> unsupportedStructuredArgument makeStandalone "a file name" codebaseLocation <*> handleBranchWithProject branchToSync <*> handleBranchWithOptionalProject destinationBranch + [codebaseLocation, srcBranch, destinationBranch] -> Input.SyncFromCodebaseI <$> unsupportedStructuredArgument makeStandalone "a file name" codebaseLocation <*> handleBranchWithProject srcBranch <*> handleBranchWithOptionalProject destinationBranch args -> wrongArgsLength "three arguments" args } where diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index bbce0d95e6..bcfccd85c3 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -16,11 +16,8 @@ import Control.Monad.Except import Control.Monad.Reader (ask) import Control.Monad.ST (ST, stToIO) import Control.Monad.State -import Data.Attoparsec.ByteString qualified as A -import Data.Attoparsec.ByteString.Char8 qualified as A8 import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL -import Data.Conduit.Attoparsec qualified as C import Data.Conduit.List qualified as C import Data.Conduit.Zlib qualified as C import Data.Graph qualified as Graph @@ -36,7 +33,6 @@ import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase -import Unison.Debug qualified as Debug import Unison.Hash32 (Hash32) import Unison.Prelude import Unison.Share.ExpectedHashMismatches (expectedCausalHashMismatches, expectedComponentHashMismatches) @@ -57,20 +53,76 @@ type Stream i o = ConduitT i o StreamM () type SyncErr = SyncError SyncV2.PullError +-- The base monad we use within the conduit pipeline. type StreamM = (ExceptT SyncErr (C.ResourceT IO)) +-- | The number of entities to process in a single transaction. +-- +-- SQLite transactions have some fixed overhead, so setting this too low can really slow things down, +-- but going too high here means we may be waiting on the network to get a full batch when we could be starting work. batchSize :: Int batchSize = 5000 ------------------------------------------------------------------------------------------------------------------------ --- Download entities +-- Main methods +------------------------------------------------------------------------------------------------------------------------ + +-- | Sync a given causal hash and its dependencies to a sync-file. +syncToFile :: + Codebase.Codebase IO v a -> + CausalHash -> + Maybe SyncV2.BranchRef -> + FilePath -> + IO (Either SyncErr ()) +syncToFile codebase rootHash mayBranchRef destFilePath = do + liftIO $ Codebase.withConnection codebase \conn -> do + C.runResourceT $ + withCodebaseEntityStream conn rootHash mayBranchRef \mayTotal stream -> do + withStreamProgressCallback (Just mayTotal) \countC -> runExceptT do + C.runConduit $ stream C..| countC C..| C.map (BL.toStrict . CBOR.serialise) C..| C.transPipe liftIO C.gzip C..| C.sinkFile destFilePath +syncFromFile :: + Bool -> + -- | Location of the sync-file + FilePath -> + Cli (Either (SyncError SyncV2.PullError) CausalHash) +syncFromFile shouldValidate syncFilePath = do + Cli.Env {codebase} <- ask + runExceptT do + mapExceptT liftIO $ Timing.time "File Sync" $ do + header <- mapExceptT C.runResourceT $ do + let stream = C.sourceFile syncFilePath C..| C.ungzip C..| decodeUnframedEntities + (header, rest) <- initializeStream stream + streamIntoCodebase shouldValidate codebase header rest + pure header + afterSyncChecks codebase (SyncV2.rootCausalHash header) + pure . hash32ToCausalHash $ SyncV2.rootCausalHash header + +syncFromCodebase :: + Bool -> + -- | The codebase to sync from. + Sqlite.Connection -> + (Codebase.Codebase IO v a) -> + -- | The hash to sync. + CausalHash -> + IO (Either (SyncError SyncV2.PullError) ()) +syncFromCodebase shouldValidate srcConn destCodebase causalHash = do + liftIO . C.runResourceT . runExceptT $ withCodebaseEntityStream srcConn causalHash Nothing \_total entityStream -> do + (header, rest) <- initializeStream entityStream + streamIntoCodebase shouldValidate destCodebase header rest + mapExceptT liftIO (afterSyncChecks destCodebase (causalHashToHash32 causalHash)) + +------------------------------------------------------------------------------------------------------------------------ +-- Helpers +------------------------------------------------------------------------------------------------------------------------ + +-- | Validate that the provided entities match their expected hashes, and if so, save them to the codebase. validateAndSave :: Bool -> (Codebase.Codebase IO v a) -> [(Hash32, TempEntity)] -> StreamM () validateAndSave shouldValidate codebase entities = do let validateEntities = runExceptT $ when shouldValidate (batchValidateEntities entities) - -- Validation is slow, run it in parallel with insertion, but don't commit the transaction until we're done - -- validation. + -- Validation is slow, so we run it in parallel with insertion (which can also be slow), + -- but we don't commit the transaction until we're done validation to avoid inserting invalid entities. ExceptT . liftIO $ IO.withAsync validateEntities \validationTask -> do Timing.time "Inserting entities" $ Codebase.runTransactionExceptT codebase do for_ entities \(hash, entity) -> do @@ -78,6 +130,25 @@ validateAndSave shouldValidate codebase entities = do lift (Sqlite.unsafeIO (IO.wait validationTask)) >>= \case Left err -> throwError err Right _ -> pure () + where + batchValidateEntities :: [(Hash32, TempEntity)] -> ExceptT SyncErr IO () + batchValidateEntities entities = do + mismatches <- fmap catMaybes $ liftIO $ IO.pooledForConcurrently entities \(hash, entity) -> do + IO.evaluate $ EV.validateTempEntity hash entity + for_ mismatches \case + err@(Share.EntityHashMismatch et (Share.HashMismatchForEntity {supplied, computed})) -> + let expectedMismatches = case et of + Share.TermComponentType -> expectedComponentHashMismatches + Share.DeclComponentType -> expectedComponentHashMismatches + Share.CausalType -> expectedCausalHashMismatches + _ -> mempty + in case Map.lookup supplied expectedMismatches of + Just expected + | expected == computed -> pure () + _ -> do + throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err + err -> do + throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err -- | Syncs a stream which could send entities in any order. syncUnsortedStream :: @@ -86,7 +157,6 @@ syncUnsortedStream :: Stream () SyncV2.EntityChunk -> StreamM () syncUnsortedStream shouldValidate codebase stream = do - Debug.debugLogM Debug.Temp $ "Syncing unsorted stream" allResults <- C.runConduit $ stream C..| C.sinkList allEntities <- ExceptT $ Timing.time "Unpacking chunks" $ liftIO $ Codebase.runTransactionExceptT codebase $ do unpackChunks allResults let sortedEntities = sortDependencyFirst allEntities @@ -99,13 +169,20 @@ syncSortedStream :: Stream () SyncV2.EntityChunk -> StreamM () syncSortedStream shouldValidate codebase stream = do - Debug.debugLogM Debug.Temp $ "Syncing sorted stream" let handler :: Stream [SyncV2.EntityChunk] o handler = C.mapM_C \chunkBatch -> do - entityBatch <- mapExceptT lift . ExceptT $ Codebase.runTransactionExceptT codebase do for chunkBatch unpackChunk - validateAndSave shouldValidate codebase (catMaybes entityBatch) + entityBatch <- mapExceptT lift . ExceptT $ Codebase.runTransactionExceptT codebase do unpackChunks chunkBatch + validateAndSave shouldValidate codebase entityBatch C.runConduit $ stream C..| C.chunksOf batchSize C..| handler +-- | Topologically sort entities based on their dependencies. +sortDependencyFirst :: [(Hash32, TempEntity)] -> [(Hash32, TempEntity)] +sortDependencyFirst entities = do + let adjList = entities <&> \(hash32, entity) -> ((hash32, entity), hash32, Set.toList $ Share.entityDependencies (tempEntityToEntity entity)) + (graph, vertexInfo, _vertexForKey) = Graph.graphFromEdges adjList + in Graph.reverseTopSort graph <&> \v -> (view _1 $ vertexInfo v) + +-- | Unpack a single entity chunk, returning the entity if it's not already in the codebase, Nothing otherwise. unpackChunk :: SyncV2.EntityChunk -> ExceptT SyncErr Sqlite.Transaction (Maybe (Hash32, TempEntity)) unpackChunk = \case SyncV2.EntityChunk {hash, entityCBOR = entityBytes} -> do @@ -126,25 +203,6 @@ unpackChunks xs = do for xs unpackChunk <&> catMaybes -batchValidateEntities :: [(Hash32, TempEntity)] -> ExceptT SyncErr IO () -batchValidateEntities entities = do - mismatches <- fmap catMaybes $ liftIO $ IO.pooledForConcurrently entities \(hash, entity) -> do - IO.evaluate $ EV.validateTempEntity hash entity - for_ mismatches \case - err@(Share.EntityHashMismatch et (Share.HashMismatchForEntity {supplied, computed})) -> - let expectedMismatches = case et of - Share.TermComponentType -> expectedComponentHashMismatches - Share.DeclComponentType -> expectedComponentHashMismatches - Share.CausalType -> expectedCausalHashMismatches - _ -> mempty - in case Map.lookup supplied expectedMismatches of - Just expected - | expected == computed -> pure () - _ -> do - throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err - err -> do - throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err - streamIntoCodebase :: Bool -> Codebase.Codebase IO v a -> SyncV2.StreamInitInfo -> Stream () SyncV2.EntityChunk -> StreamM () streamIntoCodebase shouldValidate codebase SyncV2.StreamInitInfo {version, entitySorting, numEntities = numEntities} stream = ExceptT do withStreamProgressCallback (fromIntegral <$> numEntities) \countC -> runExceptT do @@ -157,6 +215,7 @@ streamIntoCodebase shouldValidate codebase SyncV2.StreamInitInfo {version, entit SyncV2.DependenciesFirst -> syncSortedStream shouldValidate codebase stream' SyncV2.Unsorted -> syncUnsortedStream shouldValidate codebase stream' +-- | Verify that the hash we expected to import from the stream was successfully loaded into the codebase. afterSyncChecks :: Codebase.Codebase IO v a -> Hash32 -> ExceptT (SyncError SyncV2.PullError) IO () afterSyncChecks codebase hash = do lift (didCausalSuccessfullyImport codebase hash) >>= \case @@ -171,53 +230,15 @@ afterSyncChecks codebase hash = do let expectedHash = hash32ToCausalHash hash isJust <$> (Codebase.runTransaction codebase $ Q.loadCausalByCausalHash expectedHash) --- | Topologically sort entities based on their dependencies. -sortDependencyFirst :: [(Hash32, TempEntity)] -> [(Hash32, TempEntity)] -sortDependencyFirst entities = do - let adjList = entities <&> \(hash32, entity) -> ((hash32, entity), hash32, Set.toList $ Share.entityDependencies (tempEntityToEntity entity)) - (graph, vertexInfo, _vertexForKey) = Graph.graphFromEdges adjList - in Graph.reverseTopSort graph <&> \v -> (view _1 $ vertexInfo v) - -syncFromFile :: - Bool -> - -- | Location of the sync-file - FilePath -> - Cli (Either (SyncError SyncV2.PullError) CausalHash) -syncFromFile shouldValidate syncFilePath = do - Cli.Env {codebase} <- ask - runExceptT do - Debug.debugLogM Debug.Temp $ "Kicking off sync" - mapExceptT liftIO $ Timing.time "File Sync" $ do - header <- mapExceptT C.runResourceT $ do - let stream = C.sourceFile syncFilePath C..| C.ungzip C..| decodeUnframedEntities - (header, rest) <- initializeStream stream - streamIntoCodebase shouldValidate codebase header rest - pure header - afterSyncChecks codebase (SyncV2.rootCausalHash header) - pure . hash32ToCausalHash $ SyncV2.rootCausalHash header - -syncFromCodebase :: - Bool -> - -- | The codebase to sync from. - Sqlite.Connection -> - (Codebase.Codebase IO v a) -> - -- | The hash to sync. - CausalHash -> - IO (Either (SyncError SyncV2.PullError) ()) -syncFromCodebase shouldValidate srcConn destCodebase causalHash = do - liftIO . C.runResourceT . runExceptT $ withEntityStream srcConn causalHash Nothing \_total entityStream -> do - (header, rest) <- initializeStream entityStream - streamIntoCodebase shouldValidate destCodebase header rest - mapExceptT liftIO (afterSyncChecks destCodebase (causalHashToHash32 causalHash)) - -withEntityStream :: +-- | Load and stream entities for a given causal hash from a codebase. +withCodebaseEntityStream :: (MonadIO m) => Sqlite.Connection -> CausalHash -> Maybe SyncV2.BranchRef -> (Int -> Stream () SyncV2.DownloadEntitiesChunk -> m r) -> m r -withEntityStream conn rootHash mayBranchRef callback = do +withCodebaseEntityStream conn rootHash mayBranchRef callback = do entities <- liftIO $ withEntityLoadingCallback $ \counter -> do Sqlite.runTransaction conn (depsForCausal rootHash counter) liftIO $ Text.hPutStrLn IO.stderr $ "Finished loading entities, writing sync-file." @@ -244,54 +265,24 @@ withEntityStream conn rootHash mayBranchRef callback = do & (initialChunk :) let stream = C.yieldMany contents callback totalEntities stream - -syncToFile :: - Codebase.Codebase IO v a -> - CausalHash -> - Maybe SyncV2.BranchRef -> - FilePath -> - IO (Either SyncErr ()) -syncToFile codebase rootHash mayBranchRef destFilePath = do - liftIO $ Codebase.withConnection codebase \conn -> do - C.runResourceT $ - withEntityStream conn rootHash mayBranchRef \mayTotal stream -> do - withStreamProgressCallback (Just mayTotal) \countC -> runExceptT do - C.runConduit $ stream C..| countC C..| C.map (BL.toStrict . CBOR.serialise) C..| C.transPipe liftIO C.gzip C..| C.sinkFile destFilePath - --- | Collect all dependencies of a given causal hash. -depsForCausal :: CausalHash -> (Int -> IO ()) -> Sqlite.Transaction (Map Hash32 (Sync.Entity Text Hash32 Hash32)) -depsForCausal causalHash counter = do - flip execStateT mempty $ expandEntities (causalHashToHash32 causalHash) where - expandEntities :: Hash32 -> ((StateT (Map Hash32 (Sync.Entity Text Hash32 Hash32)) Sqlite.Transaction)) () - expandEntities hash32 = do - gets (Map.member hash32) >>= \case - True -> pure () - False -> do - entity <- lift $ Sync.expectEntity hash32 - modify (Map.insert hash32 entity) - lift . Sqlite.unsafeIO $ counter 1 - traverseOf_ Sync.entityHashes_ expandEntities entity - --- | Gets the framed chunks from a NetString framed stream. -_unNetString :: ConduitT ByteString ByteString StreamM () -_unNetString = do - bs <- C.sinkParser $ do - len <- A8.decimal - _ <- A8.char ':' - bs <- A.take len - _ <- A8.char ',' - pure bs - C.yield bs - -_decodeFramedEntity :: ByteString -> StreamM SyncV2.DownloadEntitiesChunk -_decodeFramedEntity bs = do - case CBOR.deserialiseOrFail (BL.fromStrict bs) of - Left err -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorDeserializationFailure err - Right chunk -> pure chunk + -- Collect all dependencies of a given causal hash. + depsForCausal :: CausalHash -> (Int -> IO ()) -> Sqlite.Transaction (Map Hash32 (Sync.Entity Text Hash32 Hash32)) + depsForCausal causalHash counter = do + flip execStateT mempty $ expandEntities (causalHashToHash32 causalHash) + where + expandEntities :: Hash32 -> ((StateT (Map Hash32 (Sync.Entity Text Hash32 Hash32)) Sqlite.Transaction)) () + expandEntities hash32 = do + gets (Map.member hash32) >>= \case + True -> pure () + False -> do + entity <- lift $ Sync.expectEntity hash32 + modify (Map.insert hash32 entity) + lift . Sqlite.unsafeIO $ counter 1 + traverseOf_ Sync.entityHashes_ expandEntities entity -- Expects a stream of tightly-packed CBOR entities without any framing/separators. -decodeUnframedEntities :: ConduitT ByteString SyncV2.DownloadEntitiesChunk StreamM () +decodeUnframedEntities :: Stream ByteString SyncV2.DownloadEntitiesChunk decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do C.await >>= \case Nothing -> pure () @@ -338,11 +329,10 @@ decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do k <- newDecoder loop rem k --- | Peel the header off the stream and parse the remaining entity chunks. +-- | Peel the header off the stream and parse the remaining entity chunks into EntityChunks initializeStream :: Stream () SyncV2.DownloadEntitiesChunk -> StreamM (SyncV2.StreamInitInfo, Stream () SyncV2.EntityChunk) initializeStream stream = do (streamRemainder, init) <- stream C.$$+ C.headC - Debug.debugM Debug.Temp "Got initial chunk: " init case init of Nothing -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorMissingInitialChunk Just chunk -> do @@ -351,7 +341,6 @@ initializeStream stream = do let entityStream = C.unsealConduitT streamRemainder C..| C.mapM parseEntity pure $ (info, entityStream) SyncV2.EntityC _ -> do - Debug.debugLogM Debug.Temp $ "Got unexpected entity chunk" throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorMissingInitialChunk SyncV2.ErrorC (SyncV2.ErrorChunk err) -> throwError . SyncError . SyncV2.PullError'DownloadEntities $ err where @@ -361,6 +350,10 @@ initializeStream stream = do SyncV2.ErrorC (SyncV2.ErrorChunk err) -> throwError . SyncError $ SyncV2.PullError'DownloadEntities err SyncV2.InitialC {} -> throwError . SyncError $ SyncV2.PullError'Sync SyncV2.SyncErrorMisplacedInitialChunk +------------------------------------------------------------------------------------------------------------------------ +-- Progress Tracking +------------------------------------------------------------------------------------------------------------------------ + -- Provide the given action a callback that display to the terminal. withStreamProgressCallback :: (MonadIO m, MonadUnliftIO n) => Maybe Int -> (ConduitT i i m () -> n a) -> n a withStreamProgressCallback total action = do diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index f128d6ff8d..e1f51a7633 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -200,7 +200,6 @@ library , aeson-pretty , ansi-terminal , async - , attoparsec , base , bytestring , cmark diff --git a/unison-share-api/src/Unison/SyncV2/Types.hs b/unison-share-api/src/Unison/SyncV2/Types.hs index 2f4432ee74..80272de8ab 100644 --- a/unison-share-api/src/Unison/SyncV2/Types.hs +++ b/unison-share-api/src/Unison/SyncV2/Types.hs @@ -32,7 +32,6 @@ import Data.Word (Word16, Word64) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.TempEntity (TempEntity) import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) -import Unison.Debug qualified as Debug import Unison.Hash32 (Hash32) import Unison.Prelude (From (..)) import Unison.Server.Orphans () @@ -186,7 +185,7 @@ optionalDecodeMapKey k m = Nothing -> pure Nothing Just bs -> Just <$> decodeUnknownCBORBytes bs --- | Serialised as a map to allow for future expansion +-- | Serialised as a map to be future compatible, allowing for future expansion. instance Serialise StreamInitInfo where encode (StreamInitInfo {version, entitySorting, numEntities, rootCausalHash, rootBranchRef}) = CBOR.encode @@ -199,18 +198,11 @@ instance Serialise StreamInitInfo where <> maybe [] (\br -> [("br", serialiseUnknownCBORBytes br)]) rootBranchRef ) decode = do - Debug.debugLogM Debug.Temp "Decoding StreamInitInfo" - Debug.debugLogM Debug.Temp "Decoding Map" m <- CBOR.decode - Debug.debugLogM Debug.Temp "Decoding Version" version <- decodeMapKey "v" m - Debug.debugLogM Debug.Temp "Decoding Entity Sorting" entitySorting <- decodeMapKey "es" m - Debug.debugLogM Debug.Temp "Decoding Number of Entities" numEntities <- (optionalDecodeMapKey "ne" m) - Debug.debugLogM Debug.Temp "Decoding Root Causal Hash" rootCausalHash <- decodeMapKey "rc" m - Debug.debugLogM Debug.Temp "Decoding Branch Ref" rootBranchRef <- optionalDecodeMapKey "br" m pure StreamInitInfo {version, entitySorting, numEntities, rootCausalHash, rootBranchRef} From 1df99747c0c9997603755b07803b8ec81cea4ce1 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 14 Jan 2025 15:43:02 -0800 Subject: [PATCH 02/25] SyncV2 with Share server --- .../U/Codebase/Sqlite/Queries.hs | 92 +++++++++++------- .../sql/001-temp-entity-tables.sql | 3 +- lib/unison-sqlite/package.yaml | 1 + .../src/Unison/Sqlite/Connection.hs | 62 +++++++++--- .../src/Unison/Sqlite/Connection/Internal.hs | 8 +- lib/unison-sqlite/unison-sqlite.cabal | 3 +- unison-cli/src/Unison/Cli/DownloadUtils.hs | 46 ++++++--- .../Codebase/Editor/HandleInput/InstallLib.hs | 2 +- .../Editor/HandleInput/ProjectClone.hs | 4 +- .../Editor/HandleInput/ProjectCreate.hs | 4 +- .../Codebase/Editor/HandleInput/Pull.hs | 1 + .../Codebase/Editor/HandleInput/SyncV2.hs | 30 ++++++ unison-cli/src/Unison/Share/Sync/Util.hs | 42 ++++++++ unison-cli/src/Unison/Share/SyncV2.hs | 95 +++++++++++++++++++ unison-cli/unison-cli.cabal | 1 + unison-share-api/src/Unison/SyncV2/API.hs | 29 ++++++ unison-share-api/unison-share-api.cabal | 1 + 17 files changed, 356 insertions(+), 68 deletions(-) create mode 100644 unison-cli/src/Unison/Share/Sync/Util.hs create mode 100644 unison-share-api/src/Unison/SyncV2/API.hs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 033efb8655..936dd91cdf 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -228,6 +228,7 @@ module U.Codebase.Sqlite.Queries expectEntity, syncToTempEntity, insertTempEntity, + insertTempEntityV2, saveTempEntityInMain, expectTempEntity, deleteTempEntity, @@ -315,6 +316,7 @@ import Data.Map.NonEmpty qualified as NEMap import Data.Maybe qualified as Maybe import Data.Sequence qualified as Seq import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as Text.Lazy @@ -532,23 +534,18 @@ countWatches = queryOneCol [sql| SELECT COUNT(*) FROM watch |] saveHash :: Hash32 -> Transaction HashId saveHash hash = do - execute - [sql| - INSERT INTO hash (base32) VALUES (:hash) - ON CONFLICT DO NOTHING - |] - expectHashId hash + loadHashId hash >>= \case + Just h -> pure h + Nothing -> do + queryOneCol + [sql| + INSERT INTO hash (base32) VALUES (:hash) + RETURNING id + |] saveHashes :: Traversable f => f Hash32 -> Transaction (f HashId) saveHashes hashes = do - for_ hashes \hash -> - execute - [sql| - INSERT INTO hash (base32) - VALUES (:hash) - ON CONFLICT DO NOTHING - |] - traverse expectHashId hashes + for hashes saveHash saveHashHash :: Hash -> Transaction HashId saveHashHash = saveHash . Hash32.fromHash @@ -623,13 +620,15 @@ expectBranchHashForCausalHash ch = do saveText :: Text -> Transaction TextId saveText t = do - execute - [sql| - INSERT INTO text (text) - VALUES (:t) - ON CONFLICT DO NOTHING - |] - expectTextId t + loadTextId t >>= \case + Just h -> pure h + Nothing -> do + queryOneCol + [sql| + INSERT INTO text (text) + VALUES (:t) + RETURNING id + |] saveTexts :: Traversable f => f Text -> Transaction (f TextId) saveTexts = @@ -686,7 +685,7 @@ saveObject :: ObjectType -> ByteString -> Transaction ObjectId -saveObject hh h t blob = do +saveObject _hh h t blob = do execute [sql| INSERT INTO object (primary_hash_id, type_id, bytes) @@ -697,9 +696,9 @@ saveObject hh h t blob = do saveHashObject h oId 2 -- todo: remove this from here, and add it to other relevant places once there are v1 and v2 hashes rowsModified >>= \case 0 -> pure () - _ -> do - hash <- expectHash32 h - tryMoveTempEntityDependents hh hash + _ -> pure () + -- hash <- expectHash32 h + -- tryMoveTempEntityDependents hh hash pure oId expectObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a @@ -957,7 +956,7 @@ saveCausal :: BranchHashId -> [CausalHashId] -> Transaction () -saveCausal hh self value parents = do +saveCausal _hh self value parents = do execute [sql| INSERT INTO causal (self_hash_id, value_hash_id) @@ -973,15 +972,15 @@ saveCausal hh self value parents = do INSERT INTO causal_parent (causal_id, parent_id) VALUES (:self, :parent) |] - flushCausalDependents hh self + -- flushCausalDependents hh self -flushCausalDependents :: +_flushCausalDependents :: HashHandle -> CausalHashId -> Transaction () -flushCausalDependents hh chId = do +_flushCausalDependents hh chId = do hash <- expectHash32 (unCausalHashId chId) - tryMoveTempEntityDependents hh hash + _tryMoveTempEntityDependents hh hash -- | `tryMoveTempEntityDependents #foo` does this: -- 0. Precondition: We just inserted object #foo. @@ -989,11 +988,11 @@ flushCausalDependents hh chId = do -- 2. Delete #foo as dependency from temp_entity_missing_dependency. e.g. (#bar, #foo), (#baz, #foo) -- 3. For each like #bar and #baz with no more rows in temp_entity_missing_dependency, -- insert_entity them. -tryMoveTempEntityDependents :: +_tryMoveTempEntityDependents :: HashHandle -> Hash32 -> Transaction () -tryMoveTempEntityDependents hh dependency = do +_tryMoveTempEntityDependents hh dependency = do dependents <- queryListCol [sql| @@ -2993,6 +2992,35 @@ insertTempEntity entityHash entity missingDependencies = do entityType = Entity.entityType entity +-- | Insert a new `temp_entity` row, and its associated 1+ `temp_entity_missing_dependency` rows. +-- +-- Preconditions: +-- 1. The entity does not already exist in "main" storage (`object` / `causal`) +-- 2. The entity does not already exist in `temp_entity`. +insertTempEntityV2 :: Hash32 -> TempEntity -> NESet Hash32 -> Transaction () +insertTempEntityV2 entityHash entity missingDependencies = do + execute + [sql| + INSERT INTO temp_entity (hash, blob, type_id) + VALUES (:entityHash, :entityBlob, :entityType) + ON CONFLICT DO NOTHING + |] + + for_ missingDependencies \depHash -> + execute + [sql| + INSERT INTO temp_entity_missing_dependency (dependent, dependency) + VALUES (:entityHash, :depHash) + |] + where + entityBlob :: ByteString + entityBlob = + runPutS (Serialization.putTempEntity entity) + + entityType :: TempEntityType + entityType = + Entity.entityType entity + -- | Delete a row from the `temp_entity` table, if it exists. deleteTempEntity :: Hash32 -> Transaction () deleteTempEntity hash = diff --git a/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql b/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql index 0ae13812b1..6651d4a6fe 100644 --- a/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql +++ b/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql @@ -56,7 +56,8 @@ create table if not exists temp_entity ( create table if not exists temp_entity_missing_dependency ( dependent text not null references temp_entity(hash), dependency text not null, - dependencyJwt text not null, + -- TODO: this is just for testing + dependencyJwt text null, unique (dependent, dependency) ); create index if not exists temp_entity_missing_dependency_ix_dependent on temp_entity_missing_dependency (dependent); diff --git a/lib/unison-sqlite/package.yaml b/lib/unison-sqlite/package.yaml index 84d0201eab..b90bd2aa57 100644 --- a/lib/unison-sqlite/package.yaml +++ b/lib/unison-sqlite/package.yaml @@ -9,6 +9,7 @@ library: dependencies: - base + - containers - direct-sqlite - megaparsec - pretty-simple diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs index 48167980db..726cac860e 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection.hs +++ b/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 diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Connection/Internal.hs b/lib/unison-sqlite/src/Unison/Sqlite/Connection/Internal.hs index 5f80151f94..579c37cfb9 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Connection/Internal.hs +++ b/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 ++ " }" diff --git a/lib/unison-sqlite/unison-sqlite.cabal b/lib/unison-sqlite/unison-sqlite.cabal index 28ea0f7c4f..329a05c5d8 100644 --- a/lib/unison-sqlite/unison-sqlite.cabal +++ b/lib/unison-sqlite/unison-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 @@ -64,6 +64,7 @@ library ghc-options: -Wall build-depends: base + , containers , direct-sqlite , megaparsec , pretty-simple diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 343ebfeeb5..fb53a84176 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/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,20 +30,24 @@ 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 @@ -49,16 +55,32 @@ downloadProjectBranchFromShare useSquashed branch = (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. diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 52e70188c8..299f30ba47 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/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) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 8a872d18b8..670a730b5e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/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 <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index e9f6e99e95..0096a91d8d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/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 <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 3ff7012220..42aebf0299 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs @@ -59,6 +59,7 @@ handlePull unresolvedSourceAndTarget pullMode = do ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError) ReadShare'ProjectBranch remoteBranch -> downloadProjectBranchFromShare + SyncV1 ( case pullMode of Input.PullWithHistory -> Share.NoSquashedHead Input.PullWithoutHistory -> Share.IncludeSquashedHead diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs index f34a64302a..3e3c7ba5ec 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs @@ -2,6 +2,7 @@ module Unison.Codebase.Editor.HandleInput.SyncV2 ( handleSyncToFile, handleSyncFromFile, handleSyncFromCodebase, + handleSyncFromCodeserver, ) where @@ -21,6 +22,7 @@ import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Share.SyncV2 qualified as SyncV2 import Unison.SyncV2.Types (BranchRef) +import Unison.Cli.DownloadUtils (SyncVersion, downloadProjectBranchFromShare) handleSyncToFile :: FilePath -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli () handleSyncToFile destSyncFile branchToSync = do @@ -69,3 +71,31 @@ handleSyncFromCodebase description srcCodebasePath srcBranch destBranch = do Cli.setProjectBranchRootToCausalHash (projectBranch ^. #branch) description causalHash Right (Right (Left syncErr)) -> do Cli.respond (Output.SyncPullError syncErr) + +handleSyncFromCodebase :: Text -> CodebasePath -> ProjectAndBranch ProjectName ProjectBranchName -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () +handleSyncFromCodebase description srcCodebasePath srcBranch destBranch = do + Cli.Env {codebase} <- ask + pp <- Cli.getCurrentProjectPath + projectBranch <- Project.resolveProjectBranchInProject (pp ^. #project) (over #branch Just destBranch) + r <- liftIO $ Init.withOpenCodebase SqliteCodebase.init "sync-src" srcCodebasePath Init.DontLock (Init.MigrateAfterPrompt Init.Backup Init.Vacuum) \srcCodebase -> do + Codebase.withConnection srcCodebase \srcConn -> do + maySrcCausalHash <- Codebase.runTransaction srcCodebase $ do + let ProjectAndBranch srcProjName srcBranchName = srcBranch + runMaybeT do + project <- MaybeT (Q.loadProjectByName srcProjName) + branch <- MaybeT (Q.loadProjectBranchByName (project ^. #projectId) srcBranchName) + lift $ Project.getProjectBranchCausalHash branch + case maySrcCausalHash of + Nothing -> pure $ Left (error "Todo proper error") + Just srcCausalHash -> do + let shouldValidate = True + fmap (const srcCausalHash) <$> liftIO (SyncV2.syncFromCodebase shouldValidate srcConn codebase srcCausalHash) + + case r of + Left _err -> pure $ error "Todo proper error" + Right (Left syncErr) -> Cli.respond (Output.SyncPullError syncErr) + Right (Right causalHash) -> do + Cli.setProjectBranchRootToCausalHash (projectBranch ^. #branch) description causalHash + +handleSyncFromCodeserver :: SyncVersion -> Projects.IncludeSquashedHead -> Projects.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) +handleSyncFromCodeserver = downloadProjectBranchFromShare diff --git a/unison-cli/src/Unison/Share/Sync/Util.hs b/unison-cli/src/Unison/Share/Sync/Util.hs new file mode 100644 index 0000000000..39eeb2cede --- /dev/null +++ b/unison-cli/src/Unison/Share/Sync/Util.hs @@ -0,0 +1,42 @@ +module Unison.Share.Sync.Util + ( BailT (..), + MonadBail (..), + runBailT, + mapBailT, + withError, + ) +where + +import Control.Monad.Reader (MonadReader (..), ReaderT (..), mapReaderT, withReaderT) +import Data.Data (Typeable) +import UnliftIO qualified as IO + +newtype Handler e = Handler {runHandler :: forall x. e -> IO x} + +newtype BailT e m a = BailT {unErrGroupT :: ReaderT (Handler e) m a} + deriving newtype (Functor, Applicative, Monad, IO.MonadUnliftIO, IO.MonadIO) + +newtype ExceptionWrapper e = ExceptionWrapper {unException :: e} + +instance Show (ExceptionWrapper e) where + show (ExceptionWrapper _) = "ExceptionWrapper<>" + +instance (Typeable e) => IO.Exception (ExceptionWrapper e) + +class MonadBail e m where + bail :: e -> m a + +mapBailT :: (Monad n) => (m a -> n b) -> BailT e m a -> BailT e n b +mapBailT f (BailT m) = BailT $ mapReaderT f $ m + +withError :: (Monad m) => (e' -> e) -> BailT e' m a -> BailT e m a +withError f (BailT m) = BailT $ withReaderT (\h -> Handler $ runHandler h . f) m + +instance (IO.MonadUnliftIO m, Typeable e) => MonadBail e (BailT e m) where + bail e = do + handler <- BailT ask + BailT $ IO.liftIO $ runHandler handler e + +runBailT :: (IO.MonadUnliftIO m, Typeable e) => BailT e m a -> (e -> m a) -> m a +runBailT (BailT m) handler = do + IO.handle (handler . unException) $ runReaderT m (Handler (IO.throwIO . ExceptionWrapper)) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index bcfccd85c3..dd90bdac75 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -48,6 +48,12 @@ import Unison.SyncV2.Types qualified as SyncV2 import Unison.Util.Servant.CBOR qualified as CBOR import Unison.Util.Timing qualified as Timing import UnliftIO qualified as IO +import Unison.SyncV2.API (Routes (downloadEntitiesStream)) +import Unison.SyncV2.API qualified as SyncV2 +import Data.Attoparsec.ByteString qualified as A +import Data.Attoparsec.ByteString.Char8 qualified as A8 +import Data.Conduit.Attoparsec qualified as C + type Stream i o = ConduitT i o StreamM () @@ -281,6 +287,23 @@ withCodebaseEntityStream conn rootHash mayBranchRef callback = do lift . Sqlite.unsafeIO $ counter 1 traverseOf_ Sync.entityHashes_ expandEntities entity +-- | Gets the framed chunks from a NetString framed stream. +_unNetString :: ConduitT ByteString ByteString StreamM () +_unNetString = do + bs <- C.sinkParser $ do + len <- A8.decimal + _ <- A8.char ':' + bs <- A.take len + _ <- A8.char ',' + pure bs + C.yield bs + +_decodeFramedEntity :: ByteString -> StreamM SyncV2.DownloadEntitiesChunk +_decodeFramedEntity bs = do + case CBOR.deserialiseOrFail (BL.fromStrict bs) of + Left err -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorDeserializationFailure err + Right chunk -> pure chunk + -- Expects a stream of tightly-packed CBOR entities without any framing/separators. decodeUnframedEntities :: Stream ByteString SyncV2.DownloadEntitiesChunk decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do @@ -329,6 +352,78 @@ decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do k <- newDecoder loop rem k +------------------------------------------------------------------------------------------------------------------------ +-- Servant stuff + +type SyncAPI = ("ucm" Servant.:> "v2" Servant.:> "sync" Servant.:> SyncV2.API) + +syncAPI :: Proxy SyncAPI +syncAPI = Proxy @SyncAPI + +downloadEntitiesStreamClientM :: SyncV2.DownloadEntitiesRequest -> Servant.ClientM (Servant.SourceT IO SyncV2.DownloadEntitiesChunk) +SyncV2.Routes + { downloadEntitiesStream = downloadEntitiesStreamClientM + } = Servant.client syncAPI + +-- -- | Helper for running clientM that returns a stream of entities. +-- -- You MUST consume the stream within the callback, it will be closed when the callback returns. +-- handleStream :: forall m o. (MonadUnliftIO m) => Servant.ClientEnv -> (o -> m ()) -> Servant.ClientM (Servant.SourceIO o) -> m (Either CodeserverTransportError ()) +-- handleStream clientEnv callback clientM = do +-- handleSourceT clientEnv (SourceT.foreach (throwError . StreamingError . Text.pack) callback) clientM + +-- | Helper for running clientM that returns a stream of entities. +-- You MUST consume the stream within the callback, it will be closed when the callback returns. +withConduit :: forall r. Servant.ClientEnv -> (Stream () SyncV2.DownloadEntitiesChunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO SyncV2.DownloadEntitiesChunk) -> StreamM r +withConduit clientEnv callback clientM = do + Debug.debugLogM Debug.Temp $ "Running clientM" + ExceptT $ withRunInIO \runInIO -> do + Servant.withClientM clientM clientEnv $ \case + Left err -> pure . Left . TransportError $ (handleClientError clientEnv err) + Right sourceT -> do + Debug.debugLogM Debug.Temp $ "Converting sourceIO to conduit" + conduit <- liftIO $ Servant.fromSourceIO sourceT + (runInIO . runExceptT $ callback conduit) + +handleClientError :: Servant.ClientEnv -> Servant.ClientError -> CodeserverTransportError +handleClientError clientEnv err = + case err of + Servant.FailureResponse _req resp -> + case HTTP.statusCode $ Servant.responseStatusCode resp of + 401 -> Unauthenticated (Servant.baseUrl clientEnv) + -- The server should provide semantically relevant permission-denied messages + -- when possible, but this should catch any we miss. + 403 -> PermissionDenied (Text.Lazy.toStrict . Text.Lazy.decodeUtf8 $ Servant.responseBody resp) + 408 -> Timeout + 429 -> RateLimitExceeded + 504 -> Timeout + _ -> UnexpectedResponse resp + Servant.DecodeFailure msg resp -> DecodeFailure msg resp + Servant.UnsupportedContentType _ct resp -> UnexpectedResponse resp + Servant.InvalidContentTypeHeader resp -> UnexpectedResponse resp + Servant.ConnectionError _ -> UnreachableCodeserver (Servant.baseUrl clientEnv) + +httpStreamEntities :: + forall. + Auth.AuthenticatedHttpClient -> + Servant.BaseUrl -> + SyncV2.DownloadEntitiesRequest -> + (SyncV2.StreamInitInfo -> Stream () SyncV2.EntityChunk -> StreamM ()) -> + StreamM () +httpStreamEntities (Auth.AuthenticatedHttpClient httpClient) unisonShareUrl req callback = do + let clientEnv = + (Servant.mkClientEnv httpClient unisonShareUrl) + { Servant.makeClientRequest = \url request -> + -- Disable client-side timeouts + (Servant.defaultMakeClientRequest url request) + <&> \r -> + r + { Http.Client.responseTimeout = Http.Client.responseTimeoutNone + } + } + (downloadEntitiesStreamClientM req) & withConduit clientEnv \stream -> do + (init, entityStream) <- initializeStream stream + callback init entityStream + -- | Peel the header off the stream and parse the remaining entity chunks into EntityChunks initializeStream :: Stream () SyncV2.DownloadEntitiesChunk -> StreamM (SyncV2.StreamInitInfo, Stream () SyncV2.EntityChunk) initializeStream stream = do diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index e1f51a7633..795180729d 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -152,6 +152,7 @@ library Unison.Share.ExpectedHashMismatches Unison.Share.Sync Unison.Share.Sync.Types + Unison.Share.Sync.Util Unison.Share.SyncV2 Unison.Util.HTTP Unison.Version diff --git a/unison-share-api/src/Unison/SyncV2/API.hs b/unison-share-api/src/Unison/SyncV2/API.hs new file mode 100644 index 0000000000..71ea8693d3 --- /dev/null +++ b/unison-share-api/src/Unison/SyncV2/API.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DataKinds #-} + +module Unison.SyncV2.API + ( API, + api, + Routes (..), + ) +where + +import Data.Proxy +import GHC.Generics (Generic) +import Servant.API +import Unison.SyncV2.Types +import Unison.Util.Servant.CBOR (CBOR) + +api :: Proxy API +api = Proxy + +type API = NamedRoutes Routes + +type DownloadEntitiesStream = + -- | The causal hash the client needs. The server should provide it and all of its dependencies + ReqBody '[CBOR, JSON] DownloadEntitiesRequest + :> StreamPost NetstringFraming CBOR (SourceIO DownloadEntitiesChunk) + +data Routes mode = Routes + { downloadEntitiesStream :: mode :- "entities" :> "download" :> DownloadEntitiesStream + } + deriving stock (Generic) diff --git a/unison-share-api/unison-share-api.cabal b/unison-share-api/unison-share-api.cabal index aaacbda4fd..a9447279da 100644 --- a/unison-share-api/unison-share-api.cabal +++ b/unison-share-api/unison-share-api.cabal @@ -48,6 +48,7 @@ library Unison.Sync.Common Unison.Sync.EntityValidation Unison.Sync.Types + Unison.SyncV2.API Unison.SyncV2.Types Unison.Util.Find Unison.Util.Servant.CBOR From 211a7139bd7bdbcf36c1bb951bd79536174a2544 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 22 Jan 2025 16:47:35 -0800 Subject: [PATCH 03/25] Revive syncFromCodeserver --- unison-cli/src/Unison/Share/SyncV2.hs | 42 +++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index dd90bdac75..8b45bf3f18 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -5,6 +5,7 @@ module Unison.Share.SyncV2 ( syncFromFile, syncToFile, syncFromCodebase, + syncFromCodeserver, ) where @@ -22,19 +23,30 @@ import Data.Conduit.List qualified as C import Data.Conduit.Zlib qualified as C import Data.Graph qualified as Graph import Data.Map qualified as Map +import Data.Proxy import Data.Set qualified as Set import Data.Text.IO qualified as Text +import Data.Text.Lazy qualified as Text.Lazy +import Data.Text.Lazy.Encoding qualified as Text.Lazy +import Network.HTTP.Client qualified as Http.Client +import Network.HTTP.Types qualified as HTTP +import Servant.API qualified as Servant +import Servant.Client.Streaming qualified as Servant import Servant.Conduit () +import Servant.Types.SourceT qualified as Servant import System.Console.Regions qualified as Console.Regions import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.Queries qualified as Q import U.Codebase.Sqlite.TempEntity (TempEntity) import U.Codebase.Sqlite.V2.HashHandle (v2HashHandle) +import Unison.Auth.HTTPClient qualified as Auth import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase +import Unison.Debug qualified as Debug import Unison.Hash32 (Hash32) import Unison.Prelude +import Unison.Share.API.Hash qualified as Share import Unison.Share.ExpectedHashMismatches (expectedCausalHashMismatches, expectedComponentHashMismatches) import Unison.Share.Sync.Types import Unison.Sqlite qualified as Sqlite @@ -118,6 +130,36 @@ syncFromCodebase shouldValidate srcConn destCodebase causalHash = do streamIntoCodebase shouldValidate destCodebase header rest mapExceptT liftIO (afterSyncChecks destCodebase (causalHashToHash32 causalHash)) +syncFromCodeserver :: + Bool -> + -- | The Unison Share URL. + Servant.BaseUrl -> + -- | The branch to download from. + SyncV2.BranchRef -> + -- | The hash to download. + Share.HashJWT -> + Set Hash32 -> + -- | Callback that's given a number of entities we just downloaded. + (Int -> IO ()) -> + Cli (Either (SyncError SyncV2.PullError) ()) +syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt knownHashes _downloadedCallback = do + Cli.Env {authHTTPClient, codebase} <- ask + runExceptT do + let hash = Share.hashJWTHash hashJwt + ExceptT $ do + (Cli.runTransaction (Q.entityLocation hash)) >>= \case + Just Q.EntityInMainStorage -> pure $ Right () + _ -> do + Debug.debugLogM Debug.Temp $ "Kicking off sync request" + Timing.time "Entity Download" $ do + liftIO . C.runResourceT . runExceptT $ httpStreamEntities + authHTTPClient + unisonShareUrl + SyncV2.DownloadEntitiesRequest {branchRef, causalHash = hashJwt, knownHashes} + \header stream -> do + streamIntoCodebase shouldValidate codebase header stream + mapExceptT liftIO (afterSyncChecks codebase hash) + ------------------------------------------------------------------------------------------------------------------------ -- Helpers ------------------------------------------------------------------------------------------------------------------------ From 691eaa9dff354f7c06e7926473d87f8db28d3ab4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 23 Jan 2025 11:04:21 -0800 Subject: [PATCH 04/25] Add pull.v2 command --- unison-cli/package.yaml | 1 + unison-cli/src/Unison/Cli/DownloadUtils.hs | 3 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../Codebase/Editor/HandleInput/Pull.hs | 6 ++-- .../Codebase/Editor/HandleInput/SyncV2.hs | 33 +++---------------- .../src/Unison/Codebase/Editor/Input.hs | 6 +++- .../src/Unison/CommandLine/InputPatterns.hs | 19 +++++++---- unison-cli/unison-cli.cabal | 1 + 8 files changed, 30 insertions(+), 41 deletions(-) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index d81ba052f7..d3d48f2c8a 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -20,6 +20,7 @@ library: - condition: "!os(windows)" dependencies: unix dependencies: + - attoparsec - Diff - IntervalMap - ListLike diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index fb53a84176..0772eda44c 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -19,6 +19,7 @@ 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 @@ -36,8 +37,6 @@ 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) => diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index c0cc9a8dd6..726fa6eb9c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -687,7 +687,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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index 42aebf0299..e51ba1046a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/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,7 +59,7 @@ handlePull unresolvedSourceAndTarget pullMode = do ReadShare'LooseCode repo -> downloadLooseCodeFromShare repo & onLeftM (Cli.returnEarly . Output.ShareError) ReadShare'ProjectBranch remoteBranch -> downloadProjectBranchFromShare - SyncV1 + syncVersion ( case pullMode of Input.PullWithHistory -> Share.NoSquashedHead Input.PullWithoutHistory -> Share.IncludeSquashedHead diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs index 3e3c7ba5ec..015e5b7630 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs @@ -8,11 +8,14 @@ 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 @@ -22,7 +25,6 @@ import Unison.Prelude import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName) import Unison.Share.SyncV2 qualified as SyncV2 import Unison.SyncV2.Types (BranchRef) -import Unison.Cli.DownloadUtils (SyncVersion, downloadProjectBranchFromShare) handleSyncToFile :: FilePath -> ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName) -> Cli () handleSyncToFile destSyncFile branchToSync = do @@ -72,30 +74,5 @@ handleSyncFromCodebase description srcCodebasePath srcBranch destBranch = do Right (Right (Left syncErr)) -> do Cli.respond (Output.SyncPullError syncErr) -handleSyncFromCodebase :: Text -> CodebasePath -> ProjectAndBranch ProjectName ProjectBranchName -> ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Cli () -handleSyncFromCodebase description srcCodebasePath srcBranch destBranch = do - Cli.Env {codebase} <- ask - pp <- Cli.getCurrentProjectPath - projectBranch <- Project.resolveProjectBranchInProject (pp ^. #project) (over #branch Just destBranch) - r <- liftIO $ Init.withOpenCodebase SqliteCodebase.init "sync-src" srcCodebasePath Init.DontLock (Init.MigrateAfterPrompt Init.Backup Init.Vacuum) \srcCodebase -> do - Codebase.withConnection srcCodebase \srcConn -> do - maySrcCausalHash <- Codebase.runTransaction srcCodebase $ do - let ProjectAndBranch srcProjName srcBranchName = srcBranch - runMaybeT do - project <- MaybeT (Q.loadProjectByName srcProjName) - branch <- MaybeT (Q.loadProjectBranchByName (project ^. #projectId) srcBranchName) - lift $ Project.getProjectBranchCausalHash branch - case maySrcCausalHash of - Nothing -> pure $ Left (error "Todo proper error") - Just srcCausalHash -> do - let shouldValidate = True - fmap (const srcCausalHash) <$> liftIO (SyncV2.syncFromCodebase shouldValidate srcConn codebase srcCausalHash) - - case r of - Left _err -> pure $ error "Todo proper error" - Right (Left syncErr) -> Cli.respond (Output.SyncPullError syncErr) - Right (Right causalHash) -> do - Cli.setProjectBranchRootToCausalHash (projectBranch ^. #branch) description causalHash - -handleSyncFromCodeserver :: SyncVersion -> Projects.IncludeSquashedHead -> Projects.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) -handleSyncFromCodeserver = downloadProjectBranchFromShare +handleSyncFromCodeserver :: Projects.IncludeSquashedHead -> Projects.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) +handleSyncFromCodeserver = downloadProjectBranchFromShare SyncV2 diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index e4015b64fe..b8767076e8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -27,6 +27,7 @@ module Unison.Codebase.Editor.Input IsGlobal, DeleteOutput (..), DeleteTarget (..), + SyncVersion (..), ) where @@ -55,6 +56,9 @@ data Event = UnisonFileChanged SourceName Source deriving stock (Show) +data SyncVersion = SyncV1 | SyncV2 + deriving (Eq, Show) + type Source = Text -- "id x = x\nconst a b = a" type SourceName = Text -- "foo.u" or "buffer 7" @@ -124,7 +128,7 @@ data Input MergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) Branch.MergeMode | PreviewMergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) | DiffNamespaceI BranchId2 BranchId2 -- old new - | PullI !PullSourceTarget !PullMode + | PullI !SyncVersion !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput | SyncToFileI FilePath (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)) | SyncFromFileI FilePath UnresolvedProjectBranch diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 0d0022da05..ccf5f0fc23 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -92,6 +92,7 @@ module Unison.CommandLine.InputPatterns projectSwitch, projectsInputPattern, pull, + pullV2, pullWithoutHistory, push, pushCreate, @@ -1783,7 +1784,11 @@ reset = pull :: InputPattern pull = - pullImpl "pull" [] Input.PullWithHistory "" + pullImpl "pull" [] Input.PullWithHistory "" Input.SyncV1 + +pullV2 :: InputPattern +pullV2 = + pullImpl "pull.v2" [] Input.PullWithHistory "" Input.SyncV2 pullWithoutHistory :: InputPattern pullWithoutHistory = @@ -1792,9 +1797,10 @@ pullWithoutHistory = [] Input.PullWithoutHistory "without including the remote's history. This usually results in smaller codebase sizes." + Input.SyncV1 -pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern -pullImpl name aliases pullMode addendum = do +pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> Input.SyncVersion -> InputPattern +pullImpl name aliases pullMode addendum syncVersion = do self where self = @@ -1838,10 +1844,10 @@ pullImpl name aliases pullMode addendum = do explainRemote Pull ], parse = \case - [] -> pure $ Input.PullI Input.PullSourceTarget0 pullMode + [] -> pure $ Input.PullI syncVersion Input.PullSourceTarget0 pullMode [sourceArg] -> do source <- handlePullSourceArg sourceArg - pure (Input.PullI (Input.PullSourceTarget1 source) pullMode) + pure (Input.PullI syncVersion (Input.PullSourceTarget1 source) pullMode) [sourceArg, targetArg] -> -- You used to be able to pull into a path, so this arg parser is a little complicated, because -- we want to provide helpful suggestions if you are doing a deprecated or invalid thing. @@ -1849,7 +1855,7 @@ pullImpl name aliases pullMode addendum = do handleMaybeProjectBranchArg targetArg, handlePath'Arg targetArg ) of - (Right source, Right target, _) -> Right (Input.PullI (Input.PullSourceTarget2 source target) pullMode) + (Right source, Right target, _) -> Right (Input.PullI syncVersion (Input.PullSourceTarget2 source target) pullMode) (Left err, _, _) -> Left err -- Parsing as a path didn't work either; just show the branch parse error (Right _, Left err, Left _) -> Left err @@ -3795,6 +3801,7 @@ validInputs = projectSwitch, projectsInputPattern, pull, + pullV2, pullWithoutHistory, push, pushCreate, diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 795180729d..dbdc009a7a 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -201,6 +201,7 @@ library , aeson-pretty , ansi-terminal , async + , attoparsec , base , bytestring , cmark From f91dc103afc7a9c4f0361afcdd2adea35bdf40a5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 24 Jan 2025 13:06:48 -0800 Subject: [PATCH 05/25] Remove debugging --- unison-cli/src/Unison/Share/SyncV2.hs | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 8b45bf3f18..af1da5d72b 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -17,8 +17,11 @@ import Control.Monad.Except import Control.Monad.Reader (ask) import Control.Monad.ST (ST, stToIO) import Control.Monad.State +import Data.Attoparsec.ByteString qualified as A +import Data.Attoparsec.ByteString.Char8 qualified as A8 import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL +import Data.Conduit.Attoparsec qualified as C import Data.Conduit.List qualified as C import Data.Conduit.Zlib qualified as C import Data.Graph qualified as Graph @@ -43,7 +46,6 @@ import Unison.Auth.HTTPClient qualified as Auth import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Codebase qualified as Codebase -import Unison.Debug qualified as Debug import Unison.Hash32 (Hash32) import Unison.Prelude import Unison.Share.API.Hash qualified as Share @@ -55,17 +57,13 @@ import Unison.Sync.Common qualified as Sync import Unison.Sync.EntityValidation qualified as EV import Unison.Sync.Types qualified as Share import Unison.Sync.Types qualified as Sync +import Unison.SyncV2.API (Routes (downloadEntitiesStream)) +import Unison.SyncV2.API qualified as SyncV2 import Unison.SyncV2.Types (CBORBytes) import Unison.SyncV2.Types qualified as SyncV2 import Unison.Util.Servant.CBOR qualified as CBOR import Unison.Util.Timing qualified as Timing import UnliftIO qualified as IO -import Unison.SyncV2.API (Routes (downloadEntitiesStream)) -import Unison.SyncV2.API qualified as SyncV2 -import Data.Attoparsec.ByteString qualified as A -import Data.Attoparsec.ByteString.Char8 qualified as A8 -import Data.Conduit.Attoparsec qualified as C - type Stream i o = ConduitT i o StreamM () @@ -150,7 +148,6 @@ syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt knownHashes _ (Cli.runTransaction (Q.entityLocation hash)) >>= \case Just Q.EntityInMainStorage -> pure $ Right () _ -> do - Debug.debugLogM Debug.Temp $ "Kicking off sync request" Timing.time "Entity Download" $ do liftIO . C.runResourceT . runExceptT $ httpStreamEntities authHTTPClient @@ -417,12 +414,10 @@ SyncV2.Routes -- You MUST consume the stream within the callback, it will be closed when the callback returns. withConduit :: forall r. Servant.ClientEnv -> (Stream () SyncV2.DownloadEntitiesChunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO SyncV2.DownloadEntitiesChunk) -> StreamM r withConduit clientEnv callback clientM = do - Debug.debugLogM Debug.Temp $ "Running clientM" ExceptT $ withRunInIO \runInIO -> do Servant.withClientM clientM clientEnv $ \case Left err -> pure . Left . TransportError $ (handleClientError clientEnv err) Right sourceT -> do - Debug.debugLogM Debug.Temp $ "Converting sourceIO to conduit" conduit <- liftIO $ Servant.fromSourceIO sourceT (runInIO . runExceptT $ callback conduit) From 9b944fdf57d3f938f528fd4b5f2b209ca9a8b5bb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 29 Jan 2025 12:50:38 -0800 Subject: [PATCH 06/25] Switch to use Vectors --- unison-cli/src/Unison/Share/SyncV2.hs | 88 +++++++++++++++++---------- 1 file changed, 57 insertions(+), 31 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index af1da5d72b..baa014564d 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -24,6 +24,7 @@ import Data.ByteString.Lazy qualified as BL import Data.Conduit.Attoparsec qualified as C import Data.Conduit.List qualified as C import Data.Conduit.Zlib qualified as C +import Data.Foldable qualified as Foldable import Data.Graph qualified as Graph import Data.Map qualified as Map import Data.Proxy @@ -31,6 +32,8 @@ import Data.Set qualified as Set import Data.Text.IO qualified as Text import Data.Text.Lazy qualified as Text.Lazy import Data.Text.Lazy.Encoding qualified as Text.Lazy +import Data.Vector (Vector) +import Data.Vector qualified as Vector import Network.HTTP.Client qualified as Http.Client import Network.HTTP.Types qualified as HTTP import Servant.API qualified as Servant @@ -162,7 +165,7 @@ syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt knownHashes _ ------------------------------------------------------------------------------------------------------------------------ -- | Validate that the provided entities match their expected hashes, and if so, save them to the codebase. -validateAndSave :: Bool -> (Codebase.Codebase IO v a) -> [(Hash32, TempEntity)] -> StreamM () +validateAndSave :: Bool -> (Codebase.Codebase IO v a) -> Vector (Hash32, TempEntity) -> StreamM () validateAndSave shouldValidate codebase entities = do let validateEntities = runExceptT $ when shouldValidate (batchValidateEntities entities) @@ -175,25 +178,25 @@ validateAndSave shouldValidate codebase entities = do lift (Sqlite.unsafeIO (IO.wait validationTask)) >>= \case Left err -> throwError err Right _ -> pure () - where - batchValidateEntities :: [(Hash32, TempEntity)] -> ExceptT SyncErr IO () - batchValidateEntities entities = do - mismatches <- fmap catMaybes $ liftIO $ IO.pooledForConcurrently entities \(hash, entity) -> do - IO.evaluate $ EV.validateTempEntity hash entity - for_ mismatches \case - err@(Share.EntityHashMismatch et (Share.HashMismatchForEntity {supplied, computed})) -> - let expectedMismatches = case et of - Share.TermComponentType -> expectedComponentHashMismatches - Share.DeclComponentType -> expectedComponentHashMismatches - Share.CausalType -> expectedCausalHashMismatches - _ -> mempty - in case Map.lookup supplied expectedMismatches of - Just expected - | expected == computed -> pure () - _ -> do - throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err - err -> do - throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err + +batchValidateEntities :: Vector (Hash32, TempEntity) -> ExceptT SyncErr IO () +batchValidateEntities entities = do + mismatches <- fmap Vector.catMaybes $ liftIO $ IO.pooledForConcurrently entities \(hash, entity) -> do + IO.evaluate $ EV.validateTempEntity hash entity + for_ mismatches \case + err@(Share.EntityHashMismatch et (Share.HashMismatchForEntity {supplied, computed})) -> + let expectedMismatches = case et of + Share.TermComponentType -> expectedComponentHashMismatches + Share.DeclComponentType -> expectedComponentHashMismatches + Share.CausalType -> expectedCausalHashMismatches + _ -> mempty + in case Map.lookup supplied expectedMismatches of + Just expected + | expected == computed -> pure () + _ -> do + throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err + err -> do + throwError . SyncError . SyncV2.PullError'DownloadEntities . SyncV2.DownloadEntitiesEntityValidationFailure $ err -- | Syncs a stream which could send entities in any order. syncUnsortedStream :: @@ -202,10 +205,17 @@ syncUnsortedStream :: Stream () SyncV2.EntityChunk -> StreamM () syncUnsortedStream shouldValidate codebase stream = do - allResults <- C.runConduit $ stream C..| C.sinkList - allEntities <- ExceptT $ Timing.time "Unpacking chunks" $ liftIO $ Codebase.runTransactionExceptT codebase $ do unpackChunks allResults + allEntities <- C.runConduit $ stream C..| C.chunksOf batchSize C..| unpackChunks codebase C..| validateBatch C..| C.concat C..| C.sinkVector @Vector let sortedEntities = sortDependencyFirst allEntities - validateAndSave shouldValidate codebase sortedEntities + liftIO $ withEntitySavingCallback (Just $ Vector.length allEntities) \countC -> do + Codebase.runTransaction codebase $ for_ sortedEntities \(hash, entity) -> do + r <- Q.saveTempEntityInMain v2HashHandle hash entity + Sqlite.unsafeIO $ countC 1 + pure r + where + validateBatch :: Stream (Vector (Hash32, TempEntity)) (Vector (Hash32, TempEntity)) + validateBatch = C.iterM \entities -> do + when shouldValidate (mapExceptT lift $ batchValidateEntities entities) -- | Syncs a stream which sends entities which are already sorted in dependency order. syncSortedStream :: @@ -214,17 +224,16 @@ syncSortedStream :: Stream () SyncV2.EntityChunk -> StreamM () syncSortedStream shouldValidate codebase stream = do - let handler :: Stream [SyncV2.EntityChunk] o - handler = C.mapM_C \chunkBatch -> do - entityBatch <- mapExceptT lift . ExceptT $ Codebase.runTransactionExceptT codebase do unpackChunks chunkBatch + let handler :: Stream (Vector (Hash32, TempEntity)) o + handler = C.mapM_C \entityBatch -> do validateAndSave shouldValidate codebase entityBatch - C.runConduit $ stream C..| C.chunksOf batchSize C..| handler + C.runConduit $ stream C..| C.chunksOf batchSize C..| unpackChunks codebase C..| handler -- | Topologically sort entities based on their dependencies. -sortDependencyFirst :: [(Hash32, TempEntity)] -> [(Hash32, TempEntity)] +sortDependencyFirst :: (Foldable f, Functor f) => f (Hash32, TempEntity) -> [(Hash32, TempEntity)] sortDependencyFirst entities = do let adjList = entities <&> \(hash32, entity) -> ((hash32, entity), hash32, Set.toList $ Share.entityDependencies (tempEntityToEntity entity)) - (graph, vertexInfo, _vertexForKey) = Graph.graphFromEdges adjList + (graph, vertexInfo, _vertexForKey) = Graph.graphFromEdges (Foldable.toList adjList) in Graph.reverseTopSort graph <&> \v -> (view _1 $ vertexInfo v) -- | Unpack a single entity chunk, returning the entity if it's not already in the codebase, Nothing otherwise. @@ -243,10 +252,11 @@ unpackChunk = \case Left err -> do throwError $ (SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorDeserializationFailure err) Right entity -> pure entity -unpackChunks :: [SyncV2.EntityChunk] -> ExceptT SyncErr Sqlite.Transaction [(Hash32, TempEntity)] -unpackChunks xs = do +unpackChunks :: Codebase.Codebase IO v a -> Stream [SyncV2.EntityChunk] (Vector (Hash32, TempEntity)) +unpackChunks codebase = C.mapM \xs -> ExceptT . lift . Codebase.runTransactionExceptT codebase $ do for xs unpackChunk <&> catMaybes + <&> Vector.fromList streamIntoCodebase :: Bool -> Codebase.Codebase IO v a -> SyncV2.StreamInitInfo -> Stream () SyncV2.EntityChunk -> StreamM () streamIntoCodebase shouldValidate codebase SyncV2.StreamInitInfo {version, entitySorting, numEntities = numEntities} stream = ExceptT do @@ -504,6 +514,22 @@ withStreamProgressCallback total action = do liftIO $ IO.atomically (IO.modifyTVar' entitiesDownloadedVar (+ 1)) C.yield i +withEntitySavingCallback :: (MonadUnliftIO m) => Maybe Int -> ((Int -> m ()) -> m a) -> m a +withEntitySavingCallback total action = do + counterVar <- IO.newTVarIO (0 :: Int) + IO.withRunInIO \toIO -> do + Console.Regions.displayConsoleRegions do + Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do + Console.Regions.setConsoleRegion region do + processed <- IO.readTVar counterVar + pure $ + "\n Saved " + <> tShow processed + <> maybe "" (\total -> " / " <> tShow total) total + <> " entities...\n\n" + toIO $ action $ \i -> do + liftIO $ IO.atomically (IO.modifyTVar' counterVar (+ i)) + withEntityLoadingCallback :: (MonadUnliftIO m) => ((Int -> m ()) -> m a) -> m a withEntityLoadingCallback action = do counterVar <- IO.newTVarIO (0 :: Int) From 4c31e90ecdf16b72bba15ec41eaeb74505287c9d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Jan 2025 10:16:32 -0800 Subject: [PATCH 07/25] Revert Queries module to trunk --- .../U/Codebase/Sqlite/Queries.hs | 92 +++++++------------ .../sql/001-temp-entity-tables.sql | 3 +- 2 files changed, 33 insertions(+), 62 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 1e3d1eef5a..043fd697c7 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -229,7 +229,6 @@ module U.Codebase.Sqlite.Queries expectEntity, syncToTempEntity, insertTempEntity, - insertTempEntityV2, saveTempEntityInMain, expectTempEntity, deleteTempEntity, @@ -318,7 +317,6 @@ import Data.Map.NonEmpty qualified as NEMap import Data.Maybe qualified as Maybe import Data.Sequence qualified as Seq import Data.Set qualified as Set -import Data.Set.NonEmpty (NESet) import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Text.Lazy qualified as Text.Lazy @@ -540,18 +538,23 @@ countWatches = queryOneCol [sql| SELECT COUNT(*) FROM watch |] saveHash :: Hash32 -> Transaction HashId saveHash hash = do - loadHashId hash >>= \case - Just h -> pure h - Nothing -> do - queryOneCol - [sql| - INSERT INTO hash (base32) VALUES (:hash) - RETURNING id - |] + execute + [sql| + INSERT INTO hash (base32) VALUES (:hash) + ON CONFLICT DO NOTHING + |] + expectHashId hash saveHashes :: Traversable f => f Hash32 -> Transaction (f HashId) saveHashes hashes = do - for hashes saveHash + for_ hashes \hash -> + execute + [sql| + INSERT INTO hash (base32) + VALUES (:hash) + ON CONFLICT DO NOTHING + |] + traverse expectHashId hashes saveHashHash :: Hash -> Transaction HashId saveHashHash = saveHash . Hash32.fromHash @@ -626,15 +629,13 @@ expectBranchHashForCausalHash ch = do saveText :: Text -> Transaction TextId saveText t = do - loadTextId t >>= \case - Just h -> pure h - Nothing -> do - queryOneCol - [sql| - INSERT INTO text (text) - VALUES (:t) - RETURNING id - |] + execute + [sql| + INSERT INTO text (text) + VALUES (:t) + ON CONFLICT DO NOTHING + |] + expectTextId t saveTexts :: Traversable f => f Text -> Transaction (f TextId) saveTexts = @@ -691,7 +692,7 @@ saveObject :: ObjectType -> ByteString -> Transaction ObjectId -saveObject _hh h t blob = do +saveObject hh h t blob = do execute [sql| INSERT INTO object (primary_hash_id, type_id, bytes) @@ -702,9 +703,9 @@ saveObject _hh h t blob = do saveHashObject h oId 2 -- todo: remove this from here, and add it to other relevant places once there are v1 and v2 hashes rowsModified >>= \case 0 -> pure () - _ -> pure () - -- hash <- expectHash32 h - -- tryMoveTempEntityDependents hh hash + _ -> do + hash <- expectHash32 h + tryMoveTempEntityDependents hh hash pure oId expectObject :: SqliteExceptionReason e => ObjectId -> (ByteString -> Either e a) -> Transaction a @@ -962,7 +963,7 @@ saveCausal :: BranchHashId -> [CausalHashId] -> Transaction () -saveCausal _hh self value parents = do +saveCausal hh self value parents = do execute [sql| INSERT INTO causal (self_hash_id, value_hash_id) @@ -978,15 +979,15 @@ saveCausal _hh self value parents = do INSERT INTO causal_parent (causal_id, parent_id) VALUES (:self, :parent) |] - -- flushCausalDependents hh self + flushCausalDependents hh self -_flushCausalDependents :: +flushCausalDependents :: HashHandle -> CausalHashId -> Transaction () -_flushCausalDependents hh chId = do +flushCausalDependents hh chId = do hash <- expectHash32 (unCausalHashId chId) - _tryMoveTempEntityDependents hh hash + tryMoveTempEntityDependents hh hash -- | `tryMoveTempEntityDependents #foo` does this: -- 0. Precondition: We just inserted object #foo. @@ -994,11 +995,11 @@ _flushCausalDependents hh chId = do -- 2. Delete #foo as dependency from temp_entity_missing_dependency. e.g. (#bar, #foo), (#baz, #foo) -- 3. For each like #bar and #baz with no more rows in temp_entity_missing_dependency, -- insert_entity them. -_tryMoveTempEntityDependents :: +tryMoveTempEntityDependents :: HashHandle -> Hash32 -> Transaction () -_tryMoveTempEntityDependents hh dependency = do +tryMoveTempEntityDependents hh dependency = do dependents <- queryListCol [sql| @@ -2972,35 +2973,6 @@ insertTempEntity entityHash entity missingDependencies = do entityType = Entity.entityType entity --- | Insert a new `temp_entity` row, and its associated 1+ `temp_entity_missing_dependency` rows. --- --- Preconditions: --- 1. The entity does not already exist in "main" storage (`object` / `causal`) --- 2. The entity does not already exist in `temp_entity`. -insertTempEntityV2 :: Hash32 -> TempEntity -> NESet Hash32 -> Transaction () -insertTempEntityV2 entityHash entity missingDependencies = do - execute - [sql| - INSERT INTO temp_entity (hash, blob, type_id) - VALUES (:entityHash, :entityBlob, :entityType) - ON CONFLICT DO NOTHING - |] - - for_ missingDependencies \depHash -> - execute - [sql| - INSERT INTO temp_entity_missing_dependency (dependent, dependency) - VALUES (:entityHash, :depHash) - |] - where - entityBlob :: ByteString - entityBlob = - runPutS (Serialization.putTempEntity entity) - - entityType :: TempEntityType - entityType = - Entity.entityType entity - -- | Delete a row from the `temp_entity` table, if it exists. deleteTempEntity :: Hash32 -> Transaction () deleteTempEntity hash = diff --git a/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql b/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql index 6651d4a6fe..0ae13812b1 100644 --- a/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql +++ b/codebase2/codebase-sqlite/sql/001-temp-entity-tables.sql @@ -56,8 +56,7 @@ create table if not exists temp_entity ( create table if not exists temp_entity_missing_dependency ( dependent text not null references temp_entity(hash), dependency text not null, - -- TODO: this is just for testing - dependencyJwt text null, + dependencyJwt text not null, unique (dependent, dependency) ); create index if not exists temp_entity_missing_dependency_ix_dependent on temp_entity_missing_dependency (dependent); From f2b3422a7e5ee29d3ec36916d67a1d31f061dd89 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Jan 2025 10:20:44 -0800 Subject: [PATCH 08/25] Remove unused BailT Monad --- lib/unison-sqlite/unison-sqlite.cabal | 1 - unison-cli/src/Unison/Share/Sync/Util.hs | 42 ------------------------ unison-cli/unison-cli.cabal | 1 - 3 files changed, 44 deletions(-) delete mode 100644 unison-cli/src/Unison/Share/Sync/Util.hs diff --git a/lib/unison-sqlite/unison-sqlite.cabal b/lib/unison-sqlite/unison-sqlite.cabal index 13a9eb27cd..3db0980a7c 100644 --- a/lib/unison-sqlite/unison-sqlite.cabal +++ b/lib/unison-sqlite/unison-sqlite.cabal @@ -65,7 +65,6 @@ library ghc-options: -Wall build-depends: base - , containers , direct-sqlite , megaparsec , pretty-simple diff --git a/unison-cli/src/Unison/Share/Sync/Util.hs b/unison-cli/src/Unison/Share/Sync/Util.hs deleted file mode 100644 index 39eeb2cede..0000000000 --- a/unison-cli/src/Unison/Share/Sync/Util.hs +++ /dev/null @@ -1,42 +0,0 @@ -module Unison.Share.Sync.Util - ( BailT (..), - MonadBail (..), - runBailT, - mapBailT, - withError, - ) -where - -import Control.Monad.Reader (MonadReader (..), ReaderT (..), mapReaderT, withReaderT) -import Data.Data (Typeable) -import UnliftIO qualified as IO - -newtype Handler e = Handler {runHandler :: forall x. e -> IO x} - -newtype BailT e m a = BailT {unErrGroupT :: ReaderT (Handler e) m a} - deriving newtype (Functor, Applicative, Monad, IO.MonadUnliftIO, IO.MonadIO) - -newtype ExceptionWrapper e = ExceptionWrapper {unException :: e} - -instance Show (ExceptionWrapper e) where - show (ExceptionWrapper _) = "ExceptionWrapper<>" - -instance (Typeable e) => IO.Exception (ExceptionWrapper e) - -class MonadBail e m where - bail :: e -> m a - -mapBailT :: (Monad n) => (m a -> n b) -> BailT e m a -> BailT e n b -mapBailT f (BailT m) = BailT $ mapReaderT f $ m - -withError :: (Monad m) => (e' -> e) -> BailT e' m a -> BailT e m a -withError f (BailT m) = BailT $ withReaderT (\h -> Handler $ runHandler h . f) m - -instance (IO.MonadUnliftIO m, Typeable e) => MonadBail e (BailT e m) where - bail e = do - handler <- BailT ask - BailT $ IO.liftIO $ runHandler handler e - -runBailT :: (IO.MonadUnliftIO m, Typeable e) => BailT e m a -> (e -> m a) -> m a -runBailT (BailT m) handler = do - IO.handle (handler . unException) $ runReaderT m (Handler (IO.throwIO . ExceptionWrapper)) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 543bc2d5c3..8a40ecd6e4 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -153,7 +153,6 @@ library Unison.Share.ExpectedHashMismatches Unison.Share.Sync Unison.Share.Sync.Types - Unison.Share.Sync.Util Unison.Share.SyncV2 Unison.Util.HTTP Unison.Version From dadd5e88d8d1c1a01e9fa485db7c2f062a5476cd Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Jan 2025 10:26:07 -0800 Subject: [PATCH 09/25] Remove cruft --- unison-cli/src/Unison/Cli/DownloadUtils.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 0772eda44c..50e89dd354 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -66,7 +66,6 @@ downloadProjectBranchFromShare syncVersion useSquashed branch = 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 From bdb2ecda0049539657acf5542e41cc90ab3285b4 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Jan 2025 10:40:16 -0800 Subject: [PATCH 10/25] Reduce code duplication in progress counters --- lib/unison-sqlite/unison-sqlite.cabal | 1 + unison-cli/src/Unison/Share/SyncV2.hs | 112 ++++++++++++++------------ 2 files changed, 61 insertions(+), 52 deletions(-) diff --git a/lib/unison-sqlite/unison-sqlite.cabal b/lib/unison-sqlite/unison-sqlite.cabal index 3db0980a7c..13a9eb27cd 100644 --- a/lib/unison-sqlite/unison-sqlite.cabal +++ b/lib/unison-sqlite/unison-sqlite.cabal @@ -65,6 +65,7 @@ library ghc-options: -Wall build-depends: base + , containers , direct-sqlite , megaparsec , pretty-simple diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index baa014564d..37f0720723 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -89,8 +89,11 @@ batchSize = 5000 -- | Sync a given causal hash and its dependencies to a sync-file. syncToFile :: Codebase.Codebase IO v a -> + -- | Root hash to sync CausalHash -> + -- | Optional name of the branch begin synced Maybe SyncV2.BranchRef -> + -- | Location of the sync-file FilePath -> IO (Either SyncErr ()) syncToFile codebase rootHash mayBranchRef destFilePath = do @@ -98,9 +101,15 @@ syncToFile codebase rootHash mayBranchRef destFilePath = do C.runResourceT $ withCodebaseEntityStream conn rootHash mayBranchRef \mayTotal stream -> do withStreamProgressCallback (Just mayTotal) \countC -> runExceptT do - C.runConduit $ stream C..| countC C..| C.map (BL.toStrict . CBOR.serialise) C..| C.transPipe liftIO C.gzip C..| C.sinkFile destFilePath + C.runConduit $ + stream + C..| countC + C..| C.map (BL.toStrict . CBOR.serialise) + C..| C.transPipe liftIO C.gzip + C..| C.sinkFile destFilePath syncFromFile :: + -- | Whether to validate entities as they're imported. Bool -> -- | Location of the sync-file FilePath -> @@ -179,6 +188,7 @@ validateAndSave shouldValidate codebase entities = do Left err -> throwError err Right _ -> pure () +-- | Validate that a batch of entities matches the hashes they're keyed by, throwing an error if any of them fail validation. batchValidateEntities :: Vector (Hash32, TempEntity) -> ExceptT SyncErr IO () batchValidateEntities entities = do mismatches <- fmap Vector.catMaybes $ liftIO $ IO.pooledForConcurrently entities \(hash, entity) -> do @@ -205,7 +215,14 @@ syncUnsortedStream :: Stream () SyncV2.EntityChunk -> StreamM () syncUnsortedStream shouldValidate codebase stream = do - allEntities <- C.runConduit $ stream C..| C.chunksOf batchSize C..| unpackChunks codebase C..| validateBatch C..| C.concat C..| C.sinkVector @Vector + allEntities <- + C.runConduit $ + stream + C..| C.chunksOf batchSize + C..| unpackChunks codebase + C..| validateBatch + C..| C.concat + C..| C.sinkVector @Vector let sortedEntities = sortDependencyFirst allEntities liftIO $ withEntitySavingCallback (Just $ Vector.length allEntities) \countC -> do Codebase.runTransaction codebase $ for_ sortedEntities \(hash, entity) -> do @@ -218,6 +235,7 @@ syncUnsortedStream shouldValidate codebase stream = do when shouldValidate (mapExceptT lift $ batchValidateEntities entities) -- | Syncs a stream which sends entities which are already sorted in dependency order. +-- This allows us to stream them directly into the codebase as they're received. syncSortedStream :: Bool -> (Codebase.Codebase IO v a) -> @@ -227,9 +245,13 @@ syncSortedStream shouldValidate codebase stream = do let handler :: Stream (Vector (Hash32, TempEntity)) o handler = C.mapM_C \entityBatch -> do validateAndSave shouldValidate codebase entityBatch - C.runConduit $ stream C..| C.chunksOf batchSize C..| unpackChunks codebase C..| handler + C.runConduit $ + stream + C..| C.chunksOf batchSize + C..| unpackChunks codebase + C..| handler --- | Topologically sort entities based on their dependencies. +-- | Topologically sort entities based on their dependencies, returning a list in dependency-first order. sortDependencyFirst :: (Foldable f, Functor f) => f (Hash32, TempEntity) -> [(Hash32, TempEntity)] sortDependencyFirst entities = do let adjList = entities <&> \(hash32, entity) -> ((hash32, entity), hash32, Set.toList $ Share.entityDependencies (tempEntityToEntity entity)) @@ -258,9 +280,17 @@ unpackChunks codebase = C.mapM \xs -> ExceptT . lift . Codebase.runTransactionEx <&> catMaybes <&> Vector.fromList -streamIntoCodebase :: Bool -> Codebase.Codebase IO v a -> SyncV2.StreamInitInfo -> Stream () SyncV2.EntityChunk -> StreamM () +-- | Stream entities from one codebase into another. +streamIntoCodebase :: + -- | Whether to validate entities as they're imported. + Bool -> + Codebase.Codebase IO v a -> + SyncV2.StreamInitInfo -> + Stream () SyncV2.EntityChunk -> + StreamM () streamIntoCodebase shouldValidate codebase SyncV2.StreamInitInfo {version, entitySorting, numEntities = numEntities} stream = ExceptT do withStreamProgressCallback (fromIntegral <$> numEntities) \countC -> runExceptT do + -- Add a counter to the stream to track how many entities we've processed. let stream' = stream C..| countC case version of (SyncV2.Version 1) -> pure () @@ -270,7 +300,7 @@ streamIntoCodebase shouldValidate codebase SyncV2.StreamInitInfo {version, entit SyncV2.DependenciesFirst -> syncSortedStream shouldValidate codebase stream' SyncV2.Unsorted -> syncUnsortedStream shouldValidate codebase stream' --- | Verify that the hash we expected to import from the stream was successfully loaded into the codebase. +-- | A sanity-check to verify that the hash we expected to import from the stream was successfully loaded into the codebase. afterSyncChecks :: Codebase.Codebase IO v a -> Hash32 -> ExceptT (SyncError SyncV2.PullError) IO () afterSyncChecks codebase hash = do lift (didCausalSuccessfullyImport codebase hash) >>= \case @@ -285,12 +315,13 @@ afterSyncChecks codebase hash = do let expectedHash = hash32ToCausalHash hash isJust <$> (Codebase.runTransaction codebase $ Q.loadCausalByCausalHash expectedHash) --- | Load and stream entities for a given causal hash from a codebase. +-- | Load and stream entities for a given causal hash from a codebase into a stream. withCodebaseEntityStream :: (MonadIO m) => Sqlite.Connection -> CausalHash -> Maybe SyncV2.BranchRef -> + -- | Callback to call with the total count of entities and the stream. (Int -> Stream () SyncV2.DownloadEntitiesChunk -> m r) -> m r withCodebaseEntityStream conn rootHash mayBranchRef callback = do @@ -353,7 +384,7 @@ _decodeFramedEntity bs = do Left err -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorDeserializationFailure err Right chunk -> pure chunk --- Expects a stream of tightly-packed CBOR entities without any framing/separators. +-- | Unpacks a stream of tightly-packed CBOR entities without any framing/separators. decodeUnframedEntities :: Stream ByteString SyncV2.DownloadEntitiesChunk decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do C.await >>= \case @@ -414,12 +445,6 @@ SyncV2.Routes { downloadEntitiesStream = downloadEntitiesStreamClientM } = Servant.client syncAPI --- -- | Helper for running clientM that returns a stream of entities. --- -- You MUST consume the stream within the callback, it will be closed when the callback returns. --- handleStream :: forall m o. (MonadUnliftIO m) => Servant.ClientEnv -> (o -> m ()) -> Servant.ClientM (Servant.SourceIO o) -> m (Either CodeserverTransportError ()) --- handleStream clientEnv callback clientM = do --- handleSourceT clientEnv (SourceT.foreach (throwError . StreamingError . Text.pack) callback) clientM - -- | Helper for running clientM that returns a stream of entities. -- You MUST consume the stream within the callback, it will be closed when the callback returns. withConduit :: forall r. Servant.ClientEnv -> (Stream () SyncV2.DownloadEntitiesChunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO SyncV2.DownloadEntitiesChunk) -> StreamM r @@ -449,6 +474,7 @@ handleClientError clientEnv err = Servant.InvalidContentTypeHeader resp -> UnexpectedResponse resp Servant.ConnectionError _ -> UnreachableCodeserver (Servant.baseUrl clientEnv) +-- | Stream entities from the codeserver. httpStreamEntities :: forall. Auth.AuthenticatedHttpClient -> @@ -496,51 +522,33 @@ initializeStream stream = do -- Progress Tracking ------------------------------------------------------------------------------------------------------------------------ --- Provide the given action a callback that display to the terminal. -withStreamProgressCallback :: (MonadIO m, MonadUnliftIO n) => Maybe Int -> (ConduitT i i m () -> n a) -> n a -withStreamProgressCallback total action = do - entitiesDownloadedVar <- IO.newTVarIO (0 :: Int) - IO.withRunInIO \toIO -> do - Console.Regions.displayConsoleRegions do - Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do - Console.Regions.setConsoleRegion region do - entitiesDownloaded <- IO.readTVar entitiesDownloadedVar - pure $ - "\n Processed " - <> tShow entitiesDownloaded - <> maybe "" (\total -> " / " <> tShow total) total - <> " entities...\n\n" - toIO $ action $ C.awaitForever \i -> do - liftIO $ IO.atomically (IO.modifyTVar' entitiesDownloadedVar (+ 1)) - C.yield i - -withEntitySavingCallback :: (MonadUnliftIO m) => Maybe Int -> ((Int -> m ()) -> m a) -> m a -withEntitySavingCallback total action = do +counterProgress :: (MonadIO m, MonadUnliftIO n) => (Int -> Text) -> ((Int -> m ()) -> n a) -> n a +counterProgress msgBuilder action = do counterVar <- IO.newTVarIO (0 :: Int) IO.withRunInIO \toIO -> do Console.Regions.displayConsoleRegions do Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do Console.Regions.setConsoleRegion region do - processed <- IO.readTVar counterVar - pure $ - "\n Saved " - <> tShow processed - <> maybe "" (\total -> " / " <> tShow total) total - <> " entities...\n\n" + num <- IO.readTVar counterVar + pure $ msgBuilder num toIO $ action $ \i -> do liftIO $ IO.atomically (IO.modifyTVar' counterVar (+ i)) +-- | Track how many entities have been downloaded using a counter stream. +withStreamProgressCallback :: (MonadIO m, MonadUnliftIO n) => Maybe Int -> (ConduitT i i m () -> n a) -> n a +withStreamProgressCallback total action = do + let msg n = "\n Processed " <> tShow n <> maybe "" (\total -> " / " <> tShow total) total <> " entities...\n\n" + let action' f = action (C.iterM \_i -> f 1) + counterProgress msg action' + +-- | Track how many entities have been saved. +withEntitySavingCallback :: (MonadUnliftIO m) => Maybe Int -> ((Int -> m ()) -> m a) -> m a +withEntitySavingCallback total action = do + let msg n = "\n Saved " <> tShow n <> maybe "" (\total -> " / " <> tShow total) total <> " entities...\n\n" + counterProgress msg action + +-- | Track how many entities have been loaded. withEntityLoadingCallback :: (MonadUnliftIO m) => ((Int -> m ()) -> m a) -> m a withEntityLoadingCallback action = do - counterVar <- IO.newTVarIO (0 :: Int) - IO.withRunInIO \toIO -> do - Console.Regions.displayConsoleRegions do - Console.Regions.withConsoleRegion Console.Regions.Linear \region -> do - Console.Regions.setConsoleRegion region do - processed <- IO.readTVar counterVar - pure $ - "\n Loading " - <> tShow processed - <> " entities...\n\n" - toIO $ action $ \i -> do - liftIO $ IO.atomically (IO.modifyTVar' counterVar (+ i)) + let msg n = "\n Loading " <> tShow n <> " entities...\n\n" + counterProgress msg action From 55fd99bb712359afdab3d35bf56f266e4bd6f4f8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Jan 2025 11:22:27 -0800 Subject: [PATCH 11/25] Hide pull.v2 --- unison-cli/src/Unison/CommandLine/InputPatterns.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f8ab98c53e..c17759e418 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1792,7 +1792,9 @@ pull = pullV2 :: InputPattern pullV2 = - pullImpl "pull.v2" [] Input.PullWithHistory "" Input.SyncV2 + (pullImpl "pull.v2" [] Input.PullWithHistory "" Input.SyncV2) + {I.visibility = I.Hidden + } pullWithoutHistory :: InputPattern pullWithoutHistory = From b87bbbbe9697d2fef4b1f7f5e61e1b5d54dff4de Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Jan 2025 11:04:49 -0800 Subject: [PATCH 12/25] Switch to unframed entities --- unison-cli/src/Unison/Share/SyncV2.hs | 10 +++++++--- unison-share-api/src/Unison/SyncV2/API.hs | 2 +- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 37f0720723..8f9768a7e0 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -440,21 +440,25 @@ type SyncAPI = ("ucm" Servant.:> "v2" Servant.:> "sync" Servant.:> SyncV2.API) syncAPI :: Proxy SyncAPI syncAPI = Proxy @SyncAPI -downloadEntitiesStreamClientM :: SyncV2.DownloadEntitiesRequest -> Servant.ClientM (Servant.SourceT IO SyncV2.DownloadEntitiesChunk) +downloadEntitiesStreamClientM :: SyncV2.DownloadEntitiesRequest -> Servant.ClientM (Servant.SourceT IO (CBORBytes SyncV2.DownloadEntitiesChunk)) SyncV2.Routes { downloadEntitiesStream = downloadEntitiesStreamClientM } = Servant.client syncAPI -- | Helper for running clientM that returns a stream of entities. -- You MUST consume the stream within the callback, it will be closed when the callback returns. -withConduit :: forall r. Servant.ClientEnv -> (Stream () SyncV2.DownloadEntitiesChunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO SyncV2.DownloadEntitiesChunk) -> StreamM r +withConduit :: forall r. Servant.ClientEnv -> (Stream () (SyncV2.DownloadEntitiesChunk) -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORBytes SyncV2.DownloadEntitiesChunk)) -> StreamM r withConduit clientEnv callback clientM = do ExceptT $ withRunInIO \runInIO -> do Servant.withClientM clientM clientEnv $ \case Left err -> pure . Left . TransportError $ (handleClientError clientEnv err) Right sourceT -> do conduit <- liftIO $ Servant.fromSourceIO sourceT - (runInIO . runExceptT $ callback conduit) + (runInIO . runExceptT $ callback (conduit C..| unpackCBORBytesStream)) + +unpackCBORBytesStream :: Stream (CBORBytes SyncV2.DownloadEntitiesChunk) SyncV2.DownloadEntitiesChunk +unpackCBORBytesStream = + C.map (BL.toStrict . coerce @_ @BL.ByteString) C..| decodeUnframedEntities handleClientError :: Servant.ClientEnv -> Servant.ClientError -> CodeserverTransportError handleClientError clientEnv err = diff --git a/unison-share-api/src/Unison/SyncV2/API.hs b/unison-share-api/src/Unison/SyncV2/API.hs index 71ea8693d3..ae575c1885 100644 --- a/unison-share-api/src/Unison/SyncV2/API.hs +++ b/unison-share-api/src/Unison/SyncV2/API.hs @@ -21,7 +21,7 @@ type API = NamedRoutes Routes type DownloadEntitiesStream = -- | The causal hash the client needs. The server should provide it and all of its dependencies ReqBody '[CBOR, JSON] DownloadEntitiesRequest - :> StreamPost NetstringFraming CBOR (SourceIO DownloadEntitiesChunk) + :> StreamPost NoFraming CBOR (SourceIO (CBORBytes DownloadEntitiesChunk)) data Routes mode = Routes { downloadEntitiesStream :: mode :- "entities" :> "download" :> DownloadEntitiesStream From d71506318bd3d0e658533bb2bce8f4e8dd071b32 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Jan 2025 12:32:08 -0800 Subject: [PATCH 13/25] Add dedicated CBORStream type --- unison-cli/src/Unison/Share/SyncV2.hs | 8 ++++---- unison-share-api/src/Unison/SyncV2/API.hs | 2 +- unison-share-api/src/Unison/SyncV2/Types.hs | 1 + unison-share-api/src/Unison/Util/Servant/CBOR.hs | 12 ++++++++++++ 4 files changed, 18 insertions(+), 5 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 8f9768a7e0..d4e64e9cce 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -62,7 +62,7 @@ import Unison.Sync.Types qualified as Share import Unison.Sync.Types qualified as Sync import Unison.SyncV2.API (Routes (downloadEntitiesStream)) import Unison.SyncV2.API qualified as SyncV2 -import Unison.SyncV2.Types (CBORBytes) +import Unison.SyncV2.Types (CBORBytes, CBORStream) import Unison.SyncV2.Types qualified as SyncV2 import Unison.Util.Servant.CBOR qualified as CBOR import Unison.Util.Timing qualified as Timing @@ -440,14 +440,14 @@ type SyncAPI = ("ucm" Servant.:> "v2" Servant.:> "sync" Servant.:> SyncV2.API) syncAPI :: Proxy SyncAPI syncAPI = Proxy @SyncAPI -downloadEntitiesStreamClientM :: SyncV2.DownloadEntitiesRequest -> Servant.ClientM (Servant.SourceT IO (CBORBytes SyncV2.DownloadEntitiesChunk)) +downloadEntitiesStreamClientM :: SyncV2.DownloadEntitiesRequest -> Servant.ClientM (Servant.SourceT IO (CBORStream SyncV2.DownloadEntitiesChunk)) SyncV2.Routes { downloadEntitiesStream = downloadEntitiesStreamClientM } = Servant.client syncAPI -- | Helper for running clientM that returns a stream of entities. -- You MUST consume the stream within the callback, it will be closed when the callback returns. -withConduit :: forall r. Servant.ClientEnv -> (Stream () (SyncV2.DownloadEntitiesChunk) -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORBytes SyncV2.DownloadEntitiesChunk)) -> StreamM r +withConduit :: forall r. Servant.ClientEnv -> (Stream () (SyncV2.DownloadEntitiesChunk) -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORStream SyncV2.DownloadEntitiesChunk)) -> StreamM r withConduit clientEnv callback clientM = do ExceptT $ withRunInIO \runInIO -> do Servant.withClientM clientM clientEnv $ \case @@ -456,7 +456,7 @@ withConduit clientEnv callback clientM = do conduit <- liftIO $ Servant.fromSourceIO sourceT (runInIO . runExceptT $ callback (conduit C..| unpackCBORBytesStream)) -unpackCBORBytesStream :: Stream (CBORBytes SyncV2.DownloadEntitiesChunk) SyncV2.DownloadEntitiesChunk +unpackCBORBytesStream :: Stream (CBORStream SyncV2.DownloadEntitiesChunk) SyncV2.DownloadEntitiesChunk unpackCBORBytesStream = C.map (BL.toStrict . coerce @_ @BL.ByteString) C..| decodeUnframedEntities diff --git a/unison-share-api/src/Unison/SyncV2/API.hs b/unison-share-api/src/Unison/SyncV2/API.hs index ae575c1885..4aec0e6b54 100644 --- a/unison-share-api/src/Unison/SyncV2/API.hs +++ b/unison-share-api/src/Unison/SyncV2/API.hs @@ -21,7 +21,7 @@ type API = NamedRoutes Routes type DownloadEntitiesStream = -- | The causal hash the client needs. The server should provide it and all of its dependencies ReqBody '[CBOR, JSON] DownloadEntitiesRequest - :> StreamPost NoFraming CBOR (SourceIO (CBORBytes DownloadEntitiesChunk)) + :> StreamPost NoFraming OctetStream (SourceIO (CBORStream DownloadEntitiesChunk)) data Routes mode = Routes { downloadEntitiesStream :: mode :- "entities" :> "download" :> DownloadEntitiesStream diff --git a/unison-share-api/src/Unison/SyncV2/Types.hs b/unison-share-api/src/Unison/SyncV2/Types.hs index 80272de8ab..c2935110d9 100644 --- a/unison-share-api/src/Unison/SyncV2/Types.hs +++ b/unison-share-api/src/Unison/SyncV2/Types.hs @@ -7,6 +7,7 @@ module Unison.SyncV2.Types SyncError (..), DownloadEntitiesError (..), CBORBytes (..), + CBORStream(..), EntityKind (..), serialiseCBORBytes, deserialiseOrFailCBORBytes, diff --git a/unison-share-api/src/Unison/Util/Servant/CBOR.hs b/unison-share-api/src/Unison/Util/Servant/CBOR.hs index 18fd94904c..580b1a7124 100644 --- a/unison-share-api/src/Unison/Util/Servant/CBOR.hs +++ b/unison-share-api/src/Unison/Util/Servant/CBOR.hs @@ -5,6 +5,7 @@ module Unison.Util.Servant.CBOR ( CBOR, UnknownCBORBytes, CBORBytes (..), + CBORStream (..), deserialiseOrFailCBORBytes, serialiseCBORBytes, decodeCBORBytes, @@ -86,3 +87,14 @@ serialiseUnknownCBORBytes = CBORBytes . CBOR.serialise data Unknown type UnknownCBORBytes = CBORBytes Unknown + +-- | Wrapper for a stream of CBOR data. Each chunk may not be a complete CBOR value, but the concatenation of all the chunks is a valid CBOR stream. +newtype CBORStream a = CBORStream BL.ByteString + deriving (Serialise) via (BL.ByteString) + deriving (Eq, Show, Ord) + +instance MimeRender OctetStream (CBORStream a) where + mimeRender Proxy (CBORStream bs) = bs + +instance MimeUnrender OctetStream (CBORStream a) where + mimeUnrender Proxy bs = Right (CBORStream bs) From 67f04ee74745723dccf98ba9d11b8bfa2e57ce51 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Feb 2025 10:28:25 -0800 Subject: [PATCH 14/25] Make timestamps for last-accessed sub-second, (and set on creation) and fix transcript order --- .../U/Codebase/Sqlite/Queries.hs | 6 +- .../idempotent/api-list-projects-branches.md | 10 +-- .../api-list-projects-branches.output.md | 74 +++++++++++++++++++ 3 files changed, 81 insertions(+), 9 deletions(-) create mode 100644 unison-src/transcripts/idempotent/api-list-projects-branches.output.md diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 043fd697c7..3d94e12f2f 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -3839,8 +3839,8 @@ insertProjectBranch description causalHashId (ProjectBranch projectId branchId b execute [sql| - INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id) - VALUES (:projectId, :branchId, :branchName, :causalHashId) + INSERT INTO project_branch (project_id, branch_id, name, causal_hash_id, last_accessed) + VALUES (:projectId, :branchId, :branchName, :causalHashId, strftime('%s', 'now', 'subsec')) |] whenJust maybeParentBranchId \parentBranchId -> execute @@ -4478,7 +4478,7 @@ setCurrentProjectPath projId branchId path = do execute [sql| UPDATE project_branch - SET last_accessed = strftime('%s', 'now') + SET last_accessed = strftime('%s', 'now', 'subsec') WHERE project_id = :projId AND branch_id = :branchId |] diff --git a/unison-src/transcripts/idempotent/api-list-projects-branches.md b/unison-src/transcripts/idempotent/api-list-projects-branches.md index 2f3bc28b22..0599cbf799 100644 --- a/unison-src/transcripts/idempotent/api-list-projects-branches.md +++ b/unison-src/transcripts/idempotent/api-list-projects-branches.md @@ -8,17 +8,15 @@ lump many of those together. Doing it this way ensures both the creation timesta the same direction so we don't end up with flaky non-deterministic tests. ``` ucm :hide -scratch/main> project.create-empty project-cherry +project-apple/main> project.create-empty project-cherry -scratch/main> project.create-empty project-banana - -scratch/main> project.create-empty project-apple +project-apple/main> project.create-empty project-banana project-apple/main> branch a-branch-cherry -project-apple/main> branch a-branch-banana +project-apple/a-branch-cherry> branch a-branch-banana -project-apple/main> branch a-branch-apple +project-apple/a-branch-banana> branch a-branch-apple ``` ``` api diff --git a/unison-src/transcripts/idempotent/api-list-projects-branches.output.md b/unison-src/transcripts/idempotent/api-list-projects-branches.output.md new file mode 100644 index 0000000000..0599cbf799 --- /dev/null +++ b/unison-src/transcripts/idempotent/api-list-projects-branches.output.md @@ -0,0 +1,74 @@ +# List Projects And Branches Test + +I create projects and branches in reverse alphabetical order, and starting with `z` +to place them after `main` alphabetically. +This is because the results from the listing endpoints is sorted by (timestamp, name); but +the default sqlite timestamp only has second-level precision and the transcript will sometimes +lump many of those together. Doing it this way ensures both the creation timestamp and name sort +the same direction so we don't end up with flaky non-deterministic tests. + +``` ucm :hide +project-apple/main> project.create-empty project-cherry + +project-apple/main> project.create-empty project-banana + +project-apple/main> branch a-branch-cherry + +project-apple/a-branch-cherry> branch a-branch-banana + +project-apple/a-branch-banana> branch a-branch-apple +``` + +``` api +-- Should list all projects +GET /api/projects + [ + { + "activeBranchRef": "a-branch-apple", + "projectName": "project-apple" + }, + { + "activeBranchRef": "main", + "projectName": "project-banana" + }, + { + "activeBranchRef": "main", + "projectName": "project-cherry" + }, + { + "activeBranchRef": "main", + "projectName": "scratch" + } + ] +-- Can query for some infix of the project name +GET /api/projects?query=bana + [ + { + "activeBranchRef": "main", + "projectName": "project-banana" + } + ] +-- Should list all branches +GET /api/projects/project-apple/branches + [ + { + "branchName": "a-branch-apple" + }, + { + "branchName": "a-branch-banana" + }, + { + "branchName": "a-branch-cherry" + }, + { + "branchName": "main" + } + ] +-- Can query for some infix of the project name +GET /api/projects/project-apple/branches?query=bana + [ + { + "branchName": "a-branch-banana" + } + ] +``` From df68cc62e917a6c46339db490b886420c475f432 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Feb 2025 11:24:02 -0800 Subject: [PATCH 15/25] Clean up error reporting --- unison-cli/src/Unison/Cli/DownloadUtils.hs | 6 ++---- unison-cli/src/Unison/Codebase/Editor/Output.hs | 1 + unison-cli/src/Unison/CommandLine/OutputMessages.hs | 1 + 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 50e89dd354..5cae49f49c 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -74,10 +74,8 @@ downloadProjectBranchFromShare syncVersion useSquashed branch = 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.SyncError pullErr -> + Output.ShareErrorPullV2 pullErr Share.TransportError err -> Output.ShareErrorTransport err pure (Sync.Common.hash32ToCausalHash (Share.hashJWTHash causalHashJwt)) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 2519967aed..b3a7f1cc60 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -475,6 +475,7 @@ data ShareError = ShareErrorDownloadEntities Share.DownloadEntitiesError | ShareErrorGetCausalHashByPath Sync.GetCausalHashByPathError | ShareErrorPull Sync.PullError + | ShareErrorPullV2 SyncV2.PullError | ShareErrorTransport Sync.CodeserverTransportError | ShareErrorUploadEntities Share.UploadEntitiesError | ShareExpectedSquashedHead diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 95dda95cf9..2d61f2b9ab 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2291,6 +2291,7 @@ prettyShareError = ShareErrorDownloadEntities err -> prettyDownloadEntitiesError err ShareErrorGetCausalHashByPath err -> prettyGetCausalHashByPathError err ShareErrorPull err -> prettyPullError err + ShareErrorPullV2 err -> prettyPullV2Error err ShareErrorTransport err -> prettyTransportError err ShareErrorUploadEntities err -> prettyUploadEntitiesError err ShareExpectedSquashedHead -> "The server failed to provide a squashed branch head when requested. Please report this as a bug to the Unison team." From 18299ba656c858f0fbd2a8670c12300f2f7b0827 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Feb 2025 11:54:43 -0800 Subject: [PATCH 16/25] Rename progress markers --- unison-cli/src/Unison/Share/SyncV2.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index d4e64e9cce..ec65a4ca13 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -541,18 +541,18 @@ counterProgress msgBuilder action = do -- | Track how many entities have been downloaded using a counter stream. withStreamProgressCallback :: (MonadIO m, MonadUnliftIO n) => Maybe Int -> (ConduitT i i m () -> n a) -> n a withStreamProgressCallback total action = do - let msg n = "\n Processed " <> tShow n <> maybe "" (\total -> " / " <> tShow total) total <> " entities...\n\n" + let msg n = "\n 📦 Unpacked " <> tShow n <> maybe "" (\total -> " / " <> tShow total) total <> " entities...\n\n" let action' f = action (C.iterM \_i -> f 1) counterProgress msg action' -- | Track how many entities have been saved. withEntitySavingCallback :: (MonadUnliftIO m) => Maybe Int -> ((Int -> m ()) -> m a) -> m a withEntitySavingCallback total action = do - let msg n = "\n Saved " <> tShow n <> maybe "" (\total -> " / " <> tShow total) total <> " entities...\n\n" + let msg n = "\n 💾 Saved " <> tShow n <> maybe "" (\total -> " / " <> tShow total) total <> " new entities...\n\n" counterProgress msg action -- | Track how many entities have been loaded. withEntityLoadingCallback :: (MonadUnliftIO m) => ((Int -> m ()) -> m a) -> m a withEntityLoadingCallback action = do - let msg n = "\n Loading " <> tShow n <> " entities...\n\n" + let msg n = "\n 📦 Unpacked " <> tShow n <> " entities...\n\n" counterProgress msg action From 2c234cb9b286c4504fd534f897293e26b3e93f92 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 28 Jan 2025 15:27:46 -0800 Subject: [PATCH 17/25] Add API and implementation for negotiating which causals to sync --- unison-cli/src/Unison/Share/SyncV2.hs | 68 ++++++++++++++++++--- unison-share-api/src/Unison/SyncV2/API.hs | 8 ++- unison-share-api/src/Unison/SyncV2/Types.hs | 58 ++++++++++++++++++ 3 files changed, 126 insertions(+), 8 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index ec65a4ca13..8f297d2bea 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -22,7 +22,8 @@ import Data.Attoparsec.ByteString.Char8 qualified as A8 import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BL import Data.Conduit.Attoparsec qualified as C -import Data.Conduit.List qualified as C +import Data.Conduit.Combinators qualified as C +import Data.Conduit.List qualified as CL import Data.Conduit.Zlib qualified as C import Data.Foldable qualified as Foldable import Data.Graph qualified as Graph @@ -148,13 +149,13 @@ syncFromCodeserver :: SyncV2.BranchRef -> -- | The hash to download. Share.HashJWT -> - Set Hash32 -> -- | Callback that's given a number of entities we just downloaded. (Int -> IO ()) -> Cli (Either (SyncError SyncV2.PullError) ()) -syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt knownHashes _downloadedCallback = do +syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt _downloadedCallback = do Cli.Env {authHTTPClient, codebase} <- ask runExceptT do + knownHashes <- ExceptT $ negotiateKnownCausals unisonShareUrl branchRef hashJwt let hash = Share.hashJWTHash hashJwt ExceptT $ do (Cli.runTransaction (Q.entityLocation hash)) >>= \case @@ -247,7 +248,7 @@ syncSortedStream shouldValidate codebase stream = do validateAndSave shouldValidate codebase entityBatch C.runConduit $ stream - C..| C.chunksOf batchSize + C..| CL.chunksOf batchSize C..| unpackChunks codebase C..| handler @@ -441,13 +442,15 @@ syncAPI :: Proxy SyncAPI syncAPI = Proxy @SyncAPI downloadEntitiesStreamClientM :: SyncV2.DownloadEntitiesRequest -> Servant.ClientM (Servant.SourceT IO (CBORStream SyncV2.DownloadEntitiesChunk)) +causalDependenciesStreamClientM :: SyncV2.CausalDependenciesRequest -> Servant.ClientM (Servant.SourceT IO (CBORStream SyncV2.CausalDependenciesChunk)) SyncV2.Routes - { downloadEntitiesStream = downloadEntitiesStreamClientM + { downloadEntitiesStream = downloadEntitiesStreamClientM, + causalDependenciesStream = causalDependenciesStreamClientM } = Servant.client syncAPI -- | Helper for running clientM that returns a stream of entities. -- You MUST consume the stream within the callback, it will be closed when the callback returns. -withConduit :: forall r. Servant.ClientEnv -> (Stream () (SyncV2.DownloadEntitiesChunk) -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORStream SyncV2.DownloadEntitiesChunk)) -> StreamM r +withConduit :: forall r chunk. Servant.ClientEnv -> (Stream () chunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORStream chunk)) -> StreamM r withConduit clientEnv callback clientM = do ExceptT $ withRunInIO \runInIO -> do Servant.withClientM clientM clientEnv $ \case @@ -480,7 +483,6 @@ handleClientError clientEnv err = -- | Stream entities from the codeserver. httpStreamEntities :: - forall. Auth.AuthenticatedHttpClient -> Servant.BaseUrl -> SyncV2.DownloadEntitiesRequest -> @@ -522,6 +524,58 @@ initializeStream stream = do SyncV2.ErrorC (SyncV2.ErrorChunk err) -> throwError . SyncError $ SyncV2.PullError'DownloadEntities err SyncV2.InitialC {} -> throwError . SyncError $ SyncV2.PullError'Sync SyncV2.SyncErrorMisplacedInitialChunk +------------------------------------------------------------------------------------------------------------------------ +-- Causal Dependency negotiation +------------------------------------------------------------------------------------------------------------------------ + +httpStreamCausalDependencies :: + forall r. + Auth.AuthenticatedHttpClient -> + Servant.BaseUrl -> + SyncV2.CausalDependenciesRequest -> + (Stream () SyncV2.CausalDependenciesChunk -> StreamM r) -> + StreamM r +httpStreamCausalDependencies (Auth.AuthenticatedHttpClient httpClient) unisonShareUrl req callback = do + let clientEnv = + (Servant.mkClientEnv httpClient unisonShareUrl) + { Servant.makeClientRequest = \url request -> + -- Disable client-side timeouts + (Servant.defaultMakeClientRequest url request) + <&> \r -> + r + { Http.Client.responseTimeout = Http.Client.responseTimeoutNone + } + } + (causalDependenciesStreamClientM req) & withConduit clientEnv callback + +-- | Ask Share for the dependencies of a given hash jwt, +-- then filter them to get the set of causals which we have and don't need sent. +negotiateKnownCausals :: + -- | The Unison Share URL. + Servant.BaseUrl -> + -- | The branch to download from. + SyncV2.BranchRef -> + -- | The hash to download. + Share.HashJWT -> + Cli (Either (SyncError SyncV2.PullError) (Set Hash32)) +negotiateKnownCausals unisonShareUrl branchRef hashJwt = do + Cli.Env {authHTTPClient, codebase} <- ask + Timing.time "Causal Negotiation" $ do + liftIO . C.runResourceT . runExceptT $ httpStreamCausalDependencies + authHTTPClient + unisonShareUrl + SyncV2.CausalDependenciesRequest {branchRef, rootCausal = hashJwt} + \stream -> do + Set.fromList <$> C.runConduit (stream C..| C.map unpack C..| C.filterM (haveCausalHash codebase) C..| C.sinkList) + where + unpack :: SyncV2.CausalDependenciesChunk -> Hash32 + unpack = \case + SyncV2.HashC causalHash -> causalHash + haveCausalHash :: Codebase.Codebase IO v a -> Hash32 -> StreamM Bool + haveCausalHash codebase causalHash = do + liftIO $ Codebase.runTransaction codebase do + Q.causalExistsByHash32 causalHash + ------------------------------------------------------------------------------------------------------------------------ -- Progress Tracking ------------------------------------------------------------------------------------------------------------------------ diff --git a/unison-share-api/src/Unison/SyncV2/API.hs b/unison-share-api/src/Unison/SyncV2/API.hs index 4aec0e6b54..b4ed916475 100644 --- a/unison-share-api/src/Unison/SyncV2/API.hs +++ b/unison-share-api/src/Unison/SyncV2/API.hs @@ -23,7 +23,13 @@ type DownloadEntitiesStream = ReqBody '[CBOR, JSON] DownloadEntitiesRequest :> StreamPost NoFraming OctetStream (SourceIO (CBORStream DownloadEntitiesChunk)) +-- | Get the relevant dependencies of a causal, including the causal spine and the causal hashes of any library roots. +type CausalDependenciesStream = + ReqBody '[CBOR, JSON] CausalDependenciesRequest + :> StreamPost NetstringFraming CBOR (SourceIO CausalDependenciesChunk) + data Routes mode = Routes - { downloadEntitiesStream :: mode :- "entities" :> "download" :> DownloadEntitiesStream + { downloadEntitiesStream :: mode :- "entities" :> "download" :> DownloadEntitiesStream, + causalDependenciesStream :: mode :- "entities" :> "dependencies" :> CausalDependenciesStream } deriving stock (Generic) diff --git a/unison-share-api/src/Unison/SyncV2/Types.hs b/unison-share-api/src/Unison/SyncV2/Types.hs index c2935110d9..9868b9c441 100644 --- a/unison-share-api/src/Unison/SyncV2/Types.hs +++ b/unison-share-api/src/Unison/SyncV2/Types.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE RecordWildCards #-} + module Unison.SyncV2.Types ( DownloadEntitiesRequest (..), DownloadEntitiesChunk (..), @@ -6,6 +8,8 @@ module Unison.SyncV2.Types StreamInitInfo (..), SyncError (..), DownloadEntitiesError (..), + CausalDependenciesRequest (..), + CausalDependenciesChunk (..), CBORBytes (..), CBORStream(..), EntityKind (..), @@ -24,6 +28,7 @@ import Codec.Serialise qualified as CBOR import Codec.Serialise.Decoding qualified as CBOR import Control.Exception (Exception) import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=)) +import Data.Aeson qualified as Aeson import Data.Map (Map) import Data.Map qualified as Map import Data.Set (Set) @@ -299,3 +304,56 @@ instance Serialise EntityKind where 3 -> pure TypeEntity 4 -> pure PatchEntity _ -> fail "invalid tag" + +------------------------------------------------------------------------------------------------------------------------ +-- Causal Dependencies + +data CausalDependenciesRequest = CausalDependenciesRequest + { branchRef :: BranchRef, + rootCausal :: HashJWT + } + deriving stock (Show, Eq, Ord) + +instance ToJSON CausalDependenciesRequest where + toJSON (CausalDependenciesRequest branchRef rootCausal) = + object + [ "branch_ref" .= branchRef, + "root_causal" .= rootCausal + ] + +instance FromJSON CausalDependenciesRequest where + parseJSON = Aeson.withObject "CausalDependenciesRequest" \obj -> do + branchRef <- obj .: "branch_ref" + rootCausal <- obj .: "root_causal" + pure CausalDependenciesRequest {..} + +instance Serialise CausalDependenciesRequest where + encode (CausalDependenciesRequest {branchRef, rootCausal}) = + encode branchRef <> encode rootCausal + decode = CausalDependenciesRequest <$> decode <*> decode + +-- | A chunk of the download entities response stream. +data CausalDependenciesChunk + = HashC Hash32 + deriving (Show, Eq, Ord) + +data CausalDependenciesChunkTag = HashChunkTag + deriving (Show, Eq, Ord) + +instance Serialise CausalDependenciesChunkTag where + encode = \case + HashChunkTag -> CBOR.encodeWord8 0 + decode = do + tag <- CBOR.decodeWord8 + case tag of + 0 -> pure HashChunkTag + _ -> fail "invalid tag" + +instance Serialise CausalDependenciesChunk where + encode = \case + (HashC ch) -> do + encode HashChunkTag <> CBOR.encode ch + decode = do + tag <- decode + case tag of + HashChunkTag -> HashC <$> CBOR.decode From 32aae20f59c09ff21aa2484b9440384bd8accc53 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Jan 2025 11:43:54 -0800 Subject: [PATCH 18/25] Get building --- unison-cli/src/Unison/Cli/DownloadUtils.hs | 5 +---- unison-cli/src/Unison/Share/SyncV2.hs | 2 +- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 5cae49f49c..68c21dc6a2 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -11,7 +11,6 @@ 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 @@ -67,11 +66,9 @@ downloadProjectBranchFromShare syncVersion useSquashed branch = 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 <- SyncV2.syncFromCodeserver shouldValidate Share.hardCodedBaseUrl branchRef causalHashJwt downloadedCallback result & onLeft \err0 -> do done case err0 of Share.SyncError pullErr -> diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 8f297d2bea..5c6fdba7c7 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -219,7 +219,7 @@ syncUnsortedStream shouldValidate codebase stream = do allEntities <- C.runConduit $ stream - C..| C.chunksOf batchSize + C..| CL.chunksOf batchSize C..| unpackChunks codebase C..| validateBatch C..| C.concat From 3e7f26342cd9e9776a1c746d42c5b2d47591956c Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Jan 2025 13:56:27 -0800 Subject: [PATCH 19/25] Switch causal dependency stream to CBORStream --- unison-cli/src/Unison/Share/SyncV2.hs | 12 +++--- unison-share-api/src/Unison/SyncV2/API.hs | 2 +- unison-share-api/src/Unison/SyncV2/Types.hs | 45 +++++++++++++++++---- 3 files changed, 44 insertions(+), 15 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 5c6fdba7c7..4eda9ac8d9 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -386,7 +386,7 @@ _decodeFramedEntity bs = do Right chunk -> pure chunk -- | Unpacks a stream of tightly-packed CBOR entities without any framing/separators. -decodeUnframedEntities :: Stream ByteString SyncV2.DownloadEntitiesChunk +decodeUnframedEntities :: forall a. (CBOR.Serialise a) => Stream ByteString a decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do C.await >>= \case Nothing -> pure () @@ -394,13 +394,13 @@ decodeUnframedEntities = C.transPipe (mapExceptT (lift . stToIO)) $ do d <- newDecoder loop bs d where - newDecoder :: ConduitT ByteString SyncV2.DownloadEntitiesChunk (ExceptT SyncErr (ST s)) (Maybe ByteString -> ST s (CBOR.IDecode s (SyncV2.DownloadEntitiesChunk))) + newDecoder :: ConduitT ByteString a (ExceptT SyncErr (ST s)) (Maybe ByteString -> ST s (CBOR.IDecode s a)) newDecoder = do (lift . lift) CBOR.deserialiseIncremental >>= \case CBOR.Done _ _ _ -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorStreamFailure "Invalid initial decoder" CBOR.Fail _ _ err -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorDeserializationFailure err CBOR.Partial k -> pure k - loop :: ByteString -> (Maybe ByteString -> ST s (CBOR.IDecode s (SyncV2.DownloadEntitiesChunk))) -> ConduitT ByteString SyncV2.DownloadEntitiesChunk (ExceptT SyncErr (ST s)) () + loop :: ByteString -> (Maybe ByteString -> ST s (CBOR.IDecode s a)) -> ConduitT ByteString a (ExceptT SyncErr (ST s)) () loop bs k = do (lift . lift) (k (Just bs)) >>= \case CBOR.Fail _ _ err -> throwError . SyncError . SyncV2.PullError'Sync $ SyncV2.SyncErrorDeserializationFailure err @@ -450,7 +450,7 @@ SyncV2.Routes -- | Helper for running clientM that returns a stream of entities. -- You MUST consume the stream within the callback, it will be closed when the callback returns. -withConduit :: forall r chunk. Servant.ClientEnv -> (Stream () chunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORStream chunk)) -> StreamM r +withConduit :: forall r chunk. (CBOR.Serialise chunk) => Servant.ClientEnv -> (Stream () chunk -> StreamM r) -> Servant.ClientM (Servant.SourceIO (CBORStream chunk)) -> StreamM r withConduit clientEnv callback clientM = do ExceptT $ withRunInIO \runInIO -> do Servant.withClientM clientM clientEnv $ \case @@ -459,7 +459,7 @@ withConduit clientEnv callback clientM = do conduit <- liftIO $ Servant.fromSourceIO sourceT (runInIO . runExceptT $ callback (conduit C..| unpackCBORBytesStream)) -unpackCBORBytesStream :: Stream (CBORStream SyncV2.DownloadEntitiesChunk) SyncV2.DownloadEntitiesChunk +unpackCBORBytesStream :: (CBOR.Serialise a) => Stream (CBORStream a) a unpackCBORBytesStream = C.map (BL.toStrict . coerce @_ @BL.ByteString) C..| decodeUnframedEntities @@ -570,7 +570,7 @@ negotiateKnownCausals unisonShareUrl branchRef hashJwt = do where unpack :: SyncV2.CausalDependenciesChunk -> Hash32 unpack = \case - SyncV2.HashC causalHash -> causalHash + SyncV2.CausalHashDepC {causalHash} -> causalHash haveCausalHash :: Codebase.Codebase IO v a -> Hash32 -> StreamM Bool haveCausalHash codebase causalHash = do liftIO $ Codebase.runTransaction codebase do diff --git a/unison-share-api/src/Unison/SyncV2/API.hs b/unison-share-api/src/Unison/SyncV2/API.hs index b4ed916475..ef80d3d1cf 100644 --- a/unison-share-api/src/Unison/SyncV2/API.hs +++ b/unison-share-api/src/Unison/SyncV2/API.hs @@ -26,7 +26,7 @@ type DownloadEntitiesStream = -- | Get the relevant dependencies of a causal, including the causal spine and the causal hashes of any library roots. type CausalDependenciesStream = ReqBody '[CBOR, JSON] CausalDependenciesRequest - :> StreamPost NetstringFraming CBOR (SourceIO CausalDependenciesChunk) + :> StreamPost NoFraming OctetStream (SourceIO (CBORStream CausalDependenciesChunk)) data Routes mode = Routes { downloadEntitiesStream :: mode :- "entities" :> "download" :> DownloadEntitiesStream, diff --git a/unison-share-api/src/Unison/SyncV2/Types.hs b/unison-share-api/src/Unison/SyncV2/Types.hs index 9868b9c441..52f6c543b8 100644 --- a/unison-share-api/src/Unison/SyncV2/Types.hs +++ b/unison-share-api/src/Unison/SyncV2/Types.hs @@ -11,7 +11,7 @@ module Unison.SyncV2.Types CausalDependenciesRequest (..), CausalDependenciesChunk (..), CBORBytes (..), - CBORStream(..), + CBORStream (..), EntityKind (..), serialiseCBORBytes, deserialiseOrFailCBORBytes, @@ -332,28 +332,57 @@ instance Serialise CausalDependenciesRequest where encode branchRef <> encode rootCausal decode = CausalDependenciesRequest <$> decode <*> decode +data DependencyType + = -- This is a top-level history node of the root we're pulling. + CausalSpineDependency + | -- This is the causal root of a library dependency. + LibDependency + deriving (Show, Eq, Ord) + +instance Serialise DependencyType where + encode = \case + CausalSpineDependency -> CBOR.encodeWord8 0 + LibDependency -> CBOR.encodeWord8 1 + decode = do + tag <- CBOR.decodeWord8 + case tag of + 0 -> pure CausalSpineDependency + 1 -> pure LibDependency + _ -> fail "invalid tag" + +instance ToJSON DependencyType where + toJSON = \case + CausalSpineDependency -> "causal_spine" + LibDependency -> "lib" + +instance FromJSON DependencyType where + parseJSON = Aeson.withText "DependencyType" \case + "causal_spine" -> pure CausalSpineDependency + "lib" -> pure LibDependency + _ -> fail "invalid DependencyType" + -- | A chunk of the download entities response stream. data CausalDependenciesChunk - = HashC Hash32 + = CausalHashDepC {causalHash :: Hash32, dependencyType :: DependencyType} deriving (Show, Eq, Ord) -data CausalDependenciesChunkTag = HashChunkTag +data CausalDependenciesChunkTag = CausalHashDepChunkTag deriving (Show, Eq, Ord) instance Serialise CausalDependenciesChunkTag where encode = \case - HashChunkTag -> CBOR.encodeWord8 0 + CausalHashDepChunkTag -> CBOR.encodeWord8 0 decode = do tag <- CBOR.decodeWord8 case tag of - 0 -> pure HashChunkTag + 0 -> pure CausalHashDepChunkTag _ -> fail "invalid tag" instance Serialise CausalDependenciesChunk where encode = \case - (HashC ch) -> do - encode HashChunkTag <> CBOR.encode ch + (CausalHashDepC {causalHash, dependencyType}) -> do + encode CausalHashDepChunkTag <> CBOR.encode causalHash <> CBOR.encode dependencyType decode = do tag <- decode case tag of - HashChunkTag -> HashC <$> CBOR.decode + CausalHashDepChunkTag -> CausalHashDepC <$> CBOR.decode <*> CBOR.decode From 3e6720928859b73792d3872b3257ecb9c55d7f11 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Jan 2025 16:14:22 -0800 Subject: [PATCH 20/25] Take dependencies till we know enough, then hang up. --- unison-cli/src/Unison/Share/SyncV2.hs | 30 ++++++++++++++++++--- unison-share-api/src/Unison/SyncV2/Types.hs | 1 + 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 4eda9ac8d9..de7bbbef01 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -63,7 +63,7 @@ import Unison.Sync.Types qualified as Share import Unison.Sync.Types qualified as Sync import Unison.SyncV2.API (Routes (downloadEntitiesStream)) import Unison.SyncV2.API qualified as SyncV2 -import Unison.SyncV2.Types (CBORBytes, CBORStream) +import Unison.SyncV2.Types (CBORBytes, CBORStream, DependencyType (..)) import Unison.SyncV2.Types qualified as SyncV2 import Unison.Util.Servant.CBOR qualified as CBOR import Unison.Util.Timing qualified as Timing @@ -566,11 +566,33 @@ negotiateKnownCausals unisonShareUrl branchRef hashJwt = do unisonShareUrl SyncV2.CausalDependenciesRequest {branchRef, rootCausal = hashJwt} \stream -> do - Set.fromList <$> C.runConduit (stream C..| C.map unpack C..| C.filterM (haveCausalHash codebase) C..| C.sinkList) + Set.fromList <$> C.runConduit (stream C..| C.map unpack C..| findKnownDeps codebase C..| C.sinkList) where - unpack :: SyncV2.CausalDependenciesChunk -> Hash32 + -- Go through the dependencies of the remote root from top-down, yielding all causal hashes that we already + -- have until we find one in the causal spine we already have, then yield that one and stop since we'll implicitly + -- have all of its dependencies. + findKnownDeps :: Codebase.Codebase IO v a -> Stream (Hash32, DependencyType) Hash32 + findKnownDeps codebase = do + C.await >>= \case + Just (hash, LibDependency) -> do + -- We yield all lib dependencies we have, it's possible we don't have any of the causal spine in common, but _do_ have + -- some of the libraries we can still save a lot of work. + whenM (lift $ haveCausalHash codebase hash) (C.yield hash) + -- We continue regardless. + findKnownDeps codebase + Just (hash, CausalSpineDependency) -> do + lift (haveCausalHash codebase hash) >>= \case + True -> do + -- If we find a causal hash we have in the spine, we don't need to look further, + -- we can pass it on, then hang up the stream. + C.yield hash + False -> do + -- Otherwise we keep looking, maybe we'll have one further in. + findKnownDeps codebase + Nothing -> pure () + unpack :: SyncV2.CausalDependenciesChunk -> (Hash32, DependencyType) unpack = \case - SyncV2.CausalHashDepC {causalHash} -> causalHash + SyncV2.CausalHashDepC {causalHash, dependencyType} -> (causalHash, dependencyType) haveCausalHash :: Codebase.Codebase IO v a -> Hash32 -> StreamM Bool haveCausalHash codebase causalHash = do liftIO $ Codebase.runTransaction codebase do diff --git a/unison-share-api/src/Unison/SyncV2/Types.hs b/unison-share-api/src/Unison/SyncV2/Types.hs index 52f6c543b8..0a716a5c37 100644 --- a/unison-share-api/src/Unison/SyncV2/Types.hs +++ b/unison-share-api/src/Unison/SyncV2/Types.hs @@ -10,6 +10,7 @@ module Unison.SyncV2.Types DownloadEntitiesError (..), CausalDependenciesRequest (..), CausalDependenciesChunk (..), + DependencyType (..), CBORBytes (..), CBORStream (..), EntityKind (..), From 51cf2b2b4c22acc5ba051282b84f4ecdbc6ed80b Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Feb 2025 16:47:49 -0800 Subject: [PATCH 21/25] Clear temp entity tables before starting a syncv2 --- unison-cli/src/Unison/Share/SyncV2.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index de7bbbef01..7ec0181ae4 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -117,6 +117,9 @@ syncFromFile :: Cli (Either (SyncError SyncV2.PullError) CausalHash) syncFromFile shouldValidate syncFilePath = do Cli.Env {codebase} <- ask + -- Every insert into SQLite checks the temp entity tables, but syncv2 doesn't actually use them, so it's faster + -- if we clear them out before starting a sync. + Cli.runTransaction Q.clearTempEntityTables runExceptT do mapExceptT liftIO $ Timing.time "File Sync" $ do header <- mapExceptT C.runResourceT $ do @@ -136,6 +139,9 @@ syncFromCodebase :: CausalHash -> IO (Either (SyncError SyncV2.PullError) ()) syncFromCodebase shouldValidate srcConn destCodebase causalHash = do + -- Every insert into SQLite checks the temp entity tables, but syncv2 doesn't actually use them, so it's faster + -- if we clear them out before starting a sync. + Sqlite.runTransaction srcConn Q.clearTempEntityTables liftIO . C.runResourceT . runExceptT $ withCodebaseEntityStream srcConn causalHash Nothing \_total entityStream -> do (header, rest) <- initializeStream entityStream streamIntoCodebase shouldValidate destCodebase header rest @@ -154,6 +160,9 @@ syncFromCodeserver :: Cli (Either (SyncError SyncV2.PullError) ()) syncFromCodeserver shouldValidate unisonShareUrl branchRef hashJwt _downloadedCallback = do Cli.Env {authHTTPClient, codebase} <- ask + -- Every insert into SQLite checks the temp entity tables, but syncv2 doesn't actually use them, so it's faster + -- if we clear them out before starting a sync. + Cli.runTransaction Q.clearTempEntityTables runExceptT do knownHashes <- ExceptT $ negotiateKnownCausals unisonShareUrl branchRef hashJwt let hash = Share.hashJWTHash hashJwt From 40af0b1aacf75fd45b110cf2dd24abf156dc224d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Tue, 4 Feb 2025 20:56:12 -0800 Subject: [PATCH 22/25] Progress tick on negotiation --- unison-cli/src/Unison/Share/SyncV2.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index 7ec0181ae4..d3b215c4a2 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -569,6 +569,7 @@ negotiateKnownCausals :: Cli (Either (SyncError SyncV2.PullError) (Set Hash32)) negotiateKnownCausals unisonShareUrl branchRef hashJwt = do Cli.Env {authHTTPClient, codebase} <- ask + liftIO $ Text.hPutStrLn IO.stderr $ " 🔎 Identifying missing entities..." Timing.time "Causal Negotiation" $ do liftIO . C.runResourceT . runExceptT $ httpStreamCausalDependencies authHTTPClient From 9516179a79dfa73d30d8a91220d43a098f4e70f5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Feb 2025 10:15:38 -0800 Subject: [PATCH 23/25] Set Sync version via env var --- docs/configuration.md | 13 ++++++++++-- unison-cli/src/Unison/Cli/DownloadUtils.hs | 17 ++++++++++++--- .../src/Unison/Codebase/Editor/HandleInput.hs | 2 +- .../Codebase/Editor/HandleInput/InstallLib.hs | 2 +- .../Editor/HandleInput/ProjectClone.hs | 4 ++-- .../Editor/HandleInput/ProjectCreate.hs | 4 ++-- .../Codebase/Editor/HandleInput/Pull.hs | 5 ++--- .../Codebase/Editor/HandleInput/SyncV2.hs | 4 ++-- .../src/Unison/Codebase/Editor/Input.hs | 6 +----- .../src/Unison/CommandLine/InputPatterns.hs | 21 ++++++------------- unison-cli/src/Unison/Share/SyncV2.hs | 2 +- 11 files changed, 43 insertions(+), 37 deletions(-) diff --git a/docs/configuration.md b/docs/configuration.md index 549f274a2a..87d38dca3a 100644 --- a/docs/configuration.md +++ b/docs/configuration.md @@ -10,6 +10,7 @@ * [`UNISON_SHARE_ACCESS_TOKEN`](#unison_share_access_token) * [`UNISON_READONLY`](#unison_readonly) * [`UNISON_ENTITY_VALIDATION`](#unison_entity_validation) + * [`UNISON_SYNC_VERSION`](#unison_sync_version) * [Local Codebase Server](#local-codebase-server) * [Codebase Configuration](#codebase-configuration) @@ -17,7 +18,7 @@ ### `UNISON_DEBUG` -Enable debugging output for various portions of the application. +Enable debugging output for various portions of the application. See `lib/unison-prelude/src/Unison/Debug.hs` for the full list of supported flags. E.g. @@ -62,7 +63,7 @@ Note for Windows users: Due to an outstanding issue with GHC's IO manager on Win Enabling the LSP on windows can cause UCM to hang on exit and may require the process to be killed by the operating system or via Ctrl-C. Note that this doesn't pose any risk of codebase corruption or cause any known issues, it's simply an annoyance. -If you accept this annoyance, you can enable the LSP server on Windows by exporting the `UNISON_LSP_ENABLED=true` environment variable. +If you accept this annoyance, you can enable the LSP server on Windows by exporting the `UNISON_LSP_ENABLED=true` environment variable. You can set this persistently in powershell using: @@ -117,6 +118,14 @@ Defaults to enabled. $ UNISON_ENTITY_VALIDATION="false" ucm ``` +### `UNISON_SYNC_VERSION` + +Allows enabling the experimental Sync Version 2 protocol when downloading code from Share. + +```sh +$ UNISON_ENTITY_VALIDATION="2" ucm +``` + ### `UNISON_PULL_WORKERS` Allows setting the number of workers to use when pulling from a codebase server. diff --git a/unison-cli/src/Unison/Cli/DownloadUtils.hs b/unison-cli/src/Unison/Cli/DownloadUtils.hs index 68c21dc6a2..936b2b3fba 100644 --- a/unison-cli/src/Unison/Cli/DownloadUtils.hs +++ b/unison-cli/src/Unison/Cli/DownloadUtils.hs @@ -12,13 +12,13 @@ import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (modifyTVar', newTVarIO, readTVar, readTVarIO) import Data.List.NonEmpty (pattern (:|)) import System.Console.Regions qualified as Console.Regions +import System.IO.Unsafe (unsafePerformIO) import U.Codebase.HashTags (CausalHash) import U.Codebase.Sqlite.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 @@ -35,15 +35,26 @@ import Unison.Share.Types (codeserverBaseURL) import Unison.Sync.Common qualified as Sync.Common import Unison.Sync.Types qualified as Share import Unison.SyncV2.Types qualified as SyncV2 +import UnliftIO.Environment qualified as UnliftIO + +data SyncVersion = SyncV1 | SyncV2 + deriving (Eq, Show) + +-- | The version of the sync protocol to use. +syncVersion :: SyncVersion +syncVersion = unsafePerformIO do + UnliftIO.lookupEnv "UNISON_SYNC_VERSION" + <&> \case + Just "2" -> SyncV2 + _ -> SyncV1 -- | Download a project/branch from Share. downloadProjectBranchFromShare :: (HasCallStack) => - SyncVersion -> Share.IncludeSquashedHead -> Share.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) -downloadProjectBranchFromShare syncVersion useSquashed branch = +downloadProjectBranchFromShare useSquashed branch = Cli.labelE \done -> do let remoteProjectBranchName = branch.branchName causalHashJwt <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 6675a49843..3924afa1aa 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/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 syncVersion sourceTarget pullMode -> handlePull syncVersion sourceTarget pullMode + PullI sourceTarget pullMode -> handlePull sourceTarget pullMode PushRemoteBranchI pushRemoteBranchInput -> handlePushRemoteBranch pushRemoteBranchInput SyncToFileI syncFileDest projectBranchName -> SyncV2.handleSyncToFile syncFileDest projectBranchName SyncFromFileI syncFileSrc projectBranchName -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs index 299f30ba47..52e70188c8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/InstallLib.hs @@ -60,7 +60,7 @@ handleInstallLib remind (ProjectAndBranch libdepProjectName unresolvedLibdepBran Cli.Env {codebase} <- ask causalHash <- - downloadProjectBranchFromShare SyncV1 Share.IncludeSquashedHead libdepProjectBranch + downloadProjectBranchFromShare Share.IncludeSquashedHead libdepProjectBranch & onLeftM (Cli.returnEarly . Output.ShareError) remoteBranchObject <- liftIO (Codebase.expectBranchForHash codebase causalHash) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs index 670a730b5e..8a872d18b8 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectClone.hs +++ b/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 (SyncVersion (..), downloadProjectBranchFromShare) +import Unison.Cli.DownloadUtils (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 SyncV1 Share.NoSquashedHead remoteProjectBranch + downloadProjectBranchFromShare Share.NoSquashedHead remoteProjectBranch & onLeftM (Cli.returnEarly . Output.ShareError) localProjectAndBranch <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs index 0096a91d8d..e9f6e99e95 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/ProjectCreate.hs +++ b/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 (SyncVersion (..), downloadProjectBranchFromShare) +import Unison.Cli.DownloadUtils (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 SyncV1 Share.NoSquashedHead baseLatestReleaseBranch + downloadProjectBranchFromShare Share.NoSquashedHead baseLatestReleaseBranch & onLeftM (Cli.returnEarly . Output.ShareError) Cli.Env {codebase} <- ask baseLatestReleaseBranchObject <- diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs index e51ba1046a..3ff7012220 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Pull.hs +++ b/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 :: SyncVersion -> PullSourceTarget -> PullMode -> Cli () -handlePull syncVersion unresolvedSourceAndTarget pullMode = do +handlePull :: PullSourceTarget -> PullMode -> Cli () +handlePull unresolvedSourceAndTarget pullMode = do let includeSquashed = case pullMode of Input.PullWithHistory -> Share.NoSquashedHead Input.PullWithoutHistory -> Share.IncludeSquashedHead @@ -59,7 +59,6 @@ handlePull syncVersion 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 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs index 015e5b7630..39af010bfe 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/SyncV2.hs @@ -10,7 +10,7 @@ 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.DownloadUtils (downloadProjectBranchFromShare) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -75,4 +75,4 @@ handleSyncFromCodebase description srcCodebasePath srcBranch destBranch = do Cli.respond (Output.SyncPullError syncErr) handleSyncFromCodeserver :: Projects.IncludeSquashedHead -> Projects.RemoteProjectBranch -> Cli (Either Output.ShareError CausalHash) -handleSyncFromCodeserver = downloadProjectBranchFromShare SyncV2 +handleSyncFromCodeserver = downloadProjectBranchFromShare diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index b386cd98b2..75de97cd1a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -31,7 +31,6 @@ module Unison.Codebase.Editor.Input -- * Type aliases ErrorMessageOrName, RawQuery, - SyncVersion (..), ) where @@ -60,9 +59,6 @@ data Event = UnisonFileChanged SourceName Source deriving stock (Show) -data SyncVersion = SyncV1 | SyncV2 - deriving (Eq, Show) - type Source = Text -- "id x = x\nconst a b = a" type SourceName = Text -- "foo.u" or "buffer 7" @@ -138,7 +134,7 @@ data Input MergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) Branch.MergeMode | PreviewMergeLocalBranchI BranchRelativePath (Maybe BranchRelativePath) | DiffNamespaceI BranchId2 BranchId2 -- old new - | PullI !SyncVersion !PullSourceTarget !PullMode + | PullI !PullSourceTarget !PullMode | PushRemoteBranchI PushRemoteBranchInput | SyncToFileI FilePath (ProjectAndBranch (Maybe ProjectName) (Maybe ProjectBranchName)) | SyncFromFileI FilePath UnresolvedProjectBranch diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index c17759e418..b003e374a2 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -92,7 +92,6 @@ module Unison.CommandLine.InputPatterns projectSwitch, projectsInputPattern, pull, - pullV2, pullWithoutHistory, push, pushCreate, @@ -1788,13 +1787,7 @@ reset = pull :: InputPattern pull = - pullImpl "pull" [] Input.PullWithHistory "" Input.SyncV1 - -pullV2 :: InputPattern -pullV2 = - (pullImpl "pull.v2" [] Input.PullWithHistory "" Input.SyncV2) - {I.visibility = I.Hidden - } + pullImpl "pull" [] Input.PullWithHistory "" pullWithoutHistory :: InputPattern pullWithoutHistory = @@ -1803,10 +1796,9 @@ pullWithoutHistory = [] Input.PullWithoutHistory "without including the remote's history. This usually results in smaller codebase sizes." - Input.SyncV1 -pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> Input.SyncVersion -> InputPattern -pullImpl name aliases pullMode addendum syncVersion = do +pullImpl :: String -> [String] -> Input.PullMode -> P.Pretty CT.ColorText -> InputPattern +pullImpl name aliases pullMode addendum = do self where self = @@ -1850,10 +1842,10 @@ pullImpl name aliases pullMode addendum syncVersion = do explainRemote Pull ], parse = \case - [] -> pure $ Input.PullI syncVersion Input.PullSourceTarget0 pullMode + [] -> pure $ Input.PullI Input.PullSourceTarget0 pullMode [sourceArg] -> do source <- handlePullSourceArg sourceArg - pure (Input.PullI syncVersion (Input.PullSourceTarget1 source) pullMode) + pure (Input.PullI (Input.PullSourceTarget1 source) pullMode) [sourceArg, targetArg] -> -- You used to be able to pull into a path, so this arg parser is a little complicated, because -- we want to provide helpful suggestions if you are doing a deprecated or invalid thing. @@ -1861,7 +1853,7 @@ pullImpl name aliases pullMode addendum syncVersion = do handleMaybeProjectBranchArg targetArg, handlePath'Arg targetArg ) of - (Right source, Right target, _) -> Right (Input.PullI syncVersion (Input.PullSourceTarget2 source target) pullMode) + (Right source, Right target, _) -> Right (Input.PullI (Input.PullSourceTarget2 source target) pullMode) (Left err, _, _) -> Left err -- Parsing as a path didn't work either; just show the branch parse error (Right _, Left err, Left _) -> Left err @@ -3821,7 +3813,6 @@ validInputs = projectSwitch, projectsInputPattern, pull, - pullV2, pullWithoutHistory, push, pushCreate, diff --git a/unison-cli/src/Unison/Share/SyncV2.hs b/unison-cli/src/Unison/Share/SyncV2.hs index d3b215c4a2..14870f208d 100644 --- a/unison-cli/src/Unison/Share/SyncV2.hs +++ b/unison-cli/src/Unison/Share/SyncV2.hs @@ -569,7 +569,7 @@ negotiateKnownCausals :: Cli (Either (SyncError SyncV2.PullError) (Set Hash32)) negotiateKnownCausals unisonShareUrl branchRef hashJwt = do Cli.Env {authHTTPClient, codebase} <- ask - liftIO $ Text.hPutStrLn IO.stderr $ " 🔎 Identifying missing entities..." + liftIO $ Text.hPutStrLn IO.stderr $ " 🔎 Identifying missing entities..." Timing.time "Causal Negotiation" $ do liftIO . C.runResourceT . runExceptT $ httpStreamCausalDependencies authHTTPClient From c8d360d184f275054ea7e10046470810e0a8c47d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 5 Feb 2025 11:13:16 -0800 Subject: [PATCH 24/25] Update transcript output --- .../project-outputs/docs/configuration.output.md | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/unison-src/transcripts/project-outputs/docs/configuration.output.md b/unison-src/transcripts/project-outputs/docs/configuration.output.md index 0bf4d06de5..bcae1f8b5a 100644 --- a/unison-src/transcripts/project-outputs/docs/configuration.output.md +++ b/unison-src/transcripts/project-outputs/docs/configuration.output.md @@ -9,6 +9,7 @@ - [`UNISON_SHARE_ACCESS_TOKEN`](#unison_share_access_token) - [`UNISON_READONLY`](#unison_readonly) - [`UNISON_ENTITY_VALIDATION`](#unison_entity_validation) + - [`UNISON_SYNC_VERSION`](#unison_sync_version) - [Local Codebase Server](#local-codebase-server) - [Codebase Configuration](#codebase-configuration) @@ -116,6 +117,14 @@ Defaults to enabled. $ UNISON_ENTITY_VALIDATION="false" ucm ``` +### `UNISON_SYNC_VERSION` + +Allows enabling the experimental Sync Version 2 protocol when downloading code from Share. + +``` sh +$ UNISON_ENTITY_VALIDATION="2" ucm +``` + ### `UNISON_PULL_WORKERS` Allows setting the number of workers to use when pulling from a codebase server. From 3fc349f70291fefe85649ace49cd2b6aea5e319b Mon Sep 17 00:00:00 2001 From: Dan Doel Date: Fri, 7 Feb 2025 14:25:09 -0500 Subject: [PATCH 25/25] Fix a problem with pre-evaluation in the sandboxed runtime Pre-evaluation tries to evaluate all top level values ahead of time. There are a few such values, though, that come from operations we have marked as sandboxed, like the standard handles. Documents and such would never actually use these handles, but they might be transitively referred to by the documents. Pre-evaluation was then eagerly evaluating the disallowed functions, even though the values aren't actually needed to calculate the document value. This commit just ignores sandboxing failures during pre-evaluation. They will cause there to be no stored result for the value, but as long as the document (or whatever else is being evaluated) doesn't _actually_ depend on the sandboxed value, it will evaluate fine. --- unison-runtime/src/Unison/Runtime/Machine.hs | 20 +++++++ unison-src/transcripts/idempotent/fix5506.md | 62 ++++++++++++++++++++ 2 files changed, 82 insertions(+) create mode 100644 unison-src/transcripts/idempotent/fix5506.md diff --git a/unison-runtime/src/Unison/Runtime/Machine.hs b/unison-runtime/src/Unison/Runtime/Machine.hs index 8976269e17..179310e5da 100644 --- a/unison-runtime/src/Unison/Runtime/Machine.hs +++ b/unison-runtime/src/Unison/Runtime/Machine.hs @@ -33,6 +33,7 @@ import Control.Lens import Data.Atomics qualified as Atomic import Data.Bits import Data.Functor.Classes (Eq1 (..), Ord1 (..)) +import Data.List qualified as List import Data.IORef (IORef) import Data.IORef qualified as IORef import Data.Map.Strict qualified as M @@ -2361,6 +2362,12 @@ preEvalTopLevelConstants cacheableCombs newCombs cc = do atomically $ do modifyTVar evaluatedCacheableCombsVar $ EC.mapInsert w (EC.mapSingleton 0 $ CachedVal w val) apply0 (Just hook) cc activeThreads w + `catch` \e -> + -- ignore sandboxing exceptions during pre-eval, in case they + -- don't matter for the final result. + if isSandboxingException e + then pure () + else throwIO e evaluatedCacheableCombs <- readTVarIO evaluatedCacheableCombsVar let allNew = evaluatedCacheableCombs <> newCombs @@ -2368,6 +2375,19 @@ preEvalTopLevelConstants cacheableCombs newCombs cc = do -- new cached versions. atomically $ modifyTVar (combs cc) (\existingCombs -> (resolveCombs (Just $ EC.mapDifference existingCombs allNew) allNew) <> existingCombs) +-- Checks if a runtime exception is due to sandboxing. +-- +-- This is used above during pre-evaluation, to ignore sandboxing +-- exceptions for top-level constant dependencies of docs and such, in +-- case the docs don't actually evaluate them. +isSandboxingException :: RuntimeExn -> Bool +isSandboxingException (PE _ (P.toPlainUnbroken -> msg)) = + List.isPrefixOf sdbx1 msg || List.isPrefixOf sdbx2 msg + where + sdbx1 = "attempted to use sandboxed operation" + sdbx2 = "Attempted to use disallowed builtin in sandboxed" +isSandboxingException _ = False + expandSandbox :: Map Reference (Set Reference) -> [(Reference, SuperGroup Symbol)] -> diff --git a/unison-src/transcripts/idempotent/fix5506.md b/unison-src/transcripts/idempotent/fix5506.md new file mode 100644 index 0000000000..3157d04ddd --- /dev/null +++ b/unison-src/transcripts/idempotent/fix5506.md @@ -0,0 +1,62 @@ +``` ucm :hide +scratch/main> builtins.mergeio +``` + +``` unison + +stdOut = stdHandle StdOut + +putText h t = match putBytes.impl h (Text.toUtf8 t) with + Left e -> raise e + _ -> () + +printLine t = + putText stdOut t + putText stdOut "\n" +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + printLine : Text ->{IO, Exception} () + putText : Handle -> Text ->{IO, Exception} () + stdOut : Handle +``` + +``` ucm +scratch/main> update + + Okay, I'm searching the branch for code that needs to be + updated... + + Done. +``` + +``` unison + +hmmm = {{ I'll try {printLine}. That's a good trick. }} +``` + +``` ucm :added-by-ucm + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + hmmm : Doc2 +``` + +``` ucm +scratch/main> display hmmm + + I'll try printLine. That's a good trick. +```