mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-21 07:17:25 +03:00
replace Share.Hash with U.Util.Hash32
This commit is contained in:
Mitchell Rosen
parent
7e7b911226
commit
8aa9805f9a
@ -163,6 +163,7 @@ import U.Codebase.WatchKind (WatchKind)
|
||||
import qualified U.Core.ABT as ABT
|
||||
import qualified U.Util.Base32Hex as Base32Hex
|
||||
import qualified U.Util.Hash as H
|
||||
import qualified U.Util.Hash32 as Hash32
|
||||
import qualified U.Util.Lens as Lens
|
||||
import qualified U.Util.Serialization as S
|
||||
import qualified U.Util.Term as TermUtil
|
||||
@ -186,7 +187,7 @@ newtype NeedTypeForBuiltinMetadata
|
||||
objectExistsForHash :: H.Hash -> Transaction Bool
|
||||
objectExistsForHash h =
|
||||
isJust <$> runMaybeT do
|
||||
id <- MaybeT . Q.loadHashId . H.toBase32Hex $ h
|
||||
id <- MaybeT . Q.loadHashId . Hash32.fromHash $ h
|
||||
MaybeT $ Q.loadObjectIdForAnyHashId id
|
||||
|
||||
expectValueHashByCausalHashId :: Db.CausalHashId -> Transaction BranchHash
|
||||
|
||||
@ -200,9 +200,11 @@ import qualified U.Codebase.Sqlite.TempEntityType as TempEntityType
|
||||
import qualified U.Codebase.Sqlite.Term.Format as TermFormat
|
||||
import U.Codebase.WatchKind (WatchKind)
|
||||
import qualified U.Util.Alternative as Alternative
|
||||
import U.Util.Base32Hex (Base32Hex (..))
|
||||
import U.Util.Hash (Hash)
|
||||
import qualified U.Util.Hash as Hash
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import qualified U.Util.Hash32 as Hash32
|
||||
import U.Util.Hash32.Orphans.Sqlite ()
|
||||
import Unison.Prelude
|
||||
import Unison.Sqlite
|
||||
|
||||
@ -259,28 +261,28 @@ countCausals = queryOneCol_ [here| SELECT COUNT(*) FROM causal |]
|
||||
countWatches :: Transaction Int
|
||||
countWatches = queryOneCol_ [here| SELECT COUNT(*) FROM watch |]
|
||||
|
||||
saveHash :: Base32Hex -> Transaction HashId
|
||||
saveHash base32 = execute sql (Only base32) >> expectHashId base32
|
||||
saveHash :: Hash32 -> Transaction HashId
|
||||
saveHash hash = execute sql (Only hash) >> expectHashId hash
|
||||
where sql = [here|
|
||||
INSERT INTO hash (base32) VALUES (?)
|
||||
ON CONFLICT DO NOTHING
|
||||
|]
|
||||
|
||||
saveHashHash :: Hash -> Transaction HashId
|
||||
saveHashHash = saveHash . Hash.toBase32Hex
|
||||
saveHashHash = saveHash . Hash32.fromHash
|
||||
|
||||
loadHashId :: Base32Hex -> Transaction (Maybe HashId)
|
||||
loadHashId base32 = queryMaybeCol loadHashIdSql (Only base32)
|
||||
loadHashId :: Hash32 -> Transaction (Maybe HashId)
|
||||
loadHashId hash = queryMaybeCol loadHashIdSql (Only hash)
|
||||
|
||||
expectHashId :: Base32Hex -> Transaction HashId
|
||||
expectHashId base32 = queryOneCol loadHashIdSql (Only base32)
|
||||
expectHashId :: Hash32 -> Transaction HashId
|
||||
expectHashId hash = queryOneCol loadHashIdSql (Only hash)
|
||||
|
||||
loadHashIdSql :: Sql
|
||||
loadHashIdSql =
|
||||
[here| SELECT id FROM hash WHERE base32 = ? |]
|
||||
|
||||
loadHashIdByHash :: Hash -> Transaction (Maybe HashId)
|
||||
loadHashIdByHash = loadHashId . Hash.toBase32Hex
|
||||
loadHashIdByHash = loadHashId . Hash32.fromHash
|
||||
|
||||
saveCausalHash :: CausalHash -> Transaction CausalHashId
|
||||
saveCausalHash = fmap CausalHashId . saveHashHash . unCausalHash
|
||||
@ -311,12 +313,12 @@ expectCausalByCausalHash ch = do
|
||||
pure (hId, bhId)
|
||||
|
||||
expectHashIdByHash :: Hash -> Transaction HashId
|
||||
expectHashIdByHash = expectHashId . Hash.toBase32Hex
|
||||
expectHashIdByHash = expectHashId . Hash32.fromHash
|
||||
|
||||
expectHash :: HashId -> Transaction Hash
|
||||
expectHash h = Hash.fromBase32Hex <$> expectHash32 h
|
||||
expectHash h = Hash32.toHash <$> expectHash32 h
|
||||
|
||||
expectHash32 :: HashId -> Transaction Base32Hex
|
||||
expectHash32 :: HashId -> Transaction Hash32
|
||||
expectHash32 h = queryOneCol sql (Only h)
|
||||
where sql = [here| SELECT base32 FROM hash WHERE id = ? |]
|
||||
|
||||
@ -485,22 +487,22 @@ loadObjectIdForPrimaryHash h =
|
||||
|
||||
expectObjectIdForPrimaryHash :: Hash -> Transaction ObjectId
|
||||
expectObjectIdForPrimaryHash =
|
||||
expectObjectIdForHash32 . Hash.toBase32Hex
|
||||
expectObjectIdForHash32 . Hash32.fromHash
|
||||
|
||||
expectObjectIdForHash32 :: Base32Hex -> Transaction ObjectId
|
||||
expectObjectIdForHash32 :: Hash32 -> Transaction ObjectId
|
||||
expectObjectIdForHash32 hash = do
|
||||
hashId <- expectHashId hash
|
||||
expectObjectIdForPrimaryHashId hashId
|
||||
|
||||
expectBranchObjectIdForHash32 :: Base32Hex -> Transaction BranchObjectId
|
||||
expectBranchObjectIdForHash32 :: Hash32 -> Transaction BranchObjectId
|
||||
expectBranchObjectIdForHash32 =
|
||||
fmap BranchObjectId . expectObjectIdForHash32
|
||||
|
||||
expectPatchObjectIdForHash32 :: Base32Hex -> Transaction PatchObjectId
|
||||
expectPatchObjectIdForHash32 :: Hash32 -> Transaction PatchObjectId
|
||||
expectPatchObjectIdForHash32 =
|
||||
fmap PatchObjectId . expectObjectIdForHash32
|
||||
|
||||
expectBranchHashIdForHash32 :: Base32Hex -> Transaction BranchHashId
|
||||
expectBranchHashIdForHash32 :: Hash32 -> Transaction BranchHashId
|
||||
expectBranchHashIdForHash32 = queryOneCol sql . Only
|
||||
where
|
||||
sql =
|
||||
@ -512,7 +514,7 @@ expectBranchHashIdForHash32 = queryOneCol sql . Only
|
||||
AND hash.base32 = ?
|
||||
|]
|
||||
|
||||
expectCausalHashIdForHash32 :: Base32Hex -> Transaction CausalHashId
|
||||
expectCausalHashIdForHash32 :: Hash32 -> Transaction CausalHashId
|
||||
expectCausalHashIdForHash32 = queryOneCol sql . Only
|
||||
where
|
||||
sql =
|
||||
@ -556,9 +558,9 @@ isObjectHash h =
|
||||
-- | All objects have corresponding hashes.
|
||||
expectPrimaryHashByObjectId :: ObjectId -> Transaction Hash
|
||||
expectPrimaryHashByObjectId =
|
||||
fmap Hash.fromBase32Hex . expectPrimaryHash32ByObjectId
|
||||
fmap Hash32.toHash . expectPrimaryHash32ByObjectId
|
||||
|
||||
expectPrimaryHash32ByObjectId :: ObjectId -> Transaction Base32Hex
|
||||
expectPrimaryHash32ByObjectId :: ObjectId -> Transaction Hash32
|
||||
expectPrimaryHash32ByObjectId oId = queryOneCol sql (Only oId)
|
||||
where sql = [here|
|
||||
SELECT hash.base32
|
||||
@ -625,11 +627,11 @@ flushCausalDependents chId = do
|
||||
-- 2. Delete #foo from temp_entity (if it's there)
|
||||
-- 3. For each like #bar and #baz with no more rows in temp_entity_missing_dependency,
|
||||
-- insert_entity them.
|
||||
tryMoveTempEntityDependents :: Base32Hex -> Transaction ()
|
||||
tryMoveTempEntityDependents dependencyBase32 = do
|
||||
dependents <- getMissingDependentsForTempEntity dependencyBase32
|
||||
execute deleteMissingDependency (Only dependencyBase32)
|
||||
deleteTempEntity dependencyBase32
|
||||
tryMoveTempEntityDependents :: Hash32 -> Transaction ()
|
||||
tryMoveTempEntityDependents dependency = do
|
||||
dependents <- getMissingDependentsForTempEntity dependency
|
||||
execute deleteMissingDependency (Only dependency)
|
||||
deleteTempEntity dependency
|
||||
traverse_ flushIfReadyToFlush dependents
|
||||
where
|
||||
deleteMissingDependency :: Sql
|
||||
@ -638,14 +640,14 @@ tryMoveTempEntityDependents dependencyBase32 = do
|
||||
WHERE dependency = ?
|
||||
|]
|
||||
|
||||
flushIfReadyToFlush :: Base32Hex -> Transaction ()
|
||||
flushIfReadyToFlush :: Hash32 -> Transaction ()
|
||||
flushIfReadyToFlush dependent = do
|
||||
readyToFlush dependent >>= \case
|
||||
True -> moveTempEntityToMain dependent
|
||||
False -> pure ()
|
||||
|
||||
readyToFlush :: Base32Hex -> Transaction Bool
|
||||
readyToFlush b32 = queryOneCol [here|
|
||||
readyToFlush :: Hash32 -> Transaction Bool
|
||||
readyToFlush hash = queryOneCol [here|
|
||||
SELECT EXISTS (
|
||||
SELECT 1
|
||||
FROM temp_entity
|
||||
@ -655,7 +657,7 @@ tryMoveTempEntityDependents dependencyBase32 = do
|
||||
FROM temp_entity_missing_dependency
|
||||
WHERE dependent = ?
|
||||
)
|
||||
|] (b32, b32)
|
||||
|] (hash, hash)
|
||||
|
||||
expectCausal :: CausalHashId -> Transaction Causal.SyncCausalFormat
|
||||
expectCausal hashId = do
|
||||
@ -680,7 +682,7 @@ expectCausal hashId = do
|
||||
pure Causal.SyncCausalFormat {parents, valueHash}
|
||||
|
||||
-- | Read an entity out of main storage.
|
||||
expectEntity :: Base32Hex -> Transaction SyncEntity
|
||||
expectEntity :: Hash32 -> Transaction SyncEntity
|
||||
expectEntity hash = do
|
||||
hashId <- expectHashId hash
|
||||
-- We don't know if this is an object or a causal, so just try one, then the other.
|
||||
@ -694,18 +696,18 @@ expectEntity hash = do
|
||||
Namespace -> Entity.N <$> decodeSyncNamespaceFormat bytes
|
||||
Patch -> Entity.P <$> decodeSyncPatchFormat bytes
|
||||
|
||||
moveTempEntityToMain :: Base32Hex -> Transaction ()
|
||||
moveTempEntityToMain b32 = do
|
||||
t <- expectTempEntity b32
|
||||
deleteTempEntity b32
|
||||
r <- tempToSyncEntity t
|
||||
_ <- saveSyncEntity b32 r
|
||||
moveTempEntityToMain :: Hash32 -> Transaction ()
|
||||
moveTempEntityToMain hash = do
|
||||
entity <- expectTempEntity hash
|
||||
deleteTempEntity hash
|
||||
entity' <- tempToSyncEntity entity
|
||||
_ <- saveSyncEntity hash entity'
|
||||
pure ()
|
||||
|
||||
-- | Read an entity out of temp storage.
|
||||
expectTempEntity :: Base32Hex -> Transaction TempEntity
|
||||
expectTempEntity b32 = do
|
||||
queryOneRowCheck sql (Only b32) \(blob, typeId) ->
|
||||
expectTempEntity :: Hash32 -> Transaction TempEntity
|
||||
expectTempEntity hash = do
|
||||
queryOneRowCheck sql (Only hash) \(blob, typeId) ->
|
||||
case typeId of
|
||||
TempEntityType.TermComponentType -> Entity.TC <$> decodeTempTermFormat blob
|
||||
TempEntityType.DeclComponentType -> Entity.DC <$> decodeTempDeclFormat blob
|
||||
@ -851,9 +853,9 @@ syncToTempEntity = \case
|
||||
TermFormat.SyncTerm . TermFormat.SyncLocallyIndexedComponent
|
||||
<$> Lens.traverseOf (traverse . Lens._1) (bitraverse expectText expectPrimaryHash32ByObjectId) terms
|
||||
|
||||
saveSyncEntity :: Base32Hex -> SyncEntity -> Transaction (Either CausalHashId ObjectId)
|
||||
saveSyncEntity b32Hex entity = do
|
||||
hashId <- saveHash b32Hex
|
||||
saveSyncEntity :: Hash32 -> SyncEntity -> Transaction (Either CausalHashId ObjectId)
|
||||
saveSyncEntity hash entity = do
|
||||
hashId <- saveHash hash
|
||||
case entity of
|
||||
Entity.TC stf -> do
|
||||
let bytes = runPutS (Serialization.recomposeTermFormat stf)
|
||||
@ -932,7 +934,7 @@ loadCausalParents h = queryListCol sql (Only h) where sql = [here|
|
||||
|]
|
||||
|
||||
-- | Like 'loadCausalParents', but the input and outputs are hashes, not hash ids.
|
||||
loadCausalParentsByHash :: Base32Hex -> Transaction [Base32Hex]
|
||||
loadCausalParentsByHash :: Hash32 -> Transaction [Hash32]
|
||||
loadCausalParentsByHash hash =
|
||||
queryListCol
|
||||
[here|
|
||||
@ -1440,7 +1442,7 @@ ancestorSql =
|
||||
-- * share sync / temp entities
|
||||
|
||||
-- | Does this entity already exist in the database, i.e. in the `object` or `causal` table?
|
||||
entityExists :: Base32Hex -> Transaction Bool
|
||||
entityExists :: Hash32 -> Transaction Bool
|
||||
entityExists hash = do
|
||||
-- first get hashId if exists
|
||||
loadHashId hash >>= \case
|
||||
@ -1448,7 +1450,7 @@ entityExists hash = do
|
||||
-- then check if is causal hash or if object exists for hash id
|
||||
Just hashId -> isCausalHash hashId ||^ isObjectHash hashId
|
||||
|
||||
getMissingDependencyJwtsForTempEntity :: Base32Hex -> Transaction (Maybe (NESet Text))
|
||||
getMissingDependencyJwtsForTempEntity :: Hash32 -> Transaction (Maybe (NESet Text))
|
||||
getMissingDependencyJwtsForTempEntity h = do
|
||||
jwts <-
|
||||
queryListCol
|
||||
@ -1459,7 +1461,7 @@ getMissingDependencyJwtsForTempEntity h = do
|
||||
(Only h)
|
||||
pure (NESet.nonEmptySet (Set.fromList jwts))
|
||||
|
||||
getMissingDependentsForTempEntity :: Base32Hex -> Transaction [Base32Hex]
|
||||
getMissingDependentsForTempEntity :: Hash32 -> Transaction [Hash32]
|
||||
getMissingDependentsForTempEntity h =
|
||||
queryListCol
|
||||
[here|
|
||||
@ -1474,7 +1476,7 @@ getMissingDependentsForTempEntity h =
|
||||
-- Preconditions:
|
||||
-- 1. The entity does not already exist in "main" storage (`object` / `causal`)
|
||||
-- 2. The entity does not already exist in `temp_entity`.
|
||||
insertTempEntity :: Base32Hex -> TempEntity -> NESet (Base32Hex, Text) -> Transaction ()
|
||||
insertTempEntity :: Hash32 -> TempEntity -> NESet (Hash32, Text) -> Transaction ()
|
||||
insertTempEntity entityHash entity missingDependencies = do
|
||||
execute
|
||||
[here|
|
||||
@ -1499,7 +1501,7 @@ insertTempEntity entityHash entity missingDependencies = do
|
||||
Entity.entityType entity
|
||||
|
||||
-- | Delete a row from the `temp_entity` table, if it exists.
|
||||
deleteTempEntity :: Base32Hex -> Transaction ()
|
||||
deleteTempEntity :: Hash32 -> Transaction ()
|
||||
deleteTempEntity hash =
|
||||
execute
|
||||
[here|
|
||||
|
||||
@ -14,12 +14,9 @@ import Data.Bytes.Get (MonadGet, getByteString, getWord8, runGetS)
|
||||
import Data.Bytes.Put (MonadPut, putByteString, putWord8)
|
||||
import Data.Bytes.Serial (SerialEndian (serializeBE), deserialize, deserializeBE, serialize)
|
||||
import Data.Bytes.VarInt (VarInt (VarInt), unVarInt)
|
||||
import Data.Int (Int64)
|
||||
import Data.List (elemIndex)
|
||||
import qualified Data.Set as Set
|
||||
import Data.Vector (Vector)
|
||||
import Data.Word (Word64)
|
||||
import Debug.Trace (trace)
|
||||
import qualified U.Codebase.Decl as Decl
|
||||
import U.Codebase.Kind (Kind)
|
||||
import qualified U.Codebase.Kind as Kind
|
||||
@ -46,10 +43,12 @@ import qualified U.Codebase.Sqlite.Term.Format as TermFormat
|
||||
import qualified U.Codebase.Term as Term
|
||||
import qualified U.Codebase.Type as Type
|
||||
import qualified U.Core.ABT as ABT
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import qualified U.Util.Base32Hex as Base32Hex
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import qualified U.Util.Hash32 as Hash32
|
||||
import qualified U.Util.Monoid as Monoid
|
||||
import U.Util.Serialization hiding (debug)
|
||||
import Unison.Prelude
|
||||
import Prelude hiding (getChar, putChar)
|
||||
|
||||
debug :: Bool
|
||||
@ -749,31 +748,31 @@ putTempEntity = \case
|
||||
Entity.C gdc ->
|
||||
putSyncCausal gdc
|
||||
where
|
||||
putBase32Hex = putText . Base32Hex.toText
|
||||
putHash32 = putText . Hash32.toText
|
||||
putPatchLocalIds PatchFormat.LocalIds {patchTextLookup, patchHashLookup, patchDefnLookup} = do
|
||||
putFoldable putText patchTextLookup
|
||||
putFoldable putBase32Hex patchHashLookup
|
||||
putFoldable putBase32Hex patchDefnLookup
|
||||
putFoldable putHash32 patchHashLookup
|
||||
putFoldable putHash32 patchDefnLookup
|
||||
putNamespaceLocalIds BranchFormat.LocalIds {branchTextLookup, branchDefnLookup, branchPatchLookup, branchChildLookup} = do
|
||||
putFoldable putText branchTextLookup
|
||||
putFoldable putBase32Hex branchDefnLookup
|
||||
putFoldable putBase32Hex branchPatchLookup
|
||||
putFoldable (putPair putBase32Hex putBase32Hex) branchChildLookup
|
||||
putFoldable putHash32 branchDefnLookup
|
||||
putFoldable putHash32 branchPatchLookup
|
||||
putFoldable (putPair putHash32 putHash32) branchChildLookup
|
||||
putSyncCausal Causal.SyncCausalFormat {valueHash, parents} = do
|
||||
putBase32Hex valueHash
|
||||
putFoldable putBase32Hex parents
|
||||
putHash32 valueHash
|
||||
putFoldable putHash32 parents
|
||||
putSyncFullPatch lids bytes = do
|
||||
putPatchLocalIds lids
|
||||
putFramedByteString bytes
|
||||
putSyncDiffPatch parent lids bytes = do
|
||||
putBase32Hex parent
|
||||
putHash32 parent
|
||||
putPatchLocalIds lids
|
||||
putFramedByteString bytes
|
||||
putSyncFullNamespace lids bytes = do
|
||||
putNamespaceLocalIds lids
|
||||
putFramedByteString bytes
|
||||
putSyncDiffNamespace parent lids bytes = do
|
||||
putBase32Hex parent
|
||||
putHash32 parent
|
||||
putNamespaceLocalIds lids
|
||||
putFramedByteString bytes
|
||||
putSyncTerm (TermFormat.SyncLocallyIndexedComponent vec) =
|
||||
@ -781,15 +780,15 @@ putTempEntity = \case
|
||||
-- when deserializing, because we don't think we need to (and it adds a
|
||||
-- little overhead.)
|
||||
flip putFoldable vec \(localIds, bytes) -> do
|
||||
putLocalIdsWith putText putBase32Hex localIds
|
||||
putLocalIdsWith putText putHash32 localIds
|
||||
putFramedByteString bytes
|
||||
putSyncDecl (DeclFormat.SyncLocallyIndexedComponent vec) =
|
||||
flip putFoldable vec \(localIds, bytes) -> do
|
||||
putLocalIdsWith putText putBase32Hex localIds
|
||||
putLocalIdsWith putText putHash32 localIds
|
||||
putFramedByteString bytes
|
||||
|
||||
getBase32Hex :: MonadGet m => m Base32Hex
|
||||
getBase32Hex = Base32Hex.UnsafeFromText <$> getText
|
||||
getHash32 :: MonadGet m => m Hash32
|
||||
getHash32 = Hash32.UnsafeFromBase32Hex . Base32Hex.UnsafeFromText <$> getText
|
||||
|
||||
getTempTermFormat :: MonadGet m => m TempEntity.TempTermFormat
|
||||
getTempTermFormat =
|
||||
@ -798,7 +797,7 @@ getTempTermFormat =
|
||||
TermFormat.SyncTerm . TermFormat.SyncLocallyIndexedComponent
|
||||
<$> getVector
|
||||
( getPair
|
||||
(getLocalIdsWith getText getBase32Hex)
|
||||
(getLocalIdsWith getText getHash32)
|
||||
getFramedByteString
|
||||
)
|
||||
tag -> unknownTag "getTempTermFormat" tag
|
||||
@ -810,7 +809,7 @@ getTempDeclFormat =
|
||||
DeclFormat.SyncDecl . DeclFormat.SyncLocallyIndexedComponent
|
||||
<$> getVector
|
||||
( getPair
|
||||
(getLocalIdsWith getText getBase32Hex)
|
||||
(getLocalIdsWith getText getHash32)
|
||||
getFramedByteString
|
||||
)
|
||||
tag -> unknownTag "getTempDeclFormat" tag
|
||||
@ -819,34 +818,34 @@ getTempPatchFormat :: MonadGet m => m TempEntity.TempPatchFormat
|
||||
getTempPatchFormat =
|
||||
getWord8 >>= \case
|
||||
0 -> PatchFormat.SyncFull <$> getPatchLocalIds <*> getFramedByteString
|
||||
1 -> PatchFormat.SyncDiff <$> getBase32Hex <*> getPatchLocalIds <*> getFramedByteString
|
||||
1 -> PatchFormat.SyncDiff <$> getHash32 <*> getPatchLocalIds <*> getFramedByteString
|
||||
tag -> unknownTag "getTempPatchFormat" tag
|
||||
where
|
||||
getPatchLocalIds =
|
||||
PatchFormat.LocalIds
|
||||
<$> getVector getText
|
||||
<*> getVector getBase32Hex
|
||||
<*> getVector getBase32Hex
|
||||
<*> getVector getHash32
|
||||
<*> getVector getHash32
|
||||
|
||||
getTempNamespaceFormat :: MonadGet m => m TempEntity.TempNamespaceFormat
|
||||
getTempNamespaceFormat =
|
||||
getWord8 >>= \case
|
||||
0 -> BranchFormat.SyncFull <$> getBranchLocalIds <*> getFramedByteString
|
||||
1 -> BranchFormat.SyncDiff <$> getBase32Hex <*> getBranchLocalIds <*> getFramedByteString
|
||||
1 -> BranchFormat.SyncDiff <$> getHash32 <*> getBranchLocalIds <*> getFramedByteString
|
||||
tag -> unknownTag "getTempNamespaceFormat" tag
|
||||
where
|
||||
getBranchLocalIds =
|
||||
BranchFormat.LocalIds
|
||||
<$> getVector getText
|
||||
<*> getVector getBase32Hex
|
||||
<*> getVector getBase32Hex
|
||||
<*> getVector (getPair getBase32Hex getBase32Hex)
|
||||
<*> getVector getHash32
|
||||
<*> getVector getHash32
|
||||
<*> getVector (getPair getHash32 getHash32)
|
||||
|
||||
getTempCausalFormat :: MonadGet m => m TempEntity.TempCausalFormat
|
||||
getTempCausalFormat =
|
||||
Causal.SyncCausalFormat
|
||||
<$> getBase32Hex
|
||||
<*> getVector getBase32Hex
|
||||
<$> getHash32
|
||||
<*> getVector getHash32
|
||||
|
||||
getSymbol :: MonadGet m => m Symbol
|
||||
getSymbol = Symbol <$> getVarInt <*> getText
|
||||
|
||||
@ -7,7 +7,7 @@ import qualified U.Codebase.Sqlite.Entity as Entity
|
||||
import U.Codebase.Sqlite.LocalIds (LocalIds')
|
||||
import qualified U.Codebase.Sqlite.Patch.Format as Patch
|
||||
import qualified U.Codebase.Sqlite.Term.Format as Term
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import Unison.Prelude
|
||||
|
||||
-- |
|
||||
@ -18,20 +18,20 @@ import Unison.Prelude
|
||||
-- | P TempPatchFormat
|
||||
-- | C TempCausalFormat
|
||||
type TempEntity =
|
||||
Entity.SyncEntity' Text Base32Hex Base32Hex Base32Hex Base32Hex Base32Hex Base32Hex
|
||||
Entity.SyncEntity' Text Hash32 Hash32 Hash32 Hash32 Hash32 Hash32
|
||||
|
||||
type TempLocalIds = LocalIds' Text Base32Hex
|
||||
type TempLocalIds = LocalIds' Text Hash32
|
||||
|
||||
type TempTermFormat = Term.SyncTermFormat' Text Base32Hex
|
||||
type TempTermFormat = Term.SyncTermFormat' Text Hash32
|
||||
|
||||
type TempDeclFormat = Decl.SyncDeclFormat' Text Base32Hex
|
||||
type TempDeclFormat = Decl.SyncDeclFormat' Text Hash32
|
||||
|
||||
type TempPatchFormat = Patch.SyncPatchFormat' Base32Hex Text Base32Hex Base32Hex
|
||||
type TempPatchFormat = Patch.SyncPatchFormat' Hash32 Text Hash32 Hash32
|
||||
|
||||
type TempPatchLocalIds = Patch.PatchLocalIds' Text Base32Hex Base32Hex
|
||||
type TempPatchLocalIds = Patch.PatchLocalIds' Text Hash32 Hash32
|
||||
|
||||
type TempNamespaceFormat = Namespace.SyncBranchFormat' Base32Hex Text Base32Hex Base32Hex (Base32Hex, Base32Hex)
|
||||
type TempNamespaceFormat = Namespace.SyncBranchFormat' Hash32 Text Hash32 Hash32 (Hash32, Hash32)
|
||||
|
||||
type TempNamespaceLocalIds = Namespace.BranchLocalIds' Text Base32Hex Base32Hex (Base32Hex, Base32Hex)
|
||||
type TempNamespaceLocalIds = Namespace.BranchLocalIds' Text Hash32 Hash32 (Hash32, Hash32)
|
||||
|
||||
type TempCausalFormat = Causal.SyncCausalFormat' Base32Hex Base32Hex
|
||||
type TempCausalFormat = Causal.SyncCausalFormat' Hash32 Hash32
|
||||
|
||||
@ -33,6 +33,7 @@ dependencies:
|
||||
- unison-sqlite
|
||||
- unison-util
|
||||
- unison-util-base32hex
|
||||
- unison-util-base32hex-orphans-sqlite
|
||||
- unison-util-serialization
|
||||
- unison-util-term
|
||||
- unliftio
|
||||
|
||||
@ -106,6 +106,7 @@ library
|
||||
, unison-sqlite
|
||||
, unison-util
|
||||
, unison-util-base32hex
|
||||
, unison-util-base32hex-orphans-sqlite
|
||||
, unison-util-serialization
|
||||
, unison-util-term
|
||||
, unliftio
|
||||
|
||||
3
hie.yaml
3
hie.yaml
@ -42,6 +42,9 @@ cradle:
|
||||
- path: "lib/unison-util-base32hex/src"
|
||||
component: "unison-util-base32hex:lib"
|
||||
|
||||
- path: "lib/unison-util-base32hex-orphans-aeson/src"
|
||||
component: "unison-util-base32hex-orphans-aeson:lib"
|
||||
|
||||
- path: "lib/unison-util-relation/src"
|
||||
component: "unison-util-relation:lib"
|
||||
|
||||
|
||||
44
lib/unison-util-base32hex-orphans-aeson/package.yaml
Normal file
44
lib/unison-util-base32hex-orphans-aeson/package.yaml
Normal file
@ -0,0 +1,44 @@
|
||||
name: unison-util-base32hex-orphans-aeson
|
||||
github: unisonweb/unison
|
||||
copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors
|
||||
|
||||
library:
|
||||
when:
|
||||
- condition: false
|
||||
other-modules: Paths_unison_util_base32hex_orphans_aeson
|
||||
source-dirs: src
|
||||
|
||||
dependencies:
|
||||
- aeson
|
||||
- base
|
||||
- text
|
||||
- unison-util-base32hex
|
||||
|
||||
ghc-options:
|
||||
-Wall
|
||||
-fno-warn-orphans
|
||||
|
||||
default-extensions:
|
||||
- ApplicativeDo
|
||||
- BangPatterns
|
||||
- BlockArguments
|
||||
- DeriveFunctor
|
||||
- DeriveGeneric
|
||||
- DeriveTraversable
|
||||
- DerivingStrategies
|
||||
- DerivingVia
|
||||
- DoAndIfThenElse
|
||||
- FlexibleContexts
|
||||
- FlexibleInstances
|
||||
- GeneralizedNewtypeDeriving
|
||||
- LambdaCase
|
||||
- MultiParamTypeClasses
|
||||
- NamedFieldPuns
|
||||
- OverloadedStrings
|
||||
- PatternSynonyms
|
||||
- RankNTypes
|
||||
- ScopedTypeVariables
|
||||
- StandaloneDeriving
|
||||
- TupleSections
|
||||
- TypeApplications
|
||||
- ViewPatterns
|
||||
@ -0,0 +1,14 @@
|
||||
module U.Util.Hash32.Orphans.Aeson () where
|
||||
|
||||
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
|
||||
import Data.Text (Text)
|
||||
import U.Util.Base32Hex (Base32Hex (..))
|
||||
import U.Util.Hash32 (Hash32 (..))
|
||||
|
||||
deriving via Text instance FromJSON Hash32
|
||||
|
||||
deriving via Text instance FromJSONKey Hash32
|
||||
|
||||
deriving via Text instance ToJSON Hash32
|
||||
|
||||
deriving via Text instance ToJSONKey Hash32
|
||||
@ -0,0 +1,53 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: unison-util-base32hex-orphans-aeson
|
||||
version: 0.0.0
|
||||
homepage: https://github.com/unisonweb/unison#readme
|
||||
bug-reports: https://github.com/unisonweb/unison/issues
|
||||
copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors
|
||||
build-type: Simple
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/unisonweb/unison
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
U.Util.Hash32.Orphans.Aeson
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions:
|
||||
ApplicativeDo
|
||||
BangPatterns
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DeriveTraversable
|
||||
DerivingStrategies
|
||||
DerivingVia
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
GeneralizedNewtypeDeriving
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
NamedFieldPuns
|
||||
OverloadedStrings
|
||||
PatternSynonyms
|
||||
RankNTypes
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeApplications
|
||||
ViewPatterns
|
||||
ghc-options: -Wall -fno-warn-orphans
|
||||
build-depends:
|
||||
aeson
|
||||
, base
|
||||
, text
|
||||
, unison-util-base32hex
|
||||
default-language: Haskell2010
|
||||
44
lib/unison-util-base32hex-orphans-sqlite/package.yaml
Normal file
44
lib/unison-util-base32hex-orphans-sqlite/package.yaml
Normal file
@ -0,0 +1,44 @@
|
||||
name: unison-util-base32hex-orphans-sqlite
|
||||
github: unisonweb/unison
|
||||
copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors
|
||||
|
||||
library:
|
||||
when:
|
||||
- condition: false
|
||||
other-modules: Paths_unison_util_base32hex_orphans_sqlite
|
||||
source-dirs: src
|
||||
|
||||
dependencies:
|
||||
- base
|
||||
- sqlite-simple
|
||||
- text
|
||||
- unison-util-base32hex
|
||||
|
||||
ghc-options:
|
||||
-Wall
|
||||
-fno-warn-orphans
|
||||
|
||||
default-extensions:
|
||||
- ApplicativeDo
|
||||
- BangPatterns
|
||||
- BlockArguments
|
||||
- DeriveFunctor
|
||||
- DeriveGeneric
|
||||
- DeriveTraversable
|
||||
- DerivingStrategies
|
||||
- DerivingVia
|
||||
- DoAndIfThenElse
|
||||
- FlexibleContexts
|
||||
- FlexibleInstances
|
||||
- GeneralizedNewtypeDeriving
|
||||
- LambdaCase
|
||||
- MultiParamTypeClasses
|
||||
- NamedFieldPuns
|
||||
- OverloadedStrings
|
||||
- PatternSynonyms
|
||||
- RankNTypes
|
||||
- ScopedTypeVariables
|
||||
- StandaloneDeriving
|
||||
- TupleSections
|
||||
- TypeApplications
|
||||
- ViewPatterns
|
||||
@ -0,0 +1,11 @@
|
||||
module U.Util.Hash32.Orphans.Sqlite () where
|
||||
|
||||
import Data.Text (Text)
|
||||
import Database.SQLite.Simple.FromField (FromField)
|
||||
import Database.SQLite.Simple.ToField (ToField)
|
||||
import U.Util.Base32Hex (Base32Hex (..))
|
||||
import U.Util.Hash32 (Hash32 (..))
|
||||
|
||||
deriving via Text instance ToField Hash32
|
||||
|
||||
deriving via Text instance FromField Hash32
|
||||
@ -0,0 +1,53 @@
|
||||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: unison-util-base32hex-orphans-sqlite
|
||||
version: 0.0.0
|
||||
homepage: https://github.com/unisonweb/unison#readme
|
||||
bug-reports: https://github.com/unisonweb/unison/issues
|
||||
copyright: Copyright (C) 2013-2021 Unison Computing, PBC and contributors
|
||||
build-type: Simple
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/unisonweb/unison
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
U.Util.Hash32.Orphans.Sqlite
|
||||
hs-source-dirs:
|
||||
src
|
||||
default-extensions:
|
||||
ApplicativeDo
|
||||
BangPatterns
|
||||
BlockArguments
|
||||
DeriveFunctor
|
||||
DeriveGeneric
|
||||
DeriveTraversable
|
||||
DerivingStrategies
|
||||
DerivingVia
|
||||
DoAndIfThenElse
|
||||
FlexibleContexts
|
||||
FlexibleInstances
|
||||
GeneralizedNewtypeDeriving
|
||||
LambdaCase
|
||||
MultiParamTypeClasses
|
||||
NamedFieldPuns
|
||||
OverloadedStrings
|
||||
PatternSynonyms
|
||||
RankNTypes
|
||||
ScopedTypeVariables
|
||||
StandaloneDeriving
|
||||
TupleSections
|
||||
TypeApplications
|
||||
ViewPatterns
|
||||
ghc-options: -Wall -fno-warn-orphans
|
||||
build-depends:
|
||||
base
|
||||
, sqlite-simple
|
||||
, text
|
||||
, unison-util-base32hex
|
||||
default-language: Haskell2010
|
||||
@ -1,40 +1,55 @@
|
||||
-- | A 512-bit hash, internally represented as base32hex.
|
||||
module U.Util.Hash32
|
||||
( -- * Hash32 type
|
||||
Hash32,
|
||||
Hash32 (..),
|
||||
|
||||
-- * Conversions
|
||||
|
||||
-- ** Base32Hex
|
||||
fromBase32Hex,
|
||||
toBase32Hex,
|
||||
|
||||
-- ** The other Hash :)
|
||||
fromHash,
|
||||
toHash,
|
||||
|
||||
-- ** Base32Hex
|
||||
unsafeFromBase32Hex,
|
||||
toBase32Hex,
|
||||
|
||||
-- ** Text
|
||||
toText,
|
||||
)
|
||||
where
|
||||
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import U.Util.Base32Hex (Base32Hex (..))
|
||||
import U.Util.Hash (Hash)
|
||||
import qualified U.Util.Hash as Hash
|
||||
import Unison.Prelude
|
||||
|
||||
-- | A 512-bit hash, internally represented as base32hex.
|
||||
newtype Hash32 = Hash32 Base32Hex
|
||||
|
||||
fromBase32Hex :: Base32Hex -> Hash32
|
||||
fromBase32Hex =
|
||||
Hash32
|
||||
|
||||
toBase32Hex :: Hash32 -> Base32Hex
|
||||
toBase32Hex =
|
||||
coerce
|
||||
--
|
||||
-- Some orphan instances provided in:
|
||||
--
|
||||
-- * @unison-util-base32hex-orphans-aeson@
|
||||
-- * @unison-util-base32hex-orphans-sqlite@
|
||||
newtype Hash32 = UnsafeFromBase32Hex Base32Hex
|
||||
deriving (Eq, Ord, Show) via (Text)
|
||||
|
||||
fromHash :: Hash -> Hash32
|
||||
fromHash =
|
||||
fromBase32Hex . Hash.toBase32Hex
|
||||
unsafeFromBase32Hex . Hash.toBase32Hex
|
||||
|
||||
toHash :: Hash32 -> Hash
|
||||
toHash =
|
||||
Hash.fromBase32Hex . toBase32Hex
|
||||
|
||||
-- | Convert base32hex to a hash32 (asserting that it is a 512-bit hash).
|
||||
unsafeFromBase32Hex :: Base32Hex -> Hash32
|
||||
unsafeFromBase32Hex =
|
||||
coerce
|
||||
|
||||
-- | Convert a hash32 to base32hex.
|
||||
toBase32Hex :: Hash32 -> Base32Hex
|
||||
toBase32Hex =
|
||||
coerce
|
||||
|
||||
toText :: Hash32 -> Text
|
||||
toText =
|
||||
coerce
|
||||
|
||||
@ -25,6 +25,8 @@ packages:
|
||||
- lib/unison-prelude
|
||||
- lib/unison-sqlite
|
||||
- lib/unison-util-base32hex
|
||||
- lib/unison-util-base32hex-orphans-aeson
|
||||
- lib/unison-util-base32hex-orphans-sqlite
|
||||
- lib/unison-util-relation
|
||||
- lib/unison-pretty-printer
|
||||
|
||||
|
||||
@ -32,6 +32,8 @@ import U.Codebase.Sqlite.DbId (SchemaVersion (SchemaVersion))
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import qualified U.Util.Base32Hex as Base32Hex
|
||||
import qualified U.Util.Hash as Hash
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import qualified U.Util.Hash32 as Hash32
|
||||
import qualified U.Util.Monoid as Monoid
|
||||
import qualified Unison.ABT as ABT
|
||||
import qualified Unison.Auth.Types as Auth
|
||||
@ -129,7 +131,6 @@ import qualified Unison.Share.Sync as Share
|
||||
import qualified Unison.ShortHash as SH
|
||||
import qualified Unison.ShortHash as ShortHash
|
||||
import qualified Unison.Sync.Types as Share
|
||||
import qualified Unison.Sync.Types as Share.Hash (toBase32Hex)
|
||||
import Unison.Term (Term)
|
||||
import qualified Unison.Term as Term
|
||||
import qualified Unison.TermPrinter as TermPrinter
|
||||
@ -637,8 +638,8 @@ notifyUser dir o = case o of
|
||||
CachedTests 0 _ -> pure . P.callout "😶" $ "No tests to run."
|
||||
CachedTests n n'
|
||||
| n == n' ->
|
||||
pure $
|
||||
P.lines [cache, "", displayTestResults True ppe oks fails]
|
||||
pure $
|
||||
P.lines [cache, "", displayTestResults True ppe oks fails]
|
||||
CachedTests _n m ->
|
||||
pure $
|
||||
if m == 0
|
||||
@ -647,6 +648,7 @@ notifyUser dir o = case o of
|
||||
P.indentN 2 $
|
||||
P.lines ["", cache, "", displayTestResults False ppe oks fails, "", "✅ "]
|
||||
where
|
||||
|
||||
NewlyComputed -> do
|
||||
clearCurrentLine
|
||||
pure $
|
||||
@ -1601,7 +1603,7 @@ notifyUser dir o = case o of
|
||||
P.fatalCallout
|
||||
( P.lines
|
||||
[ "The server detected an error in the history being pushed, please report this as a bug in ucm.",
|
||||
"The history in question is the hash: " <> prettyShareHash child <> " with the ancestor: " <> prettyShareHash parent
|
||||
"The history in question is the hash: " <> prettyHash32 child <> " with the ancestor: " <> prettyHash32 parent
|
||||
]
|
||||
)
|
||||
Share.FastForwardPushErrorNotFastForward sharePath ->
|
||||
@ -1643,7 +1645,7 @@ notifyUser dir o = case o of
|
||||
),
|
||||
P.text "",
|
||||
P.text "The hashes it expected are:\n"
|
||||
<> P.indentN 2 (P.lines (map prettyShareHash (toList hashes)))
|
||||
<> P.indentN 2 (P.lines (map prettyHash32 (toList hashes)))
|
||||
]
|
||||
handleGetCausalHashByPathError = \case
|
||||
Share.GetCausalHashByPathErrorNoReadPermission sharePath -> noReadPermission sharePath
|
||||
@ -1736,8 +1738,8 @@ prettyBase32Hex# b = P.group $ "#" <> prettyBase32Hex b
|
||||
prettyHash :: IsString s => Hash.Hash -> P.Pretty s
|
||||
prettyHash = prettyBase32Hex# . Hash.toBase32Hex
|
||||
|
||||
prettyShareHash :: IsString s => Share.Hash -> P.Pretty s
|
||||
prettyShareHash = prettyBase32Hex# . Share.Hash.toBase32Hex
|
||||
prettyHash32 :: IsString s => Hash32 -> P.Pretty s
|
||||
prettyHash32 = prettyBase32Hex# . Hash32.toBase32Hex
|
||||
|
||||
formatMissingStuff ::
|
||||
(Show tm, Show typ) =>
|
||||
@ -2269,7 +2271,7 @@ showDiffNamespace ::
|
||||
(Pretty, NumberedArgs)
|
||||
showDiffNamespace _ _ _ _ diffOutput
|
||||
| OBD.isEmpty diffOutput =
|
||||
("The namespaces are identical.", mempty)
|
||||
("The namespaces are identical.", mempty)
|
||||
showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput {..} =
|
||||
(P.sepNonEmpty "\n\n" p, toList args)
|
||||
where
|
||||
|
||||
@ -41,16 +41,15 @@ import qualified Data.Set.NonEmpty as NESet
|
||||
import qualified Servant.API as Servant ((:<|>) (..))
|
||||
import Servant.Client (BaseUrl)
|
||||
import qualified Servant.Client as Servant (ClientEnv, ClientM, client, hoistClient, mkClientEnv, runClientM)
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import U.Codebase.HashTags (CausalHash)
|
||||
import qualified U.Codebase.Sqlite.Queries as Q
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import qualified U.Util.Hash as Hash
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import Unison.Auth.HTTPClient (AuthorizedHttpClient)
|
||||
import qualified Unison.Auth.HTTPClient as Auth
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Sqlite as Sqlite
|
||||
import qualified Unison.Sync.API as Share (api)
|
||||
import Unison.Sync.Common
|
||||
import Unison.Sync.Common (causalHashToHash32, entityToTempEntity, expectEntity, hash32ToCausalHash)
|
||||
import qualified Unison.Sync.Types as Share
|
||||
import Unison.Util.Monoid (foldMapM)
|
||||
import qualified Unison.Util.Set as Set
|
||||
@ -62,7 +61,7 @@ import qualified Unison.Util.Set as Set
|
||||
data CheckAndSetPushError
|
||||
= CheckAndSetPushErrorHashMismatch Share.HashMismatch
|
||||
| CheckAndSetPushErrorNoWritePermission Share.Path
|
||||
| CheckAndSetPushErrorServerMissingDependencies (NESet Share.Hash)
|
||||
| CheckAndSetPushErrorServerMissingDependencies (NESet Hash32)
|
||||
|
||||
-- | Push a causal to Unison Share.
|
||||
-- FIXME reword this
|
||||
@ -77,7 +76,7 @@ checkAndSetPush ::
|
||||
Share.Path ->
|
||||
-- | The hash that we expect this repo+path to be at on Unison Share. If not, we'll get back a hash mismatch error.
|
||||
-- This prevents accidentally pushing over data that we didn't know was there.
|
||||
Maybe Share.Hash ->
|
||||
Maybe Hash32 ->
|
||||
-- | The hash of our local causal to push.
|
||||
CausalHash ->
|
||||
IO (Either CheckAndSetPushError ())
|
||||
@ -114,7 +113,7 @@ checkAndSetPush httpClient unisonShareUrl conn path expectedHash causalHash = do
|
||||
Share.UpdatePathRequest
|
||||
{ path,
|
||||
expectedHash,
|
||||
newHash = causalHashToShareHash causalHash
|
||||
newHash = causalHashToHash32 causalHash
|
||||
}
|
||||
|
||||
-- | An error occurred while fast-forward pushing code to Unison Share.
|
||||
@ -123,9 +122,9 @@ data FastForwardPushError
|
||||
| FastForwardPushErrorNoReadPermission Share.Path
|
||||
| FastForwardPushErrorNotFastForward Share.Path
|
||||
| FastForwardPushErrorNoWritePermission Share.Path
|
||||
| FastForwardPushErrorServerMissingDependencies (NESet Share.Hash)
|
||||
| -- Parent Child
|
||||
FastForwardPushInvalidParentage Share.Hash Share.Hash
|
||||
| FastForwardPushErrorServerMissingDependencies (NESet Hash32)
|
||||
| -- Parent Child
|
||||
FastForwardPushInvalidParentage Hash32 Hash32
|
||||
|
||||
-- | Push a causal to Unison Share.
|
||||
-- FIXME reword this
|
||||
@ -161,7 +160,7 @@ fastForwardPush httpClient unisonShareUrl conn path localHeadHash =
|
||||
Share.FastForwardPathRequest
|
||||
{ expectedHash = remoteHeadHash,
|
||||
hashes =
|
||||
causalHashToShareHash <$> List.NonEmpty.fromList (localInnerHashes ++ [localHeadHash]),
|
||||
causalHashToHash32 <$> List.NonEmpty.fromList (localInnerHashes ++ [localHeadHash]),
|
||||
path
|
||||
}
|
||||
doFastForwardPath <&> \case
|
||||
@ -185,14 +184,14 @@ fastForwardPush httpClient unisonShareUrl conn path localHeadHash =
|
||||
unisonShareUrl
|
||||
conn
|
||||
(Share.pathRepoName path)
|
||||
(NESet.singleton (causalHashToShareHash headHash))
|
||||
(NESet.singleton (causalHashToHash32 headHash))
|
||||
|
||||
-- Return a list from oldest to newst of the ancestors between (excluding) the latest local and the current remote
|
||||
-- hash.
|
||||
-- note: seems like we /should/ cut this short, with another command to go longer? :grimace:
|
||||
fancyBfs :: CausalHash -> Share.Hash -> Sqlite.Transaction (Maybe [CausalHash])
|
||||
fancyBfs :: CausalHash -> Hash32 -> Sqlite.Transaction (Maybe [CausalHash])
|
||||
fancyBfs h0 h1 =
|
||||
tweak <$> dagbfs (== Share.toBase32Hex h1) Q.loadCausalParentsByHash (Hash.toBase32Hex (unCausalHash h0))
|
||||
tweak <$> dagbfs (== h1) Q.loadCausalParentsByHash (causalHashToHash32 h0)
|
||||
where
|
||||
-- Drop 1 (under a Maybe, and twddling hash types):
|
||||
--
|
||||
@ -202,9 +201,9 @@ fastForwardPush httpClient unisonShareUrl conn path localHeadHash =
|
||||
--
|
||||
-- The drop 1 is because dagbfs returns the goal at the head of the returned list, but we know what the goal is
|
||||
-- already (the remote head hash).
|
||||
tweak :: Maybe [Base32Hex] -> Maybe [CausalHash]
|
||||
tweak :: Maybe [Hash32] -> Maybe [CausalHash]
|
||||
tweak =
|
||||
fmap (map (CausalHash . Hash.fromBase32Hex) . drop 1)
|
||||
fmap (map hash32ToCausalHash . drop 1)
|
||||
|
||||
data Step a
|
||||
= DeadEnd
|
||||
@ -333,7 +332,7 @@ pull httpClient unisonShareUrl conn repoPath = do
|
||||
Just EntityInMainStorage -> pure ()
|
||||
Just (EntityInTempStorage missingDependencies) -> doDownload missingDependencies
|
||||
Nothing -> doDownload (NESet.singleton hashJwt)
|
||||
pure (Right (CausalHash (Hash.fromBase32Hex (Share.toBase32Hex hash))))
|
||||
pure (Right (hash32ToCausalHash hash))
|
||||
where
|
||||
doDownload :: NESet Share.HashJWT -> IO ()
|
||||
doDownload =
|
||||
@ -388,7 +387,7 @@ downloadEntities httpClient unisonShareUrl conn repoName =
|
||||
|
||||
whenJust (NESet.nonEmptySet missingDependencies0) loop
|
||||
|
||||
doDownload :: NESet Share.HashJWT -> IO (NEMap Share.Hash (Share.Entity Text Share.Hash Share.HashJWT))
|
||||
doDownload :: NESet Share.HashJWT -> IO (NEMap Hash32 (Share.Entity Text Hash32 Share.HashJWT))
|
||||
doDownload hashes = do
|
||||
Share.DownloadEntitiesSuccess entities <-
|
||||
httpDownloadEntities
|
||||
@ -410,12 +409,12 @@ uploadEntities ::
|
||||
BaseUrl ->
|
||||
Sqlite.Connection ->
|
||||
Share.RepoName ->
|
||||
NESet Share.Hash ->
|
||||
NESet Hash32 ->
|
||||
IO Bool
|
||||
uploadEntities httpClient unisonShareUrl conn repoName =
|
||||
loop
|
||||
where
|
||||
loop :: NESet Share.Hash -> IO Bool
|
||||
loop :: NESet Hash32 -> IO Bool
|
||||
loop (NESet.toAscList -> hashes) = do
|
||||
-- Get each entity that the server is missing out of the database.
|
||||
entities <- Sqlite.runTransaction conn (traverse expectEntity hashes)
|
||||
@ -449,8 +448,8 @@ data EntityLocation
|
||||
EntityInTempStorage (NESet Share.HashJWT)
|
||||
|
||||
-- | Where is an entity stored?
|
||||
entityLocation :: Share.Hash -> Sqlite.Transaction (Maybe EntityLocation)
|
||||
entityLocation (Share.Hash hash) =
|
||||
entityLocation :: Hash32 -> Sqlite.Transaction (Maybe EntityLocation)
|
||||
entityLocation hash =
|
||||
Q.entityExists hash >>= \case
|
||||
True -> pure (Just EntityInMainStorage)
|
||||
False ->
|
||||
@ -487,8 +486,8 @@ elaborateHashes =
|
||||
-- 2. In main storage if we already have all of its dependencies in main storage.
|
||||
-- 3. In temp storage otherwise.
|
||||
upsertEntitySomewhere ::
|
||||
Share.Hash ->
|
||||
Share.Entity Text Share.Hash Share.HashJWT ->
|
||||
Hash32 ->
|
||||
Share.Entity Text Hash32 Share.HashJWT ->
|
||||
Sqlite.Transaction EntityLocation
|
||||
upsertEntitySomewhere hash entity =
|
||||
entityLocation hash >>= \case
|
||||
@ -496,7 +495,7 @@ upsertEntitySomewhere hash entity =
|
||||
Nothing -> do
|
||||
missingDependencies0 <-
|
||||
Set.filterM
|
||||
(fmap not . Q.entityExists . Share.toBase32Hex . Share.hashJWTHash)
|
||||
(fmap not . Q.entityExists . Share.hashJWTHash)
|
||||
(Share.entityDependencies entity)
|
||||
case NESet.nonEmptySet missingDependencies0 of
|
||||
Nothing -> do
|
||||
@ -507,26 +506,26 @@ upsertEntitySomewhere hash entity =
|
||||
pure (EntityInTempStorage missingDependencies)
|
||||
|
||||
-- | Insert an entity that doesn't have any missing dependencies.
|
||||
insertEntity :: Share.Hash -> Share.Entity Text Share.Hash Share.HashJWT -> Sqlite.Transaction ()
|
||||
insertEntity :: Hash32 -> Share.Entity Text Hash32 Share.HashJWT -> Sqlite.Transaction ()
|
||||
insertEntity hash entity = do
|
||||
syncEntity <- Q.tempToSyncEntity (entityToTempEntity (Share.toBase32Hex . Share.hashJWTHash) entity)
|
||||
_id <- Q.saveSyncEntity (Share.toBase32Hex hash) syncEntity
|
||||
syncEntity <- Q.tempToSyncEntity (entityToTempEntity Share.hashJWTHash entity)
|
||||
_id <- Q.saveSyncEntity hash syncEntity
|
||||
pure ()
|
||||
|
||||
-- | Insert an entity and its missing dependencies.
|
||||
insertTempEntity ::
|
||||
Share.Hash ->
|
||||
Share.Entity Text Share.Hash Share.HashJWT ->
|
||||
Hash32 ->
|
||||
Share.Entity Text Hash32 Share.HashJWT ->
|
||||
NESet Share.HashJWT ->
|
||||
Sqlite.Transaction ()
|
||||
insertTempEntity hash entity missingDependencies =
|
||||
Q.insertTempEntity
|
||||
(Share.toBase32Hex hash)
|
||||
(entityToTempEntity (Share.toBase32Hex . Share.hashJWTHash) entity)
|
||||
hash
|
||||
(entityToTempEntity Share.hashJWTHash entity)
|
||||
( NESet.map
|
||||
( \hashJwt ->
|
||||
let Share.DecodedHashJWT {claims = Share.HashJWTClaims {hash}} = Share.decodeHashJWT hashJwt
|
||||
in (Share.toBase32Hex hash, Share.unHashJWT hashJwt)
|
||||
in (hash, Share.unHashJWT hashJwt)
|
||||
)
|
||||
missingDependencies
|
||||
)
|
||||
|
||||
@ -47,6 +47,7 @@ dependencies:
|
||||
- unison-pretty-printer
|
||||
- unison-util
|
||||
- unison-util-base32hex
|
||||
- unison-util-base32hex-orphans-aeson
|
||||
- unison-util-relation
|
||||
- unison-sqlite
|
||||
- unliftio
|
||||
|
||||
@ -3,7 +3,8 @@ module Unison.Sync.Common
|
||||
( expectEntity,
|
||||
|
||||
-- * Type conversions
|
||||
causalHashToShareHash,
|
||||
causalHashToHash32,
|
||||
hash32ToCausalHash,
|
||||
entityToTempEntity,
|
||||
tempEntityToEntity,
|
||||
)
|
||||
@ -11,7 +12,6 @@ where
|
||||
|
||||
import qualified Control.Lens as Lens
|
||||
import qualified Data.Set as Set
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import U.Codebase.HashTags (CausalHash (..))
|
||||
import qualified U.Codebase.Sqlite.Branch.Format as NamespaceFormat
|
||||
@ -25,27 +25,33 @@ import U.Codebase.Sqlite.TempEntity (TempEntity)
|
||||
import qualified U.Codebase.Sqlite.TempEntity as Sqlite
|
||||
import qualified U.Codebase.Sqlite.TempEntity as TempEntity
|
||||
import qualified U.Codebase.Sqlite.Term.Format as TermFormat
|
||||
import U.Util.Base32Hex (Base32Hex)
|
||||
import qualified U.Util.Hash as Hash
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import qualified U.Util.Hash32 as Hash32
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Sqlite as Sqlite
|
||||
import qualified Unison.Sync.Types as Share
|
||||
|
||||
-- | Read an entity out of the database that we know is in main storage.
|
||||
expectEntity :: Share.Hash -> Sqlite.Transaction (Share.Entity Text Share.Hash Share.Hash)
|
||||
expectEntity :: Hash32 -> Sqlite.Transaction (Share.Entity Text Hash32 Hash32)
|
||||
expectEntity hash = do
|
||||
syncEntity <- Q.expectEntity (Share.toBase32Hex hash)
|
||||
syncEntity <- Q.expectEntity hash
|
||||
tempEntity <- Q.syncToTempEntity syncEntity
|
||||
pure (tempEntityToEntity tempEntity)
|
||||
|
||||
causalHashToShareHash :: CausalHash -> Share.Hash
|
||||
causalHashToShareHash =
|
||||
Share.Hash . Hash.toBase32Hex . unCausalHash
|
||||
-- FIXME this isn't the right module for this conversion
|
||||
causalHashToHash32 :: CausalHash -> Hash32
|
||||
causalHashToHash32 =
|
||||
Hash32.fromHash . unCausalHash
|
||||
|
||||
-- FIXME this isn't the right module for this conversion
|
||||
hash32ToCausalHash :: Hash32 -> CausalHash
|
||||
hash32ToCausalHash =
|
||||
CausalHash . Hash32.toHash
|
||||
|
||||
-- | Convert an entity that came over the wire from Unison Share into an equivalent type that we can store in the
|
||||
-- `temp_entity` table.
|
||||
entityToTempEntity :: forall hash. (hash -> Base32Hex) -> Share.Entity Text Share.Hash hash -> TempEntity
|
||||
entityToTempEntity toBase32Hex = \case
|
||||
entityToTempEntity :: forall hash. (hash -> Hash32) -> Share.Entity Text Hash32 hash -> TempEntity
|
||||
entityToTempEntity toHash32 = \case
|
||||
Share.TC (Share.TermComponent terms) ->
|
||||
terms
|
||||
& Vector.fromList
|
||||
@ -65,7 +71,7 @@ entityToTempEntity toBase32Hex = \case
|
||||
Share.PD Share.PatchDiff {parent, textLookup, oldHashLookup, newHashLookup, bytes} ->
|
||||
Entity.P
|
||||
( PatchFormat.SyncDiff
|
||||
(toBase32Hex parent)
|
||||
(toHash32 parent)
|
||||
(mungePatchLocalIds textLookup oldHashLookup newHashLookup)
|
||||
bytes
|
||||
)
|
||||
@ -74,22 +80,22 @@ entityToTempEntity toBase32Hex = \case
|
||||
Share.ND Share.NamespaceDiff {parent, textLookup, defnLookup, patchLookup, childLookup, bytes} ->
|
||||
Entity.N
|
||||
( NamespaceFormat.SyncDiff
|
||||
(toBase32Hex parent)
|
||||
(toHash32 parent)
|
||||
(mungeNamespaceLocalIds textLookup defnLookup patchLookup childLookup)
|
||||
bytes
|
||||
)
|
||||
Share.C Share.Causal {namespaceHash, parents} ->
|
||||
Entity.C
|
||||
Causal.SyncCausalFormat
|
||||
{ valueHash = toBase32Hex namespaceHash,
|
||||
parents = Vector.fromList (map toBase32Hex (Set.toList parents))
|
||||
{ valueHash = toHash32 namespaceHash,
|
||||
parents = Vector.fromList (map toHash32 (Set.toList parents))
|
||||
}
|
||||
where
|
||||
mungeLocalIds :: Share.LocalIds Text hash -> TempEntity.TempLocalIds
|
||||
mungeLocalIds Share.LocalIds {texts, hashes} =
|
||||
LocalIds
|
||||
{ textLookup = Vector.fromList texts,
|
||||
defnLookup = Vector.map toBase32Hex (Vector.fromList hashes)
|
||||
defnLookup = Vector.map toHash32 (Vector.fromList hashes)
|
||||
}
|
||||
|
||||
mungeNamespaceLocalIds ::
|
||||
@ -101,20 +107,20 @@ entityToTempEntity toBase32Hex = \case
|
||||
mungeNamespaceLocalIds textLookup defnLookup patchLookup childLookup =
|
||||
NamespaceFormat.LocalIds
|
||||
{ branchTextLookup = Vector.fromList textLookup,
|
||||
branchDefnLookup = Vector.fromList (map toBase32Hex defnLookup),
|
||||
branchPatchLookup = Vector.fromList (map toBase32Hex patchLookup),
|
||||
branchChildLookup = Vector.fromList (map (\(x, y) -> (toBase32Hex x, toBase32Hex y)) childLookup)
|
||||
branchDefnLookup = Vector.fromList (map toHash32 defnLookup),
|
||||
branchPatchLookup = Vector.fromList (map toHash32 patchLookup),
|
||||
branchChildLookup = Vector.fromList (map (\(x, y) -> (toHash32 x, toHash32 y)) childLookup)
|
||||
}
|
||||
|
||||
mungePatchLocalIds :: [Text] -> [Share.Hash] -> [hash] -> TempEntity.TempPatchLocalIds
|
||||
mungePatchLocalIds :: [Text] -> [Hash32] -> [hash] -> TempEntity.TempPatchLocalIds
|
||||
mungePatchLocalIds textLookup oldHashLookup newHashLookup =
|
||||
PatchFormat.LocalIds
|
||||
{ patchTextLookup = Vector.fromList textLookup,
|
||||
patchHashLookup = Vector.fromList (coerce @[Share.Hash] @[Base32Hex] oldHashLookup),
|
||||
patchDefnLookup = Vector.fromList (map toBase32Hex newHashLookup)
|
||||
patchHashLookup = Vector.fromList oldHashLookup,
|
||||
patchDefnLookup = Vector.fromList (map toHash32 newHashLookup)
|
||||
}
|
||||
|
||||
tempEntityToEntity :: Sqlite.TempEntity -> Share.Entity Text Share.Hash Share.Hash
|
||||
tempEntityToEntity :: Sqlite.TempEntity -> Share.Entity Text Hash32 Hash32
|
||||
tempEntityToEntity = \case
|
||||
Entity.TC (TermFormat.SyncTerm (TermFormat.SyncLocallyIndexedComponent terms)) ->
|
||||
terms
|
||||
@ -134,17 +140,17 @@ tempEntityToEntity = \case
|
||||
Share.P
|
||||
Share.Patch
|
||||
{ textLookup = Vector.toList patchTextLookup,
|
||||
oldHashLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) patchHashLookup),
|
||||
newHashLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) patchDefnLookup),
|
||||
oldHashLookup = Vector.toList patchHashLookup,
|
||||
newHashLookup = Vector.toList patchDefnLookup,
|
||||
bytes
|
||||
}
|
||||
PatchFormat.SyncDiff parent PatchFormat.LocalIds {patchTextLookup, patchHashLookup, patchDefnLookup} bytes ->
|
||||
Share.PD
|
||||
Share.PatchDiff
|
||||
{ parent = Share.Hash parent,
|
||||
{ parent,
|
||||
textLookup = Vector.toList patchTextLookup,
|
||||
oldHashLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) patchHashLookup),
|
||||
newHashLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) patchDefnLookup),
|
||||
oldHashLookup = Vector.toList patchHashLookup,
|
||||
newHashLookup = Vector.toList patchDefnLookup,
|
||||
bytes
|
||||
}
|
||||
Entity.N format ->
|
||||
@ -160,11 +166,9 @@ tempEntityToEntity = \case
|
||||
Share.N
|
||||
Share.Namespace
|
||||
{ textLookup = Vector.toList branchTextLookup,
|
||||
defnLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) branchDefnLookup),
|
||||
patchLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) branchPatchLookup),
|
||||
childLookup =
|
||||
Vector.toList
|
||||
(coerce @(Vector (Base32Hex, Base32Hex)) @(Vector (Share.Hash, Share.Hash)) branchChildLookup),
|
||||
defnLookup = Vector.toList branchDefnLookup,
|
||||
patchLookup = Vector.toList branchPatchLookup,
|
||||
childLookup = Vector.toList branchChildLookup,
|
||||
bytes
|
||||
}
|
||||
NamespaceFormat.SyncDiff
|
||||
@ -178,25 +182,23 @@ tempEntityToEntity = \case
|
||||
bytes ->
|
||||
Share.ND
|
||||
Share.NamespaceDiff
|
||||
{ parent = Share.Hash parent,
|
||||
{ parent,
|
||||
textLookup = Vector.toList branchTextLookup,
|
||||
defnLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) branchDefnLookup),
|
||||
patchLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) branchPatchLookup),
|
||||
childLookup =
|
||||
Vector.toList
|
||||
(coerce @(Vector (Base32Hex, Base32Hex)) @(Vector (Share.Hash, Share.Hash)) branchChildLookup),
|
||||
defnLookup = Vector.toList branchDefnLookup,
|
||||
patchLookup = Vector.toList branchPatchLookup,
|
||||
childLookup = Vector.toList branchChildLookup,
|
||||
bytes
|
||||
}
|
||||
Entity.C Causal.SyncCausalFormat {valueHash, parents} ->
|
||||
Share.C
|
||||
Share.Causal
|
||||
{ namespaceHash = Share.Hash valueHash,
|
||||
parents = Set.fromList (coerce @[Base32Hex] @[Share.Hash] (Vector.toList parents))
|
||||
{ namespaceHash = valueHash,
|
||||
parents = Set.fromList (Vector.toList parents)
|
||||
}
|
||||
where
|
||||
mungeLocalIds :: LocalIds' Text Base32Hex -> Share.LocalIds Text Share.Hash
|
||||
mungeLocalIds :: LocalIds' Text Hash32 -> Share.LocalIds Text Hash32
|
||||
mungeLocalIds LocalIds {textLookup, defnLookup} =
|
||||
Share.LocalIds
|
||||
{ texts = Vector.toList textLookup,
|
||||
hashes = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) defnLookup)
|
||||
hashes = Vector.toList defnLookup
|
||||
}
|
||||
|
||||
@ -12,7 +12,6 @@ module Unison.Sync.Types
|
||||
pathCodebasePath,
|
||||
|
||||
-- ** Hash types
|
||||
Hash (..),
|
||||
HashJWT (..),
|
||||
hashJWTHash,
|
||||
HashJWTClaims (..),
|
||||
@ -89,7 +88,8 @@ import Data.Set.NonEmpty (NESet)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Encoding as Text
|
||||
import Servant.Auth.JWT
|
||||
import U.Util.Base32Hex (Base32Hex (..))
|
||||
import U.Util.Hash32 (Hash32)
|
||||
import U.Util.Hash32.Orphans.Aeson ()
|
||||
import Unison.Prelude
|
||||
import qualified Unison.Util.Set as Set
|
||||
import qualified Web.JWT as JWT
|
||||
@ -140,21 +140,18 @@ instance FromJSON Path where
|
||||
------------------------------------------------------------------------------------------------------------------------
|
||||
-- Hash types
|
||||
|
||||
newtype Hash = Hash {toBase32Hex :: Base32Hex}
|
||||
deriving (Show, Eq, Ord, ToJSON, FromJSON, ToJSONKey, FromJSONKey) via (Text)
|
||||
|
||||
newtype HashJWT = HashJWT {unHashJWT :: Text}
|
||||
deriving newtype (Show, Eq, Ord, ToJSON, FromJSON)
|
||||
|
||||
-- | Grab the hash out of a hash JWT.
|
||||
--
|
||||
-- This decodes the whole JWT, then throws away the claims; use it if you really only need the hash!
|
||||
hashJWTHash :: HashJWT -> Hash
|
||||
hashJWTHash :: HashJWT -> Hash32
|
||||
hashJWTHash =
|
||||
decodedHashJWTHash . decodeHashJWT
|
||||
|
||||
data HashJWTClaims = HashJWTClaims
|
||||
{ hash :: Hash
|
||||
{ hash :: Hash32
|
||||
-- Currently unused
|
||||
-- entityType :: EntityType
|
||||
}
|
||||
@ -216,7 +213,7 @@ decodeHashJWTClaims (HashJWT text) =
|
||||
Aeson.Success claims -> claims
|
||||
|
||||
-- | Grab the hash out of a decoded hash JWT.
|
||||
decodedHashJWTHash :: DecodedHashJWT -> Hash
|
||||
decodedHashJWTHash :: DecodedHashJWT -> Hash32
|
||||
decodedHashJWTHash DecodedHashJWT {claims = HashJWTClaims {hash}} =
|
||||
hash
|
||||
|
||||
@ -661,7 +658,7 @@ instance FromJSON DownloadEntitiesRequest where
|
||||
pure DownloadEntitiesRequest {..}
|
||||
|
||||
data DownloadEntitiesResponse
|
||||
= DownloadEntitiesSuccess (NEMap Hash (Entity Text Hash HashJWT))
|
||||
= DownloadEntitiesSuccess (NEMap Hash32 (Entity Text Hash32 HashJWT))
|
||||
| DownloadEntitiesNoReadPermission RepoName
|
||||
|
||||
-- data DownloadEntities = DownloadEntities
|
||||
@ -696,7 +693,7 @@ instance FromJSON DownloadEntitiesResponse where
|
||||
|
||||
data UploadEntitiesRequest = UploadEntitiesRequest
|
||||
{ repoName :: RepoName,
|
||||
entities :: NEMap Hash (Entity Text Hash Hash)
|
||||
entities :: NEMap Hash32 (Entity Text Hash32 Hash32)
|
||||
}
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
@ -715,12 +712,12 @@ instance FromJSON UploadEntitiesRequest where
|
||||
|
||||
data UploadEntitiesResponse
|
||||
= UploadEntitiesSuccess
|
||||
| UploadEntitiesNeedDependencies (NeedDependencies Hash)
|
||||
| UploadEntitiesNeedDependencies (NeedDependencies Hash32)
|
||||
| UploadEntitiesNoWritePermission RepoName
|
||||
| UploadEntitiesHashMismatchForEntity HashMismatchForEntity
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
data HashMismatchForEntity = HashMismatchForEntity {supplied :: Hash, computed :: Hash}
|
||||
data HashMismatchForEntity = HashMismatchForEntity {supplied :: Hash32, computed :: Hash32}
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
instance ToJSON UploadEntitiesResponse where
|
||||
@ -775,9 +772,9 @@ instance FromJSON HashMismatchForEntity where
|
||||
-- instead.
|
||||
data FastForwardPathRequest = FastForwardPathRequest
|
||||
{ -- | The causal that the client believes exists at `path`
|
||||
expectedHash :: Hash,
|
||||
expectedHash :: Hash32,
|
||||
-- | The sequence of causals to fast-forward with, starting from the oldest new causal to the newest new causal
|
||||
hashes :: NonEmpty Hash,
|
||||
hashes :: NonEmpty Hash32,
|
||||
-- | The path to fast-forward
|
||||
path :: Path
|
||||
}
|
||||
@ -801,7 +798,7 @@ instance FromJSON FastForwardPathRequest where
|
||||
|
||||
data FastForwardPathResponse
|
||||
= FastForwardPathSuccess
|
||||
| FastForwardPathMissingDependencies (NeedDependencies Hash)
|
||||
| FastForwardPathMissingDependencies (NeedDependencies Hash32)
|
||||
| FastForwardPathNoWritePermission Path
|
||||
| -- | This wasn't a fast-forward. Here's a JWT to download the causal head, if you want it.
|
||||
FastForwardPathNotFastForward HashJWT
|
||||
@ -811,7 +808,7 @@ data FastForwardPathResponse
|
||||
FastForwardPathInvalidParentage InvalidParentage
|
||||
deriving stock (Show)
|
||||
|
||||
data InvalidParentage = InvalidParentage {parent :: Hash, child :: Hash}
|
||||
data InvalidParentage = InvalidParentage {parent :: Hash32, child :: Hash32}
|
||||
deriving stock (Show)
|
||||
|
||||
instance ToJSON FastForwardPathResponse where
|
||||
@ -847,8 +844,8 @@ instance FromJSON InvalidParentage where
|
||||
|
||||
data UpdatePathRequest = UpdatePathRequest
|
||||
{ path :: Path,
|
||||
expectedHash :: Maybe Hash, -- Nothing requires empty history at destination
|
||||
newHash :: Hash
|
||||
expectedHash :: Maybe Hash32, -- Nothing requires empty history at destination
|
||||
newHash :: Hash32
|
||||
}
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
@ -870,7 +867,7 @@ instance FromJSON UpdatePathRequest where
|
||||
data UpdatePathResponse
|
||||
= UpdatePathSuccess
|
||||
| UpdatePathHashMismatch HashMismatch
|
||||
| UpdatePathMissingDependencies (NeedDependencies Hash)
|
||||
| UpdatePathMissingDependencies (NeedDependencies Hash32)
|
||||
| UpdatePathNoWritePermission Path
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
@ -893,8 +890,8 @@ instance FromJSON UpdatePathResponse where
|
||||
|
||||
data HashMismatch = HashMismatch
|
||||
{ path :: Path,
|
||||
expectedHash :: Maybe Hash,
|
||||
actualHash :: Maybe Hash
|
||||
expectedHash :: Maybe Hash32,
|
||||
actualHash :: Maybe Hash32
|
||||
}
|
||||
deriving stock (Show, Eq, Ord)
|
||||
|
||||
|
||||
@ -105,6 +105,7 @@ library
|
||||
, unison-sqlite
|
||||
, unison-util
|
||||
, unison-util-base32hex
|
||||
, unison-util-base32hex-orphans-aeson
|
||||
, unison-util-relation
|
||||
, unliftio
|
||||
, unordered-containers
|
||||
|
||||
Loading…
Reference in New Issue
Block a user