Start wiring in personal keys to migration

ChrisPenner · ChrisPenner · commit c0156f8755d3 · 2025-11-05T15:35:42.000-08:00
diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs
@@ -263,6 +263,7 @@ module U.Codebase.Sqlite.Queries
     addUpgradeBranchTable,
     addHistoryComments,
     addHistoryCommentHashing,
+    historyCommentHashingCleanup,
 
     -- ** schema version
     currentSchemaVersion,
@@ -544,6 +545,10 @@ addHistoryCommentHashing :: Transaction ()
 addHistoryCommentHashing =
   executeStatements $(embedProjectStringFile "sql/021-hash-history-comments.sql")
 
+historyCommentHashingCleanup :: Transaction ()
+historyCommentHashingCleanup =
+  executeStatements $(embedProjectStringFile "sql/022-hash-history-comments-cleanup.sql")
+
 schemaVersion :: Transaction SchemaVersion
 schemaVersion =
   queryOneCol
diff --git a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql
@@ -11,11 +11,10 @@ CREATE TABLE history_comments_new (
   -- using strftime('%s', 'now', 'subsec')
   created_at TEXT NOT NULL,
 
-  comment_hash_id UNIQUE INTEGER NOT NULL REFERENCES hash(id),
+  comment_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id),
   author_thumbprint_id INTEGER NOT NULL REFERENCES key_thumbprints(id)
 );
 
-CREATE INDEX history_comments_by_causal_hash_id ON history_comments_new(causal_hash_id, created_at DESC);
 
 CREATE TABLE history_comment_revisions_new (
   id INTEGER PRIMARY KEY,
@@ -32,10 +31,9 @@ CREATE TABLE history_comment_revisions_new (
   -- but you can ask to hide them.
   hidden BOOL NOT NULL DEFAULT FALSE,
 
-  revision_hash_id UNIQUE INTEGER NOT NULL REFERENCES hash(id)
+  revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id)
 );
 
-CREATE INDEX history_comment_revisions_by_comment_id_and_created_at ON history_comment_revisions_new(comment_id, created_at DESC);
 
 -- Copy data from old tables to new tables
 INSERT INTO history_comments_new (id, causal_hash_id, author, created_at, comment_hash_id, author_thumbprint_id)
@@ -53,3 +51,6 @@ DROP TABLE history_comment_revisions;
 -- Rename new tables to old table names
 ALTER TABLE history_comments_new RENAME TO history_comments;
 ALTER TABLE history_comment_revisions_new RENAME TO history_comment_revisions;
+
+CREATE INDEX history_comments_by_causal_hash_id ON history_comments(causal_hash_id, created_at DESC);
+CREATE INDEX history_comment_revisions_by_comment_id_and_created_at ON history_comment_revisions(comment_id, created_at DESC);
diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal
@@ -31,6 +31,7 @@ extra-source-files:
     sql/019-add-upgrade-branch-table.sql
     sql/020-add-history-comments.sql
     sql/021-hash-history-comments.sql
+    sql/022-hash-history-comments-cleanup.sql
     sql/create.sql
 
 source-repository head
diff --git a/lib/unison-credentials/package.yaml b/lib/unison-credentials/package.yaml
@@ -0,0 +1,55 @@
+name: unison-credentials
+github: unisonweb/unison
+copyright: Copyright (C) 2013-2025 Unison Computing, PBC and contributors
+
+ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures
+
+dependencies:
+  - base
+  - aeson
+  - containers
+  - jose
+  - text
+  - base64-bytestring
+  - lens
+  - memory
+  - network-uri
+  - time
+  - unison-core1
+  - unison-prelude
+  - lock-file
+
+library:
+  source-dirs: src
+  when:
+    - condition: false
+      other-modules: Paths_unison_credentials
+
+default-extensions:
+  - ApplicativeDo
+  - BangPatterns
+  - BlockArguments
+  - DeriveAnyClass
+  - DeriveFunctor
+  - DeriveGeneric
+  - DeriveTraversable
+  - DerivingStrategies
+  - DerivingVia
+  - DoAndIfThenElse
+  - DuplicateRecordFields
+  - FlexibleContexts
+  - FlexibleInstances
+  - GeneralizedNewtypeDeriving
+  - ImportQualifiedPost
+  - LambdaCase
+  - MultiParamTypeClasses
+  - NamedFieldPuns
+  - OverloadedStrings
+  - PatternSynonyms
+  - RankNTypes
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TupleSections
+  - TypeApplications
+  - TypeFamilies
+  - ViewPatterns
diff --git a/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs b/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs
diff --git a/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs b/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs
diff --git a/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs b/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs
diff --git a/lib/unison-credentials/src/Unison/Auth/Types.hs b/lib/unison-credentials/src/Unison/Auth/Types.hs
diff --git a/lib/unison-credentials/unison-credentials.cabal b/lib/unison-credentials/unison-credentials.cabal
@@ -0,0 +1,69 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.38.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           unison-credentials
+version:        0.0.0
+homepage:       https://github.com/unisonweb/unison#readme
+bug-reports:    https://github.com/unisonweb/unison/issues
+copyright:      Copyright (C) 2013-2025 Unison Computing, PBC and contributors
+build-type:     Simple
+
+source-repository head
+  type: git
+  location: https://github.com/unisonweb/unison
+
+library
+  exposed-modules:
+      Unison.Auth.CredentialFile
+      Unison.Auth.CredentialManager
+      Unison.Auth.PersonalKey
+      Unison.Auth.Types
+  hs-source-dirs:
+      src
+  default-extensions:
+      ApplicativeDo
+      BangPatterns
+      BlockArguments
+      DeriveAnyClass
+      DeriveFunctor
+      DeriveGeneric
+      DeriveTraversable
+      DerivingStrategies
+      DerivingVia
+      DoAndIfThenElse
+      DuplicateRecordFields
+      FlexibleContexts
+      FlexibleInstances
+      GeneralizedNewtypeDeriving
+      ImportQualifiedPost
+      LambdaCase
+      MultiParamTypeClasses
+      NamedFieldPuns
+      OverloadedStrings
+      PatternSynonyms
+      RankNTypes
+      ScopedTypeVariables
+      StandaloneDeriving
+      TupleSections
+      TypeApplications
+      TypeFamilies
+      ViewPatterns
+  ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures
+  build-depends:
+      aeson
+    , base
+    , base64-bytestring
+    , containers
+    , jose
+    , lens
+    , lock-file
+    , memory
+    , network-uri
+    , text
+    , time
+    , unison-core1
+    , unison-prelude
+  default-language: Haskell2010
diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml
@@ -54,6 +54,7 @@ library:
     - unison-codebase-sync
     - unison-core
     - unison-core1
+    - unison-credentials
     - unison-hash
     - unison-hashing-v2
     - unison-prelude
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs
@@ -14,6 +14,7 @@ import Text.Printf (printf)
 import U.Codebase.Reference qualified as C.Reference
 import U.Codebase.Sqlite.DbId (HashVersion (..), SchemaVersion (..))
 import U.Codebase.Sqlite.Queries qualified as Q
+import Unison.Auth.CredentialManager (getOrCreatePersonalKey)
 import Unison.Codebase (CodebasePath)
 import Unison.Codebase.Init (BackupStrategy (..), VacuumStrategy (..))
 import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (OpenCodebaseUnknownSchemaVersion))
@@ -34,6 +35,7 @@ import Unison.Codebase.Type (LocalOrRemote (..))
 import Unison.ConstructorType qualified as CT
 import Unison.Debug qualified as Debug
 import Unison.Hash (Hash)
+import Unison.KeyThumbprint (KeyThumbprint)
 import Unison.Prelude
 import Unison.Sqlite qualified as Sqlite
 import Unison.Sqlite.Connection qualified as Sqlite.Connection
@@ -44,14 +46,15 @@ import UnliftIO qualified
 -- | Mapping from schema version to the migration required to get there.
 -- E.g. The migration at index 2 must be run on a codebase at version 1.
 migrations ::
+  KeyThumbprint ->
   (MVar Region.ConsoleRegion) ->
   -- | A 'getDeclType'-like lookup, possibly backed by a cache.
   (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) ->
   TVar (Map Hash Ops2.TermBufferEntry) ->
   TVar (Map Hash Ops2.DeclBufferEntry) ->
   CodebasePath ->
   Map SchemaVersion (Sqlite.Connection -> IO ())
-migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath =
+migrations keyThumbprint regionVar getDeclType termBuffer declBuffer rootCodebasePath =
   Map.fromList
     [ (2, runT $ migrateSchema1To2 getDeclType termBuffer declBuffer),
       -- The 1 to 2 migration kept around hash objects of hash version 1, unfortunately this
@@ -93,7 +96,8 @@ migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath =
       sqlMigration 22 Q.addUpgradeBranchTable,
       sqlMigration 23 Q.addHistoryComments,
       sqlMigration 24 Q.addHistoryCommentHashing,
-      (25, runT hashHistoryCommentsMigration)
+      (25, runT $ hashHistoryCommentsMigration keyThumbprint),
+      sqlMigration 26 Q.historyCommentHashingCleanup
     ]
   where
     runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO ()
@@ -128,6 +132,8 @@ checkCodebaseIsUpToDate = do
       | schemaVersion < Q.currentSchemaVersion -> CodebaseRequiresMigration schemaVersion Q.currentSchemaVersion
       | otherwise -> CodebaseUnknownSchemaVersion schemaVersion
 
+type PersonalKeyThumbprint = Text
+
 -- | Migrates a codebase up to the most recent version known to ucm.
 -- This is a No-op if it's up to date
 -- Returns an error if the schema version is newer than this ucm knows about.
@@ -155,7 +161,8 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh
 
     Region.displayConsoleRegions do
       (`UnliftIO.finally` finalizeRegion) do
-        let migs = migrations regionVar getDeclType termBuffer declBuffer root
+        getOrCreatePersonalKey
+        let migs = migrations keyThumbprint regionVar getDeclType termBuffer declBuffer root
         -- The highest schema that this ucm knows how to migrate to.
         let highestKnownSchemaVersion = fst . head $ Map.toDescList migs
         currentSchemaVersion <- Sqlite.runTransaction conn Q.schemaVersion
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs
@@ -8,41 +8,43 @@ import U.Codebase.HashTags
 import U.Codebase.Sqlite.DbId (HistoryCommentId (..), HistoryCommentRevisionId (HistoryCommentRevisionId))
 import U.Codebase.Sqlite.Orphans (AsSqlite (..))
 import U.Codebase.Sqlite.Queries qualified as Q
+import Unison.Debug qualified as Debug
 import Unison.Hash (Hash)
 import Unison.Hashing.HistoryComments (hashHistoryComment, hashHistoryCommentRevision)
 import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..))
-import Unison.KeyThumbprint (KeyThumbprint (KeyThumbprint))
+import Unison.KeyThumbprint (KeyThumbprint)
 import Unison.Prelude
 import Unison.Sqlite qualified as Sqlite
 
 -- | This migration just deletes all the old name lookups, it doesn't recreate them.
 -- On share we'll rebuild only the required name lookups from scratch.
-hashHistoryCommentsMigration :: Sqlite.Transaction ()
-hashHistoryCommentsMigration = do
+hashHistoryCommentsMigration :: KeyThumbprint -> Sqlite.Transaction ()
+hashHistoryCommentsMigration defaultKeyThumbprint = do
   Q.expectSchemaVersion 24
-  hashAllHistoryComments
+  hashAllHistoryComments defaultKeyThumbprint
   Q.setSchemaVersion 25
 
-hashAllHistoryComments :: Sqlite.Transaction ()
-hashAllHistoryComments = do
+hashAllHistoryComments :: KeyThumbprint -> Sqlite.Transaction ()
+hashAllHistoryComments defaultKeyThumbprint = do
   historyComments <-
-    Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, Text, UTCTime)
+    Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, UTCTime)
       [Sqlite.sql|
     SELECT comment.id, causal_hash.base32, comment.author, thumbprint.thumbprint, comment.created_at
       FROM history_comments comment
-      JOIN hash causal_hash ON history_comments.causal_hash_id = causal_hash.id
-      JOIN key_thumbprints thumbprint ON history_comments.author_thumbprint_id = thumbprint.id
+      JOIN hash causal_hash ON comment.causal_hash_id = causal_hash.id
     |]
-  for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, authorThumbprint, createdAt) -> do
+  Debug.debugM Debug.Temp "Got comments" historyComments
+  for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, createdAt) -> do
     let historyComment =
           HistoryComment
             { author,
               createdAt,
-              authorThumbprint = KeyThumbprint authorThumbprint,
+              authorThumbprint = defaultKeyThumbprint,
               causal = coerce @_ @CausalHash causalHash,
               commentId = ()
             }
     let historyCommentHash = hashHistoryComment historyComment
+    Debug.debugM Debug.Temp "Hashing history comment" (author, causalHash)
     historyCommentHashId <- Q.saveHistoryCommentHash historyCommentHash.commentId
     Sqlite.execute
       [Sqlite.sql|
@@ -53,11 +55,14 @@ hashAllHistoryComments = do
   historyCommentRevisions <-
     Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, UTCTime, AsSqlite Hash)
       [Sqlite.sql|
-    SELECT hcr.id, hcr.subject, hcr.content, hcr.created_at, comment_hash.base32
+    SELECT hcr.id, hcr.subject, hcr.contents, hcr.created_at, comment_hash.base32
       FROM history_comment_revisions hcr
-      JOIN hash comment_hash ON hcr.comment_hash_id = comment_hash.id
+      JOIN history_comments comment ON hcr.comment_id = comment.id
+      JOIN hash comment_hash ON comment.comment_hash_id = comment_hash.id
     |]
+  Debug.debugM Debug.Temp "Got revisions" historyCommentRevisions
   for_ historyCommentRevisions $ \(HistoryCommentRevisionId revisionId, subject, content, createdAt, commentHash) -> do
+    Debug.debugM Debug.Temp "Hashing history comment revision" (subject, content)
     let historyCommentRevision =
           HistoryCommentRevision
             { subject,
diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs
@@ -87,6 +87,7 @@ createSchema = do
   Q.addUpgradeBranchTable
   Q.addHistoryComments
   Q.addHistoryCommentHashing
+  Q.historyCommentHashingCleanup
   (_, emptyCausalHashId) <- emptyCausalHash
   (_, ProjectBranchRow {projectId, branchId}) <-
     insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId
diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal
@@ -123,7 +123,6 @@ library
       Unison.PrettyPrintEnvDecl
       Unison.PrintError
       Unison.Result
-      Unison.Share.Types
       Unison.Syntax.DeclParser
       Unison.Syntax.DeclPrinter
       Unison.Syntax.FileParser
@@ -239,6 +238,7 @@ library
     , unison-codebase-sync
     , unison-core
     , unison-core1
+    , unison-credentials
     , unison-hash
     , unison-hashing-v2
     , unison-prelude
diff --git a/stack.yaml b/stack.yaml
@@ -23,6 +23,7 @@ packages:
   - lib/orphans/unison-hash-orphans-aeson
   - lib/orphans/unison-hash-orphans-sqlite
   - lib/orphans/uuid-orphans-sqlite
+  - lib/unison-credentials
   - lib/unison-hash
   - lib/unison-hashing
   - lib/unison-prelude
diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal
@@ -23,13 +23,9 @@ library
       Compat
       Stats
       System.Path
-      Unison.Auth.CredentialFile
-      Unison.Auth.CredentialManager
       Unison.Auth.Discovery
       Unison.Auth.HTTPClient
-      Unison.Auth.PersonalKey
       Unison.Auth.Tokens
-      Unison.Auth.Types
       Unison.Auth.UserInfo
       Unison.Cli.DownloadUtils
       Unison.Cli.MergeTypes
diff --git a/unison-core/package.yaml b/unison-core/package.yaml
@@ -10,6 +10,7 @@ library:
   ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -funbox-strict-fields
   dependencies:
     - base
+    - aeson
     - bytestring
     - containers >= 0.6.3
     - cryptonite
@@ -22,10 +23,12 @@ library:
     - megaparsec
     - memory
     - mtl
+    - network-uri
     - nonempty-containers
     - rfc5051
     - semialign
     - semigroups
+    - servant-client
     - text
     - text-builder
     - time
diff --git a/unison-core/src/Unison/Share/Types.hs b/unison-core/src/Unison/Share/Types.hs
diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal
