replace Share.Hash with U.Util.Hash32

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

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

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

@@ -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 :: Hash32 -> Transaction HashId
-saveHash base32 = execute sql (Only base32) >> expectHashId base32
+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 :: Hash32 -> Transaction (Maybe HashId)
-loadHashId base32 = queryMaybeCol loadHashIdSql (Only base32)
+loadHashId hash = queryMaybeCol loadHashIdSql (Only hash)
 
-expectHashId :: Base32Hex -> Transaction HashId
+expectHashId :: Hash32 -> Transaction HashId
-expectHashId base32 = queryOneCol loadHashIdSql (Only base32)
+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 :: Hash32 -> Transaction ()
-tryMoveTempEntityDependents dependencyBase32 = do
+tryMoveTempEntityDependents dependency = do
-  dependents <- getMissingDependentsForTempEntity dependencyBase32
+  dependents <- getMissingDependentsForTempEntity dependency
-  execute deleteMissingDependency (Only dependencyBase32)
+  execute deleteMissingDependency (Only dependency)
-  deleteTempEntity dependencyBase32
+  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 :: Hash32 -> Transaction Bool
-    readyToFlush b32 = queryOneCol [here|
+    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 :: Hash32 -> Transaction ()
-moveTempEntityToMain b32 = do
+moveTempEntityToMain hash = do
-  t <- expectTempEntity b32
+  entity <- expectTempEntity hash
-  deleteTempEntity b32
+  deleteTempEntity hash
-  r <- tempToSyncEntity t
+  entity' <- tempToSyncEntity entity
-  _ <- saveSyncEntity b32 r
+  _ <- saveSyncEntity hash entity'
   pure ()
 
 -- | Read an entity out of temp storage.
-expectTempEntity :: Base32Hex -> Transaction TempEntity
+expectTempEntity :: Hash32 -> Transaction TempEntity
-expectTempEntity b32 = do
+expectTempEntity hash = do
-  queryOneRowCheck sql (Only b32) \(blob, typeId) ->
+  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 :: Hash32 -> SyncEntity -> Transaction (Either CausalHashId ObjectId)
-saveSyncEntity b32Hex entity = do
+saveSyncEntity hash entity = do
-  hashId <- saveHash b32Hex
+  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|

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

@@ -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 putHash32 patchHashLookup
-      putFoldable putBase32Hex patchDefnLookup
+      putFoldable putHash32 patchDefnLookup
     putNamespaceLocalIds BranchFormat.LocalIds {branchTextLookup, branchDefnLookup, branchPatchLookup, branchChildLookup} = do
       putFoldable putText branchTextLookup
-      putFoldable putBase32Hex branchDefnLookup
+      putFoldable putHash32 branchDefnLookup
-      putFoldable putBase32Hex branchPatchLookup
+      putFoldable putHash32 branchPatchLookup
-      putFoldable (putPair putBase32Hex putBase32Hex) branchChildLookup
+      putFoldable (putPair putHash32 putHash32) branchChildLookup
     putSyncCausal Causal.SyncCausalFormat {valueHash, parents} = do
-      putBase32Hex valueHash
+      putHash32 valueHash
-      putFoldable putBase32Hex parents
+      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
+getHash32 :: MonadGet m => m Hash32
-getBase32Hex = Base32Hex.UnsafeFromText <$> getText
+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 getHash32
-        <*> getVector getBase32Hex
+        <*> 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 getHash32
-        <*> getVector getBase32Hex
+        <*> getVector getHash32
-        <*> getVector (getPair getBase32Hex getBase32Hex)
+        <*> getVector (getPair getHash32 getHash32)
 
 getTempCausalFormat :: MonadGet m => m TempEntity.TempCausalFormat
 getTempCausalFormat =
   Causal.SyncCausalFormat
-    <$> getBase32Hex
+    <$> getHash32
-    <*> getVector getBase32Hex
+    <*> getVector getHash32
 
 getSymbol :: MonadGet m => m Symbol
 getSymbol = Symbol <$> getVarInt <*> getText

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

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

codebase2/codebase-sqlite/package.yaml

@@ -33,6 +33,7 @@ dependencies:
   - unison-sqlite
   - unison-util
   - unison-util-base32hex
+  - unison-util-base32hex-orphans-sqlite
   - unison-util-serialization
   - unison-util-term
   - unliftio

codebase2/codebase-sqlite/unison-codebase-sqlite.cabal

@@ -106,6 +106,7 @@ library
     , unison-sqlite
     , unison-util
     , unison-util-base32hex
+    , unison-util-base32hex-orphans-sqlite
     , unison-util-serialization
     , unison-util-term
     , unliftio

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"
 

lib/unison-util-base32hex-orphans-aeson/package.yaml

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

lib/unison-util-base32hex-orphans-aeson/src/U/Util/Hash32/Orphans/Aeson.hs

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

lib/unison-util-base32hex-orphans-aeson/unison-util-base32hex-orphans-aeson.cabal

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

lib/unison-util-base32hex-orphans-sqlite/package.yaml

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

lib/unison-util-base32hex-orphans-sqlite/src/U/Util/Hash32/Orphans/Sqlite.hs

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

lib/unison-util-base32hex-orphans-sqlite/unison-util-base32hex-orphans-sqlite.cabal

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

lib/unison-util-base32hex/src/U/Util/Hash32.hs

@@ -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
+--
-
+-- Some orphan instances provided in:
-fromBase32Hex :: Base32Hex -> Hash32
+--
-fromBase32Hex =
+--   * @unison-util-base32hex-orphans-aeson@
-  Hash32
+--   * @unison-util-base32hex-orphans-sqlite@
-
+newtype Hash32 = UnsafeFromBase32Hex Base32Hex
-toBase32Hex :: Hash32 -> Base32Hex
+  deriving (Eq, Ord, Show) via (Text)
-toBase32Hex =
-  coerce
 
 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

stack.yaml

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

unison-cli/src/Unison/CommandLine/OutputMessages.hs

@@ -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 $
+          pure $
-          P.lines [cache, "", displayTestResults True ppe oks fails]
+            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
+prettyHash32 :: IsString s => Hash32 -> P.Pretty s
-prettyShareHash = prettyBase32Hex# . Share.Hash.toBase32Hex
+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

unison-cli/src/Unison/Share/Sync.hs

@@ -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 U.Util.Hash32 (Hash32)
-import qualified U.Util.Hash as Hash
 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)
+  | FastForwardPushErrorServerMissingDependencies (NESet Hash32)
-  | --                              Parent     Child
+  | --                              Parent Child
-    FastForwardPushInvalidParentage Share.Hash Share.Hash
+    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 :: Hash32 -> Sqlite.Transaction (Maybe EntityLocation)
-entityLocation (Share.Hash hash) =
+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 ->
+  Hash32 ->
-  Share.Entity Text Share.Hash Share.HashJWT ->
+  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)
+  syncEntity <- Q.tempToSyncEntity (entityToTempEntity Share.hashJWTHash entity)
-  _id <- Q.saveSyncEntity (Share.toBase32Hex hash) syncEntity
+  _id <- Q.saveSyncEntity hash syncEntity
   pure ()
 
 -- | Insert an entity and its missing dependencies.
 insertTempEntity ::
-  Share.Hash ->
+  Hash32 ->
-  Share.Entity Text Share.Hash Share.HashJWT ->
+  Share.Entity Text Hash32 Share.HashJWT ->
   NESet Share.HashJWT ->
   Sqlite.Transaction ()
 insertTempEntity hash entity missingDependencies =
   Q.insertTempEntity
-    (Share.toBase32Hex hash)
+    hash
-    (entityToTempEntity (Share.toBase32Hex . Share.hashJWTHash) entity)
+    (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
     )

unison-share-api/package.yaml

@@ -47,6 +47,7 @@ dependencies:
   - unison-pretty-printer
   - unison-util
   - unison-util-base32hex
+  - unison-util-base32hex-orphans-aeson
   - unison-util-relation
   - unison-sqlite
   - unliftio

unison-share-api/src/Unison/Sync/Common.hs

@@ -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 U.Util.Hash32 (Hash32)
-import qualified U.Util.Hash as Hash
+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
+-- FIXME this isn't the right module  for this conversion
-causalHashToShareHash =
+causalHashToHash32 :: CausalHash -> Hash32
-  Share.Hash . Hash.toBase32Hex . unCausalHash
+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 :: forall hash. (hash -> Hash32) -> Share.Entity Text Hash32 hash -> TempEntity
-entityToTempEntity toBase32Hex = \case
+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,
+        { valueHash = toHash32 namespaceHash,
-          parents = Vector.fromList (map toBase32Hex (Set.toList parents))
+          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),
+          branchDefnLookup = Vector.fromList (map toHash32 defnLookup),
-          branchPatchLookup = Vector.fromList (map toBase32Hex patchLookup),
+          branchPatchLookup = Vector.fromList (map toHash32 patchLookup),
-          branchChildLookup = Vector.fromList (map (\(x, y) -> (toBase32Hex x, toBase32Hex y)) childLookup)
+          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),
+          patchHashLookup = Vector.fromList oldHashLookup,
-          patchDefnLookup = Vector.fromList (map toBase32Hex newHashLookup)
+          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),
+              oldHashLookup = Vector.toList patchHashLookup,
-              newHashLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) patchDefnLookup),
+              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),
+              oldHashLookup = Vector.toList patchHashLookup,
-              newHashLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) patchDefnLookup),
+              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),
+                defnLookup = Vector.toList branchDefnLookup,
-                patchLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) branchPatchLookup),
+                patchLookup = Vector.toList branchPatchLookup,
-                childLookup =
+                childLookup = Vector.toList branchChildLookup,
-                  Vector.toList
-                    (coerce @(Vector (Base32Hex, Base32Hex)) @(Vector (Share.Hash, Share.Hash)) 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),
+                defnLookup = Vector.toList branchDefnLookup,
-                patchLookup = Vector.toList (coerce @(Vector Base32Hex) @(Vector Share.Hash) branchPatchLookup),
+                patchLookup = Vector.toList branchPatchLookup,
-                childLookup =
+                childLookup = Vector.toList branchChildLookup,
-                  Vector.toList
-                    (coerce @(Vector (Base32Hex, Base32Hex)) @(Vector (Share.Hash, Share.Hash)) branchChildLookup),
                 bytes
               }
   Entity.C Causal.SyncCausalFormat {valueHash, parents} ->
     Share.C
       Share.Causal
-        { namespaceHash = Share.Hash valueHash,
+        { namespaceHash = valueHash,
-          parents = Set.fromList (coerce @[Base32Hex] @[Share.Hash] (Vector.toList parents))
+          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
         }

unison-share-api/src/Unison/Sync/Types.hs

@@ -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
+    expectedHash :: Maybe Hash32, -- Nothing requires empty history at destination
-    newHash :: Hash
+    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,
+    expectedHash :: Maybe Hash32,
-    actualHash :: Maybe Hash
+    actualHash :: Maybe Hash32
   }
   deriving stock (Show, Eq, Ord)
 

unison-share-api/unison-share-api.cabal

@@ -105,6 +105,7 @@ library
     , unison-sqlite
     , unison-util
     , unison-util-base32hex
+    , unison-util-base32hex-orphans-aeson
     , unison-util-relation
     , unliftio
     , unordered-containers