Hash history comments and sign them with the author's personal key.

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

@@ -39,6 +39,14 @@ newtype CausalHashId = CausalHashId {unCausalHashId :: HashId}
   deriving (Eq, Ord)
   deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via HashId
 
+newtype CommentHashId = CommentHashId {unCommentHashId :: HashId}
+  deriving (Eq, Ord)
+  deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via HashId
+
+newtype CommentRevisionHashId = CommentRevisionHashId {unCommentRevisionHashId :: HashId}
+  deriving (Eq, Ord)
+  deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via HashId
+
 newtype ProjectBranchId = ProjectBranchId {unProjectBranchId :: UUID}
   deriving newtype (Eq, FromField, Ord, Show, ToField)
 
@@ -67,6 +75,20 @@ instance Show BranchHashId where
 instance Show CausalHashId where
   show h = "CausalHashId (" ++ show (unCausalHashId h) ++ ")"
 
+instance Show CommentHashId where
+  show h = "CommentHashId (" ++ show (unCommentHashId h) ++ ")"
+
+instance Show CommentRevisionHashId where
+  show h = "CommentRevisionHashId (" ++ show (unCommentRevisionHashId h) ++ ")"
+
 newtype HistoryCommentId = HistoryCommentId Word64
   deriving (Eq, Ord, Show)
   deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via Word64
+
+newtype HistoryCommentRevisionId = HistoryCommentRevisionId Word64
+  deriving (Eq, Ord, Show)
+  deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via Word64
+
+newtype KeyThumbprintId = KeyThumbprintId Word64
+  deriving (Eq, Ord, Show)
+  deriving (Num, Real, Enum, Integral, Bits, FromField, ToField) via Word64

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 -- | Some naming conventions used in this module:
@@ -35,6 +36,8 @@ module U.Codebase.Sqlite.Queries
     expectCausalHash,
     expectBranchHashForCausalHash,
     saveBranchHash,
+    saveHistoryCommentHash,
+    saveHistoryCommentRevisionHash,
 
     -- * hash_object table
     saveHashObject,
@@ -260,6 +263,8 @@ module U.Codebase.Sqlite.Queries
     addDerivedDependentsByDependencyIndex,
     addUpgradeBranchTable,
     addHistoryComments,
+    addHistoryCommentHashing,
+    historyCommentHashingCleanup,
 
     -- ** schema version
     currentSchemaVersion,
@@ -296,6 +301,9 @@ module U.Codebase.Sqlite.Queries
     getConfigValue,
     setConfigValue,
 
+    -- * Personal Keys
+    ensurePersonalKeyThumbprintId,
+
     -- * Types
     TextPathSegments,
     JsonParseFailure (..),
@@ -328,14 +336,21 @@ import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Data.Text.Lazy qualified as Text.Lazy
 import Data.Time qualified as Time
+import Data.Time.Clock.POSIX qualified as POSIX
 import Data.Vector qualified as Vector
 import Network.URI (URI)
 import U.Codebase.Branch.Type (NamespaceStats (..))
 import U.Codebase.Config (AuthorName, ConfigKey)
 import U.Codebase.Config qualified as Config
 import U.Codebase.Decl qualified as C
 import U.Codebase.Decl qualified as C.Decl
-import U.Codebase.HashTags (BranchHash (..), CausalHash (..), PatchHash (..))
+import U.Codebase.HashTags
+  ( BranchHash (..),
+    CausalHash (..),
+    HistoryCommentHash (..),
+    HistoryCommentRevisionHash (..),
+    PatchHash (..),
+  )
 import U.Codebase.Reference (Reference' (..))
 import U.Codebase.Reference qualified as C (Reference)
 import U.Codebase.Reference qualified as C.Reference
@@ -348,9 +363,13 @@ import U.Codebase.Sqlite.DbId
   ( BranchHashId (..),
     BranchObjectId (..),
     CausalHashId (..),
+    CommentHashId (..),
+    CommentRevisionHashId (..),
     HashId (..),
     HashVersion,
     HistoryCommentId,
+    HistoryCommentRevisionId,
+    KeyThumbprintId,
     ObjectId (..),
     PatchObjectId (..),
     ProjectBranchId (..),
@@ -366,7 +385,6 @@ import U.Codebase.Sqlite.Decode
 import U.Codebase.Sqlite.Entity (SyncEntity)
 import U.Codebase.Sqlite.Entity qualified as Entity
 import U.Codebase.Sqlite.HashHandle (HashHandle (..))
-import U.Codebase.Sqlite.HistoryComment (HistoryComment (..))
 import U.Codebase.Sqlite.LocalIds
   ( LocalDefnId (..),
     LocalIds,
@@ -407,6 +425,12 @@ import Unison.Hash qualified as Hash
 import Unison.Hash32 (Hash32)
 import Unison.Hash32 qualified as Hash32
 import Unison.Hash32.Orphans.Sqlite ()
+import Unison.HistoryComment
+  ( HistoryComment (..),
+    HistoryCommentRevision (..),
+    LatestHistoryComment,
+  )
+import Unison.KeyThumbprint (KeyThumbprint (..))
 import Unison.Name (Name)
 import Unison.Name qualified as Name
 import Unison.NameSegment.Internal (NameSegment (NameSegment))
@@ -429,7 +453,7 @@ type TextPathSegments = [Text]
 -- * main squeeze
 
 currentSchemaVersion :: SchemaVersion
-currentSchemaVersion = 23
+currentSchemaVersion = 26
 
 runCreateSql :: Transaction ()
 runCreateSql =
@@ -519,6 +543,14 @@ addHistoryComments :: Transaction ()
 addHistoryComments =
   executeStatements $(embedProjectStringFile "sql/020-add-history-comments.sql")
 
+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
@@ -629,6 +661,12 @@ expectCausalByCausalHash ch = do
   bhId <- expectCausalValueHashId hId
   pure (hId, bhId)
 
+saveHistoryCommentHash :: HistoryCommentHash -> Transaction CommentHashId
+saveHistoryCommentHash = fmap CommentHashId . saveHashHash . unHistoryCommentHash
+
+saveHistoryCommentRevisionHash :: HistoryCommentRevisionHash -> Transaction CommentRevisionHashId
+saveHistoryCommentRevisionHash = fmap CommentRevisionHashId . saveHashHash . unHistoryCommentRevisionHash
+
 expectHashIdByHash :: Hash -> Transaction HashId
 expectHashIdByHash = expectHashId . Hash32.fromHash
 
@@ -4123,44 +4161,90 @@ saveSquashResult bhId chId =
       ON CONFLICT DO NOTHING
     |]
 
+-- Convert milliseconds since epoch to UTCTime _exactly_.
+-- UTCTime has picosecond precision so this is lossless.
+millisToUTCTime :: Int64 -> Time.UTCTime
+millisToUTCTime ms =
+  toRational ms
+    & (/ (1_000 :: Rational))
+    & fromRational
+    & POSIX.posixSecondsToUTCTime
+
+utcTimeToMillis :: Time.UTCTime -> Int64
+utcTimeToMillis utcTime =
+  POSIX.utcTimeToPOSIXSeconds utcTime
+    & toRational
+    & (* (1_000 :: Rational))
+    & round
+
 getLatestCausalComment ::
   CausalHashId ->
-  Transaction (Maybe (HistoryComment CausalHashId HistoryCommentId))
+  Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash HistoryCommentRevisionId HistoryCommentHash))
 getLatestCausalComment causalHashId =
-  queryMaybeRow @(HistoryCommentId, CausalHashId, Text, Text, Text)
+  -- FromRow instances cap out at 10-tuples, so we do a cheeky :. trick.
+  queryMaybeRow @((Hash32, Hash32, Text, KeyThumbprintId, Int64, HistoryCommentRevisionId, Text, Text, Bool) :. (ByteString, Int64))
     [sql|
-      SELECT cc.id, cc.causal_hash_id, cc.author, ccr.subject, ccr.contents
+      SELECT comment_hash.base32, causal_hash.base32, cc.author, cc.author_thumbprint_id, cc.created_at_ms, ccr.id, ccr.subject, ccr.contents, ccr.hidden, ccr.author_signature, ccr.created_at_ms
         FROM history_comments AS cc
         JOIN history_comment_revisions AS ccr ON cc.id = ccr.comment_id
+        JOIN hash AS comment_hash ON comment_hash.id = cc.comment_hash_id
+        JOIN hash AS causal_hash ON causal_hash.id = cc.causal_hash_id
         WHERE cc.causal_hash_id = :causalHashId
-        ORDER BY ccr.created_at DESC
+        ORDER BY ccr.created_at_ms DESC
         LIMIT 1
     |]
-    <&> fmap \(commentId, causal, author, subject, content) ->
-      HistoryComment {author, subject, content, commentId, causal}
-
-commentOnCausal :: HistoryComment CausalHashId () -> Transaction ()
-commentOnCausal HistoryComment {author, content, subject, causal = causalHashId} = do
-  mayExistingCommentId <-
-    queryMaybeCol @HistoryCommentId
-      [sql|
+    <&> fmap \((commentHash, causalHash, author, authorThumbprint, commentCreatedAtMs, revisionId, subject, content, isHidden) :. (authorSignature, revisionCreatedAtMs)) ->
+      HistoryCommentRevision
+        { subject,
+          content,
+          createdAt = millisToUTCTime revisionCreatedAtMs,
+          revisionId,
+          isHidden,
+          authorSignature,
+          comment =
+            HistoryComment
+              { author,
+                authorThumbprint,
+                causal = CausalHash . Hash32.toHash $ causalHash,
+                createdAt = millisToUTCTime commentCreatedAtMs,
+                commentId = HistoryCommentHash . Hash32.toHash $ commentHash
+              }
+        }
+
+commentOnCausal :: LatestHistoryComment KeyThumbprint CausalHashId HistoryCommentRevisionHash HistoryCommentHash -> Transaction ()
+commentOnCausal
+  HistoryCommentRevision
+    { content,
+      subject,
+      revisionId = commentRevisionHash,
+      authorSignature,
+      comment = HistoryComment {author, authorThumbprint, causal = causalHashId, commentId = commentHash}
+    } = do
+    commentHashId <- saveHistoryCommentHash commentHash
+    commentRevisionHashId <- saveHistoryCommentRevisionHash commentRevisionHash
+    thumbprintId <- ensurePersonalKeyThumbprintId authorThumbprint
+    mayExistingCommentId <-
+      queryMaybeCol @HistoryCommentId
+        [sql|
       SELECT id
         FROM history_comments
         WHERE causal_hash_id = :causalHashId
     |]
-  commentId <- case mayExistingCommentId of
-    Nothing ->
-      queryOneCol @HistoryCommentId
-        [sql|
-            INSERT INTO history_comments (author, causal_hash_id, created_at)
-            VALUES (:author, :causalHashId, strftime('%s', 'now', 'subsec'))
+    now <- Sqlite.unsafeIO $ Time.getCurrentTime
+    createdAtMs <- pure $ utcTimeToMillis now
+    commentId <- case mayExistingCommentId of
+      Nothing ->
+        queryOneCol @HistoryCommentId
+          [sql|
+            INSERT INTO history_comments (comment_hash_id, author_thumbprint_id, author, causal_hash_id, created_at_ms)
+            VALUES (:commentHashId, :thumbprintId, :author, :causalHashId, :createdAtMs)
             RETURNING id
           |]
-    Just cid -> pure cid
-  execute
-    [sql|
-      INSERT INTO history_comment_revisions (comment_id, subject, contents, created_at)
-      VALUES (:commentId, :subject, :content, strftime('%s', 'now', 'subsec'))
+      Just cid -> pure cid
+    execute
+      [sql|
+      INSERT INTO history_comment_revisions (revision_hash_id, comment_id, subject, contents, author_signature, created_at_ms)
+      VALUES (:commentRevisionHashId, :commentId, :subject, :content, :authorSignature, :createdAtMs)
     |]
 
 getAuthorName :: Transaction (Maybe AuthorName)
@@ -4192,3 +4276,24 @@ getConfigValue key =
       FROM config
       WHERE key = :key
     |]
+
+-- | Save or return the id for a given key thumbprint
+ensurePersonalKeyThumbprintId :: KeyThumbprint -> Transaction KeyThumbprintId
+ensurePersonalKeyThumbprintId thumbprint = do
+  let thumbprintText = thumbprintToText thumbprint
+  mayExisting <-
+    queryMaybeCol
+      [sql|
+    SELECT id
+    FROM key_thumbprints
+    WHERE thumbprint = :thumbprintText
+    |]
+  case mayExisting of
+    Just thumbprintId -> pure thumbprintId
+    Nothing ->
+      queryOneCol
+        [sql|
+          INSERT INTO key_thumbprints (thumbprint)
+          VALUES (:thumbprintText)
+          RETURNING id
+        |]

codebase2/codebase-sqlite/sql/021-hash-history-comments.sql

@@ -0,0 +1,28 @@
+-- Table for storing personal key thumbprints,
+-- which we may later associate with users.
+CREATE TABLE IF NOT EXISTS key_thumbprints (
+  id INTEGER PRIMARY KEY,
+  thumbprint TEXT UNIQUE NOT NULL
+);
+
+ALTER TABLE history_comments
+  -- The hash used for comment identity.
+  -- It's the hash of (causal_hash <> author <> created_at_ms)
+  ADD COLUMN comment_hash_id INTEGER NULL REFERENCES hash(id);
+
+CREATE UNIQUE INDEX IF NOT EXISTS idx_history_comments_comment_hash_id
+  ON history_comments(comment_hash_id);
+
+ALTER TABLE history_comments
+  ADD COLUMN author_thumbprint_id INTEGER NULL REFERENCES key_thumbprints(id);
+
+ALTER TABLE history_comment_revisions
+  -- The hash used for this revision's identity.
+  -- It's the hash of (comment_hash <> subject <> contents <> hidden <> created_at_ms)
+  ADD COLUMN revision_hash_id INTEGER NULL REFERENCES hash(id);
+
+ALTER TABLE history_comment_revisions
+  ADD COLUMN author_signature BLOB NULL;
+
+CREATE UNIQUE INDEX IF NOT EXISTS idx_history_comment_revisions_revision_hash_id
+  ON history_comment_revisions(revision_hash_id);