[Experimental] Swap Hash -> Hash32 in HashTags

codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Branch/Hashing.hs

@@ -7,14 +7,15 @@ where
 import U.Codebase.Branch (Branch)
 import U.Codebase.BranchV3 (BranchV3)
 import U.Codebase.HashTags
+import Unison.Hash32 qualified as Hash32
 import Unison.Hashing.V2 qualified as Hashing
 import Unison.Hashing.V2.Convert2 (convertBranchV3, v2ToH2Branch)
 
 hashBranch :: forall m. Monad m => Branch m -> m BranchHash
 hashBranch branch =
-  BranchHash . Hashing.contentHash <$> v2ToH2Branch branch
+  BranchHash . Hash32.fromHash . Hashing.contentHash <$> v2ToH2Branch branch
 
 -- | Hash a V3 branch.
 hashBranchV3 :: BranchV3 m -> BranchHash
 hashBranchV3 =
-  BranchHash . Hashing.contentHash . convertBranchV3
+  BranchHash . Hash32.fromHash . Hashing.contentHash . convertBranchV3

codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Causal/Hashing.hs

@@ -3,12 +3,13 @@ module U.Codebase.Causal.Hashing where
 import Data.Set
 import Data.Set qualified as Set
 import U.Codebase.HashTags (BranchHash (..), CausalHash (..))
+import Unison.Hash32 qualified as Hash32
 import Unison.Hashing.V2 qualified as Hashing
 
 hashCausal :: BranchHash -> Set CausalHash -> CausalHash
 hashCausal branchHash ancestors =
-  CausalHash . Hashing.contentHash $
+  CausalHash . Hash32.fromHash . Hashing.contentHash $
     Hashing.Causal
-      { Hashing.branchHash = unBranchHash branchHash,
-        Hashing.parents = Set.map unCausalHash ancestors
+      { Hashing.branchHash = Hash32.toHash $ unBranchHash branchHash,
+        Hashing.parents = Set.map (Hash32.toHash . unCausalHash) ancestors
       }

codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Sqlite/V2/HashHandle.hs

@@ -12,6 +12,7 @@ import U.Codebase.Sqlite.Branch.Format qualified as BranchFormat
 import U.Codebase.Sqlite.HashHandle
 import U.Codebase.Term.Hashing as H2
 import U.Util.Type (removeAllEffectVars)
+import Unison.Hash32 qualified as Hash32
 import Unison.Hashing.V2 qualified as H2
 import Unison.Hashing.V2.Convert2 (h2ToV2Reference, hashBranchFormatToH2Branch, v2ToH2Type, v2ToH2TypeD)
 
@@ -29,6 +30,7 @@ v2HashHandle =
         BranchFormat.localToHashBranch localIds localBranch
           & hashBranchFormatToH2Branch
           & H2.contentHash
+          & Hash32.fromHash
           & BranchHash,
       verifyTermFormatHash = H2.verifyTermFormatHash
     }

codebase2/codebase-sqlite-hashing-v2/src/U/Codebase/Term/Hashing.hs

@@ -24,7 +24,7 @@ import Unison.Symbol qualified as Unison
 import Unison.Var qualified as Var
 
 verifyTermFormatHash :: ComponentHash -> TermFormat.HashTermFormat -> Maybe (HashMismatch)
-verifyTermFormatHash (ComponentHash hash) (TermFormat.Term (TermFormat.LocallyIndexedComponent elements)) =
+verifyTermFormatHash (ComponentHash hash32) (TermFormat.Term (TermFormat.LocallyIndexedComponent elements)) =
   Foldable.toList elements
     & fmap s2cTermWithType
     & Reference.component hash
@@ -40,6 +40,7 @@ verifyTermFormatHash (ComponentHash hash) (TermFormat.Term (TermFormat.LocallyIn
         then Nothing
         else Just (HashMismatch hash hash')
   where
+    hash = Hash32.toHash hash32
     mapTermV ::
       ABT.Term (C.Term.F' text' termRef' typeRef' termLink' typeLink' S.Symbol) S.Symbol a ->
       ABT.Term (C.Term.F' text' termRef' typeRef' termLink' typeLink' Unison.Symbol) Unison.Symbol a

codebase2/codebase-sqlite-hashing-v2/src/Unison/Hashing/V2/Convert2.hs

@@ -27,6 +27,7 @@ import U.Codebase.Term qualified as V2.Term
 import U.Codebase.Type qualified as V2.Type
 import U.Core.ABT qualified as ABT
 import Unison.Hash (Hash)
+import Unison.Hash32 qualified as Hash32
 import Unison.Hashing.V2 qualified as H2
 import Unison.NameSegment (NameSegment (..))
 import Unison.Prelude
@@ -36,7 +37,7 @@ import Unison.Util.Map qualified as Map
 convertBranchV3 :: BranchV3 m -> H2.Branch
 convertBranchV3 BranchV3 {children, terms, types} =
   H2.Branch
-    { children = children & Map.bimap coerce (unCausalHash . Causal.causalHash),
+    { children = children & Map.bimap coerce (Hash32.toHash . unCausalHash . Causal.causalHash),
       patches = Map.empty,
       terms = Map.bimap coerce (\ref -> Map.singleton (v2ToH2Referent ref) emptyMetadata) terms,
       types = Map.bimap coerce (\ref -> Map.singleton (v2ToH2Reference ref) emptyMetadata) types
@@ -101,8 +102,8 @@ v2ToH2Branch V2.Branch {terms, types, patches, children} = do
       <&> Map.bimap coerce (Map.bimap v2ToH2Reference v2ToH2MdValues)
   let hpatches =
         patches
-          & Map.bimap coerce (unPatchHash . fst)
-  let hchildren = children & Map.bimap coerce (unCausalHash . Causal.causalHash)
+          & Map.bimap coerce (Hash32.toHash . unPatchHash . fst)
+  let hchildren = children & Map.bimap coerce (Hash32.toHash . unCausalHash . Causal.causalHash)
   pure $ H2.Branch {types = htypes, terms = hterms, patches = hpatches, children = hchildren}
 
 v2ToH2MdValues :: V2Branch.MdValues -> H2.MdValues
@@ -121,19 +122,19 @@ hashBranchFormatToH2Branch Memory.BranchFull.Branch {terms, types, patches, chil
       types =
         types
           & Map.bimap H2.NameSegment (Map.bimap cvreference cvMdValues),
-      patches = patches & Map.bimap H2.NameSegment unPatchHash,
-      children = children & Map.bimap H2.NameSegment (unCausalHash . snd)
+      patches = patches & Map.bimap H2.NameSegment (Hash32.toHash . unPatchHash),
+      children = children & Map.bimap H2.NameSegment (Hash32.toHash . unCausalHash . snd)
     }
   where
     cvMdValues :: Memory.BranchFull.MetadataSetFormat' Text ComponentHash -> H2.MdValues
     cvMdValues (Memory.BranchFull.Inline refSet) = H2.MdValues $ Set.map cvreference refSet
     cvreference :: V2Reference.Reference' Text ComponentHash -> H2.Reference
-    cvreference = v2ToH2Reference . second unComponentHash
+    cvreference = v2ToH2Reference . second (Hash32.toHash . unComponentHash)
     cvreferent :: Memory.BranchFull.Referent'' Text ComponentHash -> H2.Referent
     cvreferent = \case
-      V2Referent.Ref ref -> (H2.ReferentRef (v2ToH2Reference $ second unComponentHash ref))
+      V2Referent.Ref ref -> (H2.ReferentRef (v2ToH2Reference $ second (Hash32.toHash . unComponentHash) ref))
       V2Referent.Con typeRef conId -> do
-        (H2.ReferentCon (v2ToH2Reference $ second unComponentHash typeRef) conId)
+        (H2.ReferentCon (v2ToH2Reference $ second (Hash32.toHash . unComponentHash) typeRef) conId)
 
 v2ToH2Term :: forall v. Ord v => V2.Term.HashableTerm v -> H2.Term v ()
 v2ToH2Term = ABT.transform convertF

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

@@ -232,7 +232,7 @@ expectValueHashByCausalHashId :: Db.CausalHashId -> Transaction BranchHash
 expectValueHashByCausalHashId = loadValueHashById <=< Q.expectCausalValueHashId
   where
     loadValueHashById :: Db.BranchHashId -> Transaction BranchHash
-    loadValueHashById = fmap BranchHash . Q.expectHash . Db.unBranchHashId
+    loadValueHashById = fmap BranchHash . Q.expectHash32 . Db.unBranchHashId
 
 expectRootCausalHash :: Transaction CausalHash
 expectRootCausalHash = Q.expectCausalHash =<< Q.expectNamespaceRoot
@@ -596,7 +596,7 @@ s2cBranch (S.Branch.Full.Branch tms tps patches children) =
       Map Db.TextId Db.PatchObjectId ->
       Transaction (Map NameSegment (PatchHash, Transaction C.Branch.Patch))
     doPatches = Map.bitraverse (fmap NameSegment . Q.expectText) \patchId -> do
-      h <- PatchHash <$> (Q.expectPrimaryHashByObjectId . Db.unPatchObjectId) patchId
+      h <- PatchHash <$> (Q.expectPrimaryHash32ByObjectId . Db.unPatchObjectId) patchId
       pure (h, expectPatch patchId)
 
     doChildren ::
@@ -1010,7 +1010,7 @@ saveDbPatch ::
   S.PatchFormat ->
   Transaction Db.PatchObjectId
 saveDbPatch hh hash patch = do
-  hashId <- Q.saveHashHash (unPatchHash hash)
+  hashId <- Q.saveHash (unPatchHash hash)
   let bytes = S.putBytes S.putPatchFormat patch
   Db.PatchObjectId <$> Q.saveObject hh hashId ObjectType.Patch bytes
 
@@ -1137,13 +1137,13 @@ declReferentsByPrefix b32prefix pos cid = do
 namespaceHashesByPrefix :: ShortNamespaceHash -> Transaction (Set BranchHash)
 namespaceHashesByPrefix (ShortNamespaceHash b32prefix) = do
   hashIds <- Q.namespaceHashIdByBase32Prefix b32prefix
-  hashes <- traverse (Q.expectHash . Db.unBranchHashId) hashIds
+  hashes <- traverse (Q.expectHash32 . Db.unBranchHashId) hashIds
   pure $ Set.fromList . map BranchHash $ hashes
 
 causalHashesByPrefix :: ShortCausalHash -> Transaction (Set CausalHash)
 causalHashesByPrefix (ShortCausalHash b32prefix) = do
   hashIds <- Q.causalHashIdByBase32Prefix b32prefix
-  hashes <- traverse (Q.expectHash . Db.unCausalHashId) hashIds
+  hashes <- traverse (Q.expectHash32 . Db.unCausalHashId) hashIds
   pure $ Set.fromList . map CausalHash $ hashes
 
 -- | returns a list of known definitions referencing `r`

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

@@ -51,6 +51,7 @@ module U.Codebase.Sqlite.Queries
     isObjectHash,
     expectObject,
     expectPrimaryHashByObjectId,
+    expectPrimaryHash32ByObjectId,
     expectPrimaryHashIdForObject,
     expectObjectWithHashIdAndType,
     expectDeclObject,
@@ -383,7 +384,6 @@ import U.Util.Term qualified as TermUtil
 import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..))
 import Unison.Debug qualified as Debug
 import Unison.Hash (Hash)
-import Unison.Hash qualified as Hash
 import Unison.Hash32 (Hash32)
 import Unison.Hash32 qualified as Hash32
 import Unison.Hash32.Orphans.Sqlite ()
@@ -552,24 +552,24 @@ loadHashIdByHash :: Hash -> Transaction (Maybe HashId)
 loadHashIdByHash = loadHashId . Hash32.fromHash
 
 saveCausalHash :: CausalHash -> Transaction CausalHashId
-saveCausalHash = fmap CausalHashId . saveHashHash . unCausalHash
+saveCausalHash = fmap CausalHashId . saveHash . unCausalHash
 
 saveBranchHash :: BranchHash -> Transaction BranchHashId
-saveBranchHash = fmap BranchHashId . saveHashHash . unBranchHash
+saveBranchHash = fmap BranchHashId . saveHash . unBranchHash
 
 loadCausalHashIdByCausalHash :: CausalHash -> Transaction (Maybe CausalHashId)
 loadCausalHashIdByCausalHash ch = runMaybeT do
-  hId <- MaybeT $ loadHashIdByHash (unCausalHash ch)
+  hId <- MaybeT $ loadHashId (unCausalHash ch)
   Alternative.whenM (lift (isCausalHash hId)) (CausalHashId hId)
 
 expectCausalHashIdByCausalHash :: CausalHash -> Transaction CausalHashId
 expectCausalHashIdByCausalHash ch = do
-  hId <- expectHashIdByHash (unCausalHash ch)
+  hId <- expectHashId (unCausalHash ch)
   pure (CausalHashId hId)
 
 loadCausalByCausalHash :: CausalHash -> Transaction (Maybe (CausalHashId, BranchHashId))
 loadCausalByCausalHash ch = runMaybeT do
-  hId <- MaybeT $ loadHashIdByHash (unCausalHash ch)
+  hId <- MaybeT $ loadHashId (unCausalHash ch)
   bhId <- MaybeT $ loadCausalValueHashId hId
   pure (CausalHashId hId, bhId)
 
@@ -595,7 +595,7 @@ expectHash32 h =
     |]
 
 expectBranchHash :: BranchHashId -> Transaction BranchHash
-expectBranchHash = coerce expectHash
+expectBranchHash = coerce expectHash32
 
 expectBranchHashForCausalHash :: CausalHash -> Transaction BranchHash
 expectBranchHashForCausalHash ch = do
@@ -798,6 +798,13 @@ loadObjectIdForPrimaryHash h =
     Nothing -> pure Nothing
     Just hashId -> loadObjectIdForPrimaryHashId hashId
 
+loadObjectIdForPrimaryHash32 :: Hash32 -> Transaction (Maybe ObjectId)
+loadObjectIdForPrimaryHash32 h =
+  loadHashId h >>= \case
+    Nothing -> pure Nothing
+    Just hashId -> loadObjectIdForPrimaryHashId hashId
+
+
 expectObjectIdForPrimaryHash :: Hash -> Transaction ObjectId
 expectObjectIdForPrimaryHash =
   expectObjectIdForHash32 . Hash32.fromHash
@@ -832,7 +839,7 @@ expectBranchHashIdForHash32 hash =
     |]
 
 expectBranchHashId :: BranchHash -> Transaction BranchHashId
-expectBranchHashId = expectBranchHashIdForHash32 . Hash32.fromHash . unBranchHash
+expectBranchHashId = expectBranchHashIdForHash32 .  unBranchHash
 
 expectCausalHashIdForHash32 :: Hash32 -> Transaction CausalHashId
 expectCausalHashIdForHash32 hash =
@@ -845,7 +852,7 @@ expectCausalHashIdForHash32 hash =
 
 loadPatchObjectIdForPrimaryHash :: PatchHash -> Transaction (Maybe PatchObjectId)
 loadPatchObjectIdForPrimaryHash =
-  (fmap . fmap) PatchObjectId . loadObjectIdForPrimaryHash . unPatchHash
+  (fmap . fmap) PatchObjectId . loadObjectIdForPrimaryHash32 . unPatchHash
 
 loadObjectIdForAnyHash :: Hash -> Transaction (Maybe ObjectId)
 loadObjectIdForAnyHash h =
@@ -1218,7 +1225,7 @@ expectCausalValueHashId (CausalHashId id) =
   queryOneCol (loadCausalValueHashIdSql id) -- (Only id)
 
 expectCausalHash :: CausalHashId -> Transaction CausalHash
-expectCausalHash = coerce expectHash
+expectCausalHash = coerce expectHash32
 
 loadCausalValueHashId :: HashId -> Transaction (Maybe BranchHashId)
 loadCausalValueHashId id =

codebase2/core/U/Codebase/HashTags.hs

@@ -1,17 +1,17 @@
 module U.Codebase.HashTags where
 
-import Unison.Hash (Hash)
+import Unison.Hash32 (Hash32)
 
 -- | Represents a hash of a type or term component
-newtype ComponentHash = ComponentHash {unComponentHash :: Hash}
+newtype ComponentHash = ComponentHash {unComponentHash :: Hash32}
   deriving stock (Eq, Ord, Show)
 
-newtype BranchHash = BranchHash {unBranchHash :: Hash} deriving (Eq, Ord)
+newtype BranchHash = BranchHash {unBranchHash :: Hash32} deriving (Eq, Ord)
 
 -- | Represents a hash of a causal containing values of the provided type.
-newtype CausalHash = CausalHash {unCausalHash :: Hash} deriving (Eq, Ord)
+newtype CausalHash = CausalHash {unCausalHash :: Hash32} deriving (Eq, Ord)
 
-newtype PatchHash = PatchHash {unPatchHash :: Hash} deriving (Eq, Ord)
+newtype PatchHash = PatchHash {unPatchHash :: Hash32} deriving (Eq, Ord)
 
 instance Show BranchHash where
   show h = "BranchHash (" ++ show (unBranchHash h) ++ ")"

lib/unison-hash/src/Unison/Hash32.hs

@@ -11,6 +11,7 @@ module Unison.Hash32
 
     -- ** Base32Hex
     unsafeFromBase32Hex,
+    unsafeFromBase32HexText,
     toBase32Hex,
 
     -- ** Text
@@ -19,6 +20,7 @@ module Unison.Hash32
 where
 
 import U.Util.Base32Hex (Base32Hex (..))
+import U.Util.Base32Hex qualified as Base32Hex
 import Unison.Hash (Hash)
 import Unison.Hash qualified as Hash
 import Unison.Prelude
@@ -53,3 +55,6 @@ toBase32Hex =
 toText :: Hash32 -> Text
 toText =
   coerce
+
+unsafeFromBase32HexText :: Text -> Hash32
+unsafeFromBase32HexText = UnsafeFromBase32Hex . Base32Hex.UnsafeFromText

parser-typechecker/src/Unison/Codebase/Branch.hs

@@ -115,6 +115,7 @@ import Unison.Codebase.Patch (Patch)
 import Unison.Codebase.Patch qualified as Patch
 import Unison.Codebase.Path (Path (..))
 import Unison.Codebase.Path qualified as Path
+import Unison.Hash32 qualified as Hash32
 import Unison.Hashing.V2 qualified as Hashing (ContentAddressable (contentHash))
 import Unison.Hashing.V2.Convert qualified as H
 import Unison.Name (Name)
@@ -547,11 +548,11 @@ modifyPatches seg f = mapMOf edits update
       p' <- case Map.lookup seg m of
         Nothing -> pure $ f Patch.empty
         Just (_, p) -> f <$> p
-      let h = H.hashPatch p'
+      let h = Hash32.fromHash $ H.hashPatch p'
       pure $ Map.insert seg (PatchHash h, pure p') m
 
 replacePatch :: (Applicative m) => NameSegment -> Patch -> Branch0 m -> Branch0 m
-replacePatch n p = over edits (Map.insert n (PatchHash (H.hashPatch p), pure p))
+replacePatch n p = over edits (Map.insert n (PatchHash (Hash32.fromHash $ H.hashPatch p), pure p))
 
 deletePatch :: NameSegment -> Branch0 m -> Branch0 m
 deletePatch n = over edits (Map.delete n)

parser-typechecker/src/Unison/Codebase/Branch/Merge.hs

@@ -29,6 +29,7 @@ import Unison.Codebase.Branch.BranchDiff qualified as BDiff
 import Unison.Codebase.Causal qualified as Causal
 import Unison.Codebase.Patch (Patch)
 import Unison.Codebase.Patch qualified as Patch
+import Unison.Hash32 qualified as Hash32
 import Unison.Hashing.V2.Convert qualified as H
 import Unison.Prelude hiding (empty)
 import Unison.Util.Map (unionWithM)
@@ -88,7 +89,7 @@ merge'' lca mode (Branch x) (Branch y) =
       let newPatches = makePatch <$> Map.difference changedPatches (_edits b0)
           makePatch Patch.PatchDiff {..} =
             let p = Patch.Patch _addedTermEdits _addedTypeEdits
-             in (PatchHash (H.hashPatch p), pure p)
+             in (PatchHash (Hash32.fromHash $ H.hashPatch p), pure p)
       pure $
         branch0
           (Star3.difference (_terms b0) removedTerms <> addedTerms)
@@ -107,7 +108,7 @@ merge'' lca mode (Branch x) (Branch y) =
                   R.difference (Patch._typeEdits p) _removedTypeEdits
                     <> _addedTypeEdits
               }
-      pure (PatchHash (H.hashPatch np), pure np)
+      pure (PatchHash (Hash32.fromHash $ H.hashPatch np), pure np)
 
 merge0 ::
   forall m.
@@ -133,4 +134,4 @@ merge0 lca mode b1 b2 = do
       e1 <- m1
       e2 <- m2
       let e3 = e1 <> e2
-      pure (PatchHash (H.hashPatch e3), pure e3)
+      pure (PatchHash (Hash32.fromHash $ H.hashPatch e3), pure e3)