From 986842e509f38e5291fbaa58cead6ef78a411748 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 15 Oct 2025 14:35:40 -0700 Subject: [PATCH 01/30] Add hashes to comment tables --- .../codebase-sqlite/sql/021-hash-history-comments.sql | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 codebase2/codebase-sqlite/sql/021-hash-history-comments.sql diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql new file mode 100644 index 0000000000..91f7e34e05 --- /dev/null +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -0,0 +1,9 @@ +ALTER TABLE history_comments + -- The hash used for comment identity. + -- It's the hash of (causal_hash <> author <> created_at) + ADD COLUMN comment_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(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) + ADD COLUMN revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id); From 1407fe4d5431608c68dee69eedd3ec9053a8b262 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 15 Oct 2025 14:45:34 -0700 Subject: [PATCH 02/30] Add Personal Key module --- unison-cli/package.yaml | 2 + unison-cli/src/Unison/Auth/PersonalKey.hs | 51 +++++++++++++++++++++++ unison-cli/unison-cli.cabal | 3 ++ 3 files changed, 56 insertions(+) create mode 100644 unison-cli/src/Unison/Auth/PersonalKey.hs diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 6257834e98..fc93fd7597 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -21,6 +21,7 @@ library: - ansi-terminal - attoparsec - base + - base64-bytestring - bytestring - cmark - co-log-core @@ -46,6 +47,7 @@ library: - http-client >= 0.7.6 - http-client-tls - http-types + - jose - ki - lens - lock-file diff --git a/unison-cli/src/Unison/Auth/PersonalKey.hs b/unison-cli/src/Unison/Auth/PersonalKey.hs new file mode 100644 index 0000000000..f7570d99d1 --- /dev/null +++ b/unison-cli/src/Unison/Auth/PersonalKey.hs @@ -0,0 +1,51 @@ +-- Module for working with "PersonalKeys" in Unison Auth. +-- +-- A Personal Key is just an Ed25519 EdDSA key pair. +-- We use the private key to make assertions on behalf of the user, +-- such as signing comments. +-- +-- Then we can register the public key with our share user account. +-- to link the key to the user. + +module Unison.Auth.PersonalKey + ( PersonalPrivateKey, + PersonalPublicKey, + generatePersonalKey, + ) +where + +import Crypto.JOSE.JWK (JWK, KeyMaterialGenParam (OKPGenParam), OKPCrv (Ed25519), genJWK) +import Crypto.JOSE.JWK qualified as JWK +import Crypto.JOSE.JWS qualified as JWS +import Data.Aeson (ToJSON) +import Data.ByteArray qualified as ByteArray +import Data.ByteString qualified as BS +import Data.ByteString.Base64.URL qualified as Base64URL +import Data.Text.Encoding qualified as Text +import Unison.Prelude + +-- | A JWK representing a personal key +newtype PersonalPrivateKey = PersonalPrivateKey {personalPrivateKeyJWK :: JWK} + +publicKey :: PersonalPrivateKey -> PersonalPublicKey +publicKey (PersonalPrivateKey jwk) = PersonalPublicKey (jwk ^. JWK.asPublicKey) + +newtype PersonalPublicKey = PersonalPublicKey {personalPublicKeyJWK :: JWK} + deriving newtype (ToJSON) + +-- Generate a single Ed25519 JWK +generatePersonalKey :: IO PersonalPrivateKey +generatePersonalKey = do + genJWK @IO (OKPGenParam Ed25519) + <&> JWK.jwkUse .~ Just JWK.Sig + <&> JWK.jwkAlg .~ Just (JWK.JWSAlg JWS.EdDSA) + <&> (\j -> j & JWK.jwkKid .~ Just (jwkThumbprint j)) + <&> PersonalPrivateKey + where + jwkThumbprint :: JWK.JWK -> Text + jwkThumbprint jwk = + jwk ^. JWK.thumbprint @JWK.SHA256 + & ByteArray.unpack + & BS.pack + & Base64URL.encodeUnpadded + & Text.decodeUtf8 diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 1de4ab84bb..8e1c4dbd2f 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -27,6 +27,7 @@ library Unison.Auth.CredentialManager Unison.Auth.Discovery Unison.Auth.HTTPClient + Unison.Auth.PersonalKey Unison.Auth.Tokens Unison.Auth.Types Unison.Auth.UserInfo @@ -223,6 +224,7 @@ library , ansi-terminal , attoparsec , base + , base64-bytestring , bytestring , cmark , co-log-core @@ -248,6 +250,7 @@ library , http-client >=0.7.6 , http-client-tls , http-types + , jose , ki , lens , lock-file From 28f3c942984578fd3c7c9fdeccdd255fc1bc2bc5 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 15 Oct 2025 15:48:00 -0700 Subject: [PATCH 03/30] getOrCreatePersonalKey --- .../src/Unison/Auth/CredentialManager.hs | 16 ++++++++++++ unison-cli/src/Unison/Auth/PersonalKey.hs | 26 ++++++++++++++----- unison-cli/src/Unison/Auth/Types.hs | 10 ++++--- 3 files changed, 43 insertions(+), 9 deletions(-) diff --git a/unison-cli/src/Unison/Auth/CredentialManager.hs b/unison-cli/src/Unison/Auth/CredentialManager.hs index 45d789c838..8a370b6f73 100644 --- a/unison-cli/src/Unison/Auth/CredentialManager.hs +++ b/unison-cli/src/Unison/Auth/CredentialManager.hs @@ -5,13 +5,16 @@ module Unison.Auth.CredentialManager CredentialManager, newCredentialManager, getCredentials, + getOrCreatePersonalKey, isExpired, ) where import Control.Monad.Trans.Except +import Data.Map qualified as Map import Data.Time.Clock (addUTCTime, diffUTCTime, getCurrentTime) import Unison.Auth.CredentialFile +import Unison.Auth.PersonalKey (PersonalPrivateKey, generatePersonalKey) import Unison.Auth.Types import Unison.Prelude import Unison.Share.Types (CodeserverId) @@ -24,6 +27,19 @@ import UnliftIO qualified -- be refreshed if we encounter any auth failures on requests. newtype CredentialManager = CredentialManager (UnliftIO.MVar Credentials) +-- | Fetches the user's personal key from the active profile, if it exists. +-- Otherwise it creates a new personal key, saves it to the active profile, and returns it. +getOrCreatePersonalKey :: (MonadUnliftIO m) => CredentialManager -> m PersonalPrivateKey +getOrCreatePersonalKey credMan@(CredentialManager credsVar) = do + Credentials {activeProfile, personalKeys} <- liftIO (UnliftIO.readMVar credsVar) + case Map.lookup activeProfile personalKeys of + Just pk -> pure pk + Nothing -> do + pk <- generatePersonalKey + _ <- modifyCredentials credMan $ \creds -> + creds {personalKeys = Map.insert activeProfile pk creds.personalKeys} + pure pk + -- | Saves credentials to the active profile. saveCredentials :: (UnliftIO.MonadUnliftIO m) => CredentialManager -> CodeserverId -> CodeserverCredentials -> m () saveCredentials credManager aud creds = do diff --git a/unison-cli/src/Unison/Auth/PersonalKey.hs b/unison-cli/src/Unison/Auth/PersonalKey.hs index f7570d99d1..ed199c5599 100644 --- a/unison-cli/src/Unison/Auth/PersonalKey.hs +++ b/unison-cli/src/Unison/Auth/PersonalKey.hs @@ -9,6 +9,7 @@ module Unison.Auth.PersonalKey ( PersonalPrivateKey, + encodePrivateKey, PersonalPublicKey, generatePersonalKey, ) @@ -18,6 +19,8 @@ import Crypto.JOSE.JWK (JWK, KeyMaterialGenParam (OKPGenParam), OKPCrv (Ed25519) import Crypto.JOSE.JWK qualified as JWK import Crypto.JOSE.JWS qualified as JWS import Data.Aeson (ToJSON) +import Data.Aeson qualified as Aeson +import Data.Aeson.Types (Value) import Data.ByteArray qualified as ByteArray import Data.ByteString qualified as BS import Data.ByteString.Base64.URL qualified as Base64URL @@ -25,17 +28,28 @@ import Data.Text.Encoding qualified as Text import Unison.Prelude -- | A JWK representing a personal key -newtype PersonalPrivateKey = PersonalPrivateKey {personalPrivateKeyJWK :: JWK} +newtype PersonalPrivateKey = PersonalPrivateKey {_personalPrivateKeyJWK :: JWK} + deriving stock (Eq) + deriving newtype (Aeson.FromJSON) -publicKey :: PersonalPrivateKey -> PersonalPublicKey -publicKey (PersonalPrivateKey jwk) = PersonalPublicKey (jwk ^. JWK.asPublicKey) +-- | Encode the private JWK. +-- +-- I left off a ToJSON instance because I want to be explicit about when +-- we're encoding the private key. +encodePrivateKey :: PersonalPrivateKey -> Value +encodePrivateKey (PersonalPrivateKey jwk) = Aeson.toJSON jwk + +_publicKey :: PersonalPrivateKey -> PersonalPublicKey +_publicKey (PersonalPrivateKey jwk) = case (jwk ^. JWK.asPublicKey) of + Just public -> PersonalPublicKey public + Nothing -> error "publicKey: Failed to extract public key from private key. This should never happen." -newtype PersonalPublicKey = PersonalPublicKey {personalPublicKeyJWK :: JWK} +newtype PersonalPublicKey = PersonalPublicKey {_personalPublicKeyJWK :: JWK} deriving newtype (ToJSON) -- Generate a single Ed25519 JWK -generatePersonalKey :: IO PersonalPrivateKey -generatePersonalKey = do +generatePersonalKey :: (MonadIO m) => m PersonalPrivateKey +generatePersonalKey = liftIO $ do genJWK @IO (OKPGenParam Ed25519) <&> JWK.jwkUse .~ Just JWK.Sig <&> JWK.jwkAlg .~ Just (JWK.JWSAlg JWS.EdDSA) diff --git a/unison-cli/src/Unison/Auth/Types.hs b/unison-cli/src/Unison/Auth/Types.hs index e557577ce4..6ecbd6ae24 100644 --- a/unison-cli/src/Unison/Auth/Types.hs +++ b/unison-cli/src/Unison/Auth/Types.hs @@ -31,6 +31,7 @@ import Data.Text qualified as Text import Data.Time (NominalDiffTime, UTCTime) import Network.URI import Network.URI qualified as URI +import Unison.Auth.PersonalKey (PersonalPrivateKey, encodePrivateKey) import Unison.Prelude import Unison.Share.Types @@ -133,20 +134,23 @@ type ProfileName = Text data Credentials = Credentials { credentials :: Map ProfileName (Map CodeserverId CodeserverCredentials), + personalKeys :: Map ProfileName PersonalPrivateKey, activeProfile :: ProfileName } deriving (Eq) instance Aeson.ToJSON Credentials where - toJSON (Credentials credMap activeProfile) = + toJSON (Credentials {credentials, personalKeys, activeProfile}) = Aeson.object - [ "credentials" .= credMap, + [ "credentials" .= credentials, + "personal_keys" .= (encodePrivateKey <$> personalKeys), "active_profile" .= activeProfile ] instance Aeson.FromJSON Credentials where parseJSON = Aeson.withObject "Credentials" $ \obj -> do credentials <- obj .: "credentials" + personalKeys <- obj .: "personal_keys" activeProfile <- obj .: "active_profile" pure Credentials {..} @@ -207,7 +211,7 @@ instance FromJSON CodeserverCredentials where pure $ CodeserverCredentials {..} emptyCredentials :: Credentials -emptyCredentials = Credentials mempty defaultProfileName +emptyCredentials = Credentials mempty mempty defaultProfileName codeserverCredentials :: URI -> Tokens -> UTCTime -> UserInfo -> CodeserverCredentials codeserverCredentials discoveryURI tokens fetchTime userInfo = CodeserverCredentials {discoveryURI, fetchTime, tokens, userInfo} From 6476649d6f760dd0d0d95175e148a0b1d1e9311f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 15 Oct 2025 16:19:02 -0700 Subject: [PATCH 04/30] Add table for key thumbprints --- .../codebase-sqlite/sql/021-hash-history-comments.sql | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql index 91f7e34e05..df08eabf37 100644 --- a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -1,7 +1,15 @@ +-- 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) - ADD COLUMN comment_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id); + ADD COLUMN comment_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id), + ADD COLUMN author_thumbprint_id INTEGER NOT NULL REFERENCES key_thumbprints(id); ALTER TABLE history_comment_revisions -- The hash used for this revision's identity. From fc2447f8c356ea194fe1bd4b4c03dc41cba9aabe Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 15 Oct 2025 16:33:09 -0700 Subject: [PATCH 05/30] Blake comment hash WIP --- .../Editor/HandleInput/HistoryComment.hs | 39 +++++++++++++++++++ 1 file changed, 39 insertions(+) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 20b616d772..ce16a1a206 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -1,7 +1,15 @@ module Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment) where +import BLAKE3 qualified +import Data.ByteArray.Sized (SizedByteArray) +import Data.ByteArray.Sized qualified as SBA +import Data.ByteString.Builder qualified as Builder +import Data.ByteString.Lazy.Char8 qualified as BL import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text import Data.Text.IO qualified as Text +import Data.Time (UTCTime) +import Data.Time.Clock.POSIX qualified as Time import Text.RawString.QQ (r) import U.Codebase.Config qualified as Config import U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) @@ -16,12 +24,43 @@ import Unison.Codebase.Editor.Output (Output (..)) import Unison.Codebase.Path qualified as Path import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.Core.Project (ProjectAndBranch (..)) +import Unison.Hash (Hash) +import Unison.Hash qualified as Hash +import Unison.Hashing.V2 (ContentAddressable (..)) +import Unison.HistoryComment (HistoryComment (..)) +import Unison.KeyThumbprint (KeyThumbprint (unThumbprint)) import Unison.Prelude import UnliftIO qualified import UnliftIO.Directory (findExecutable) import UnliftIO.Environment qualified as Env import UnliftIO.Process qualified as Proc +instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash CommentHash) where + contentHash HistoryComment {author, subject, content, causal, authorThumbprint, createdAt, commentId} = + let commentHash :: SizedByteArray BLAKE3.DEFAULT_DIGEST_LEN ByteString + commentHash = + BLAKE3.hash + Nothing + [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, + Hash.toByteString (into @Hash causal), + Text.encodeUtf8 $ unThumbprint authorThumbprint, + Hash.toByteString (into @Hash commentId), + Text.encodeUtf8 author, + Text.encodeUtf8 subject, + Text.encodeUtf8 content, + -- Encode UTCTime as a UTC 8601 seconds since epoch + createdAt + & Time.utcTimeToPOSIXSeconds + & floor + & Builder.int64BE + & Builder.toLazyByteString + & BL.toStrict + ] + in Hash.fromByteString . SBA.unSizedByteArray $ commentHash + where + commentHashingVersion :: Int32 + commentHashingVersion = 1 + handleHistoryComment :: Maybe BranchId2 -> Cli () handleHistoryComment mayThingToAnnotate = do authorName <- From 2f654920d79490fe00b38ebe28769fd8037eb830 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 15 Oct 2025 16:33:09 -0700 Subject: [PATCH 06/30] Propagate HistoryComment type --- .../codebase-sqlite/U/Codebase/Sqlite/DbId.hs | 4 + .../U/Codebase/Sqlite/HistoryComment.hs | 12 --- .../U/Codebase/Sqlite/Queries.hs | 84 ++++++++++++++----- .../unison-codebase-sqlite.cabal | 2 +- codebase2/core/U/Codebase/HashTags.hs | 32 +++++++ stack.yaml | 6 ++ stack.yaml.lock | 9 +- unison-cli/package.yaml | 2 + unison-cli/src/Unison/Auth/PersonalKey.hs | 24 +++--- .../Codebase/Editor/HandleInput/History.hs | 10 ++- .../Editor/HandleInput/HistoryComment.hs | 66 +++++++++++---- .../src/Unison/Codebase/Editor/Output.hs | 6 +- .../src/Unison/CommandLine/OutputMessages.hs | 6 +- unison-cli/unison-cli.cabal | 2 + unison-core/package.yaml | 1 + unison-core/src/Unison/HistoryComment.hs | 31 +++++++ unison-core/src/Unison/KeyThumbprint.hs | 6 ++ unison-core/unison-core1.cabal | 5 +- 18 files changed, 236 insertions(+), 72 deletions(-) delete mode 100644 codebase2/codebase-sqlite/U/Codebase/Sqlite/HistoryComment.hs create mode 100644 unison-core/src/Unison/HistoryComment.hs create mode 100644 unison-core/src/Unison/KeyThumbprint.hs diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs index 1cb0d95f5f..e2db33f6e0 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs @@ -70,3 +70,7 @@ instance Show CausalHashId where newtype HistoryCommentId = HistoryCommentId 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 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HistoryComment.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/HistoryComment.hs deleted file mode 100644 index 124b7142e6..0000000000 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/HistoryComment.hs +++ /dev/null @@ -1,12 +0,0 @@ -module U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) where - -import Data.Text (Text) - -data HistoryComment causal id = HistoryComment - { author :: Text, - subject :: Text, - content :: Text, - causal :: causal, - commentId :: id - } - deriving (Show, Eq, Functor) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index f9054dcd1a..36471c93ff 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -296,6 +296,9 @@ module U.Codebase.Sqlite.Queries getConfigValue, setConfigValue, + -- * Personal Keys + expectPersonalKeyThumbprintId, + -- * Types TextPathSegments, JsonParseFailure (..), @@ -335,7 +338,7 @@ 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 (..), CommentHash (..), PatchHash (..)) import U.Codebase.Reference (Reference' (..)) import U.Codebase.Reference qualified as C (Reference) import U.Codebase.Reference qualified as C.Reference @@ -351,6 +354,7 @@ import U.Codebase.Sqlite.DbId HashId (..), HashVersion, HistoryCommentId, + KeyThumbprintId, ObjectId (..), PatchObjectId (..), ProjectBranchId (..), @@ -366,7 +370,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 +410,8 @@ 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)) @@ -4125,40 +4130,59 @@ saveSquashResult bhId chId = getLatestCausalComment :: CausalHashId -> - Transaction (Maybe (HistoryComment CausalHashId HistoryCommentId)) + Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash CommentHash)) getLatestCausalComment causalHashId = - queryMaybeRow @(HistoryCommentId, CausalHashId, Text, Text, Text) + queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, Text, Text, Time.UTCTime) [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, ccr.subject, ccr.contents, ccr.created_at 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 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, subject, content, createdAt) -> + HistoryCommentRevision + { subject, + content, + createdAt, + comment = + HistoryComment + { author, + authorThumbprint, + causal = CausalHash . Hash32.toHash $ causalHash, + createdAt, + commentId = CommentHash . Hash32.toHash $ commentHash + } + } + +commentOnCausal :: LatestHistoryComment KeyThumbprintId CausalHashId () -> Transaction () +commentOnCausal + HistoryCommentRevision + { content, + subject, + comment = HistoryComment {author, causal = causalHashId} + } = do + mayExistingCommentId <- + queryMaybeCol @HistoryCommentId + [sql| SELECT id FROM history_comments WHERE causal_hash_id = :causalHashId |] - commentId <- case mayExistingCommentId of - Nothing -> - queryOneCol @HistoryCommentId - [sql| + 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')) RETURNING id |] - Just cid -> pure cid - execute - [sql| + 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')) |] @@ -4192,3 +4216,23 @@ getConfigValue key = FROM config WHERE key = :key |] + +-- | Save or return the id for a given key thumbprint +expectPersonalKeyThumbprintId :: KeyThumbprint -> Transaction KeyThumbprintId +expectPersonalKeyThumbprintId 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 + |] diff --git a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal index f6dc340e7c..a9e5658967 100644 --- a/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal +++ b/codebase2/codebase-sqlite/unison-codebase-sqlite.cabal @@ -30,6 +30,7 @@ extra-source-files: sql/018-add-derived-dependents-by-dependency-index.sql sql/019-add-upgrade-branch-table.sql sql/020-add-history-comments.sql + sql/021-hash-history-comments.sql sql/create.sql source-repository head @@ -50,7 +51,6 @@ library U.Codebase.Sqlite.Decode U.Codebase.Sqlite.Entity U.Codebase.Sqlite.HashHandle - U.Codebase.Sqlite.HistoryComment U.Codebase.Sqlite.LocalIds U.Codebase.Sqlite.LocalizeObject U.Codebase.Sqlite.ObjectType diff --git a/codebase2/core/U/Codebase/HashTags.hs b/codebase2/core/U/Codebase/HashTags.hs index 5470f3009f..9b0e1dee65 100644 --- a/codebase2/core/U/Codebase/HashTags.hs +++ b/codebase2/core/U/Codebase/HashTags.hs @@ -18,6 +18,12 @@ newtype CausalHash = CausalHash {unCausalHash :: Hash} newtype PatchHash = PatchHash {unPatchHash :: Hash} deriving stock (Eq, Ord) +newtype CommentHash = CommentHash {unCommentHash :: Hash} + deriving stock (Eq, Ord) + +newtype CommentRevisionHash = CommentRevisionHash {unCommentRevisionHash :: Hash} + deriving stock (Eq, Ord) + instance Show ComponentHash where show h = "ComponentHash (" ++ show (unComponentHash h) ++ ")" @@ -30,6 +36,12 @@ instance Show CausalHash where instance Show PatchHash where show h = "PatchHash (" ++ show (unPatchHash h) ++ ")" +instance Show CommentHash where + show h = "CommentHash (" ++ show (unCommentHash h) ++ ")" + +instance Show CommentRevisionHash where + show h = "CommentRevisionHash (" ++ show (unCommentRevisionHash h) ++ ")" + instance From ComponentHash Text where from = from @Hash @Text . unComponentHash @@ -42,6 +54,12 @@ instance From CausalHash Text where instance From PatchHash Text where from = from @Hash @Text . unPatchHash +instance From CommentHash Text where + from = from @Hash @Text . unCommentHash + +instance From CommentRevisionHash Text where + from = from @Hash @Text . unCommentRevisionHash + instance From ComponentHash Hash instance From BranchHash Hash @@ -50,6 +68,10 @@ instance From CausalHash Hash instance From PatchHash Hash +instance From CommentHash Hash + +instance From CommentRevisionHash Hash + instance From Hash ComponentHash instance From Hash BranchHash @@ -58,6 +80,10 @@ instance From Hash CausalHash instance From Hash PatchHash +instance From Hash CommentHash + +instance From Hash CommentRevisionHash + instance From ComponentHash Hash32 where from = from @Hash @Hash32 . unComponentHash @@ -81,3 +107,9 @@ instance From Hash32 CausalHash where instance From Hash32 PatchHash where from = PatchHash . from @Hash32 @Hash + +instance From CommentHash Hash32 where + from = from @Hash @Hash32 . unCommentHash + +instance From CommentRevisionHash Hash32 where + from = from @Hash @Hash32 . unCommentRevisionHash diff --git a/stack.yaml b/stack.yaml index c36a96dbfb..d6da607377 100644 --- a/stack.yaml +++ b/stack.yaml @@ -65,6 +65,7 @@ extra-deps: - recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 + - blake3-0.3@sha256:5517c394b60f88918df78eb8356799fd3b1a09e16b82af36be6edb85d6c3e108,2838 # TODO: The revision pinned here doesn’t exist in the Nix snapshot of Hackage we use. Uncomment this once we update # the Nix inputs (likely via #5796). @@ -74,6 +75,11 @@ extra-deps: flags: haskeline: terminfo: false + blake3: + avx512: false + avx2: false + sse41: false + sse2: false allow-newer: true allow-newer-deps: diff --git a/stack.yaml.lock b/stack.yaml.lock index 7f0b8a62a8..d80b72e627 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -1,7 +1,7 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files packages: - completed: @@ -68,6 +68,13 @@ packages: size: 284 original: hackage: network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 +- completed: + hackage: blake3-0.3@sha256:5517c394b60f88918df78eb8356799fd3b1a09e16b82af36be6edb85d6c3e108,2838 + pantry-tree: + sha256: d5200c6f006a3a790a25d63b9823ce125c8a64c15300259ce467643f364683a2 + size: 1649 + original: + hackage: blake3-0.3@sha256:5517c394b60f88918df78eb8356799fd3b1a09e16b82af36be6edb85d6c3e108,2838 snapshots: - completed: sha256: 8e7996960d864443a66eb4105338bbdd6830377b9f6f99cd5527ef73c10c01e7 diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index fc93fd7597..9518d539fe 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -22,6 +22,7 @@ library: - attoparsec - base - base64-bytestring + - blake3 - bytestring - cmark - co-log-core @@ -88,6 +89,7 @@ library: - unison-core - unison-core1 - unison-hash + - unison-hashing-v2 - unison-merge - unison-parser-typechecker - unison-prelude diff --git a/unison-cli/src/Unison/Auth/PersonalKey.hs b/unison-cli/src/Unison/Auth/PersonalKey.hs index ed199c5599..09442d3609 100644 --- a/unison-cli/src/Unison/Auth/PersonalKey.hs +++ b/unison-cli/src/Unison/Auth/PersonalKey.hs @@ -12,6 +12,7 @@ module Unison.Auth.PersonalKey encodePrivateKey, PersonalPublicKey, generatePersonalKey, + personalKeyThumbprint, ) where @@ -22,9 +23,9 @@ import Data.Aeson (ToJSON) import Data.Aeson qualified as Aeson import Data.Aeson.Types (Value) import Data.ByteArray qualified as ByteArray -import Data.ByteString qualified as BS import Data.ByteString.Base64.URL qualified as Base64URL import Data.Text.Encoding qualified as Text +import Unison.KeyThumbprint (KeyThumbprint (..)) import Unison.Prelude -- | A JWK representing a personal key @@ -32,6 +33,17 @@ newtype PersonalPrivateKey = PersonalPrivateKey {_personalPrivateKeyJWK :: JWK} deriving stock (Eq) deriving newtype (Aeson.FromJSON) +personalKeyThumbprint :: PersonalPrivateKey -> KeyThumbprint +personalKeyThumbprint (PersonalPrivateKey jwk) = jwkThumbprint jwk + +jwkThumbprint :: JWK.JWK -> KeyThumbprint +jwkThumbprint jwk = + jwk ^. JWK.thumbprint @JWK.SHA256 + & ByteArray.convert + & Base64URL.encodeUnpadded + & Text.decodeUtf8 + & KeyThumbprint + -- | Encode the private JWK. -- -- I left off a ToJSON instance because I want to be explicit about when @@ -53,13 +65,5 @@ generatePersonalKey = liftIO $ do genJWK @IO (OKPGenParam Ed25519) <&> JWK.jwkUse .~ Just JWK.Sig <&> JWK.jwkAlg .~ Just (JWK.JWSAlg JWS.EdDSA) - <&> (\j -> j & JWK.jwkKid .~ Just (jwkThumbprint j)) + <&> (\j -> j & JWK.jwkKid .~ Just (thumbprintToText $ jwkThumbprint j)) <&> PersonalPrivateKey - where - jwkThumbprint :: JWK.JWK -> Text - jwkThumbprint jwk = - jwk ^. JWK.thumbprint @JWK.SHA256 - & ByteArray.unpack - & BS.pack - & Base64URL.encodeUnpadded - & Text.decodeUtf8 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs index 4a32e4eee8..5dd572e878 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs @@ -2,7 +2,6 @@ module Unison.Codebase.Editor.HandleInput.History (handleHistory) where import Data.Map qualified as Map import U.Codebase.HashTags -import U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -14,6 +13,7 @@ import Unison.Codebase.Causal qualified as Causal import Unison.Codebase.Editor.Input import Unison.Codebase.Editor.Output import Unison.Codebase.Path (Path') +import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..), LatestHistoryComment) import Unison.NamesWithHistory qualified as Names import Unison.Prelude @@ -30,7 +30,7 @@ handleHistory resultsCap diffCap from = do history <- doHistory schLength 0 branch [] Cli.respondNumbered history where - doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (HistoryComment () ()), Names.Diff)] -> Cli.Cli NumberedOutput + doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (LatestHistoryComment () () ()), Names.Diff)] -> Cli.Cli NumberedOutput doHistory schLength !n b acc = if maybe False (n >=) resultsCap then do @@ -49,8 +49,10 @@ handleHistory resultsCap diffCap from = do mayComment <- getComment causalHash let elem = (causalHash, mayComment, Branch.namesDiff b' b) doHistory schLength (n + 1) b' (elem : acc) - getComment :: CausalHash -> Cli.Cli (Maybe (HistoryComment () ())) + getComment :: CausalHash -> Cli.Cli (Maybe (LatestHistoryComment () () ())) getComment ch = Cli.runTransaction $ do causalHashId <- Q.expectCausalHashIdByCausalHash ch Q.getLatestCausalComment causalHashId - <&> fmap \hc -> hc {causal = (), commentId = ()} + <&> fmap \hcr -> + let comment = hcr.comment {authorThumbprint = (), causal = (), commentId = ()} + in hcr {comment = comment} diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index ce16a1a206..5e272a8b48 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -1,6 +1,10 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + module Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment) where import BLAKE3 qualified +import Control.Monad.Reader +import Data.ByteArray qualified as ByteArray import Data.ByteArray.Sized (SizedByteArray) import Data.ByteArray.Sized qualified as SBA import Data.ByteString.Builder qualified as Builder @@ -12,8 +16,10 @@ import Data.Time (UTCTime) import Data.Time.Clock.POSIX qualified as Time import Text.RawString.QQ (r) import U.Codebase.Config qualified as Config -import U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) +import U.Codebase.HashTags (CausalHash, CommentHash) import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Auth.CredentialManager qualified as CredMan +import Unison.Auth.PersonalKey qualified as PK import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli @@ -27,25 +33,47 @@ import Unison.Core.Project (ProjectAndBranch (..)) import Unison.Hash (Hash) import Unison.Hash qualified as Hash import Unison.Hashing.V2 (ContentAddressable (..)) -import Unison.HistoryComment (HistoryComment (..)) -import Unison.KeyThumbprint (KeyThumbprint (unThumbprint)) +import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..)) +import Unison.KeyThumbprint (KeyThumbprint (..)) import Unison.Prelude import UnliftIO qualified import UnliftIO.Directory (findExecutable) import UnliftIO.Environment qualified as Env import UnliftIO.Process qualified as Proc -instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash CommentHash) where - contentHash HistoryComment {author, subject, content, causal, authorThumbprint, createdAt, commentId} = +commentHashingVersion :: Int32 +commentHashingVersion = 1 + +-- Hash a base comment +instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash ()) where + contentHash HistoryComment {createdAt, author, causal, authorThumbprint} = let commentHash :: SizedByteArray BLAKE3.DEFAULT_DIGEST_LEN ByteString commentHash = BLAKE3.hash Nothing [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, Hash.toByteString (into @Hash causal), - Text.encodeUtf8 $ unThumbprint authorThumbprint, - Hash.toByteString (into @Hash commentId), + Text.encodeUtf8 $ thumbprintToText authorThumbprint, Text.encodeUtf8 author, + -- Encode UTCTime as a UTC 8601 seconds since epoch + createdAt + & Time.utcTimeToPOSIXSeconds + & floor + & Builder.int64BE + & Builder.toLazyByteString + & BL.toStrict + ] + in Hash.fromByteString . SBA.unSizedByteArray $ commentHash + +-- Hash a comment revision +instance ContentAddressable (HistoryCommentRevision UTCTime CommentHash) where + contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash} = + let hashDigest :: SizedByteArray BLAKE3.DEFAULT_DIGEST_LEN ByteString + hashDigest = + BLAKE3.hash + Nothing + [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, + Hash.toByteString (into @Hash commentHash), Text.encodeUtf8 subject, Text.encodeUtf8 content, -- Encode UTCTime as a UTC 8601 seconds since epoch @@ -56,17 +84,20 @@ instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash Com & Builder.toLazyByteString & BL.toStrict ] - in Hash.fromByteString . SBA.unSizedByteArray $ commentHash - where - commentHashingVersion :: Int32 - commentHashingVersion = 1 + in Hash.fromByteString . ByteArray.convert $ hashDigest handleHistoryComment :: Maybe BranchId2 -> Cli () handleHistoryComment mayThingToAnnotate = do - authorName <- - Cli.runTransaction Q.getAuthorName >>= \case - Nothing -> Cli.returnEarly $ AuthorNameRequired - Just authorName -> pure authorName + Cli.Env {credentialManager} <- ask + authorThumbprint <- PK.personalKeyThumbprint <$> liftIO (CredMan.getOrCreatePersonalKey credentialManager) + (mayAuthorName, authorThumbprintId) <- + Cli.runTransaction do + authorName <- Q.getAuthorName + authorThumbprintId <- Q.expectPersonalKeyThumbprintId authorThumbprint + pure (authorName, authorThumbprintId) + authorName <- case mayAuthorName of + Nothing -> Cli.returnEarly $ AuthorNameRequired + Just authorName -> pure authorName causalHash <- case mayThingToAnnotate of Nothing -> do Branch.headHash <$> Cli.getCurrentProjectRoot @@ -89,13 +120,14 @@ handleHistoryComment mayThingToAnnotate = do mayExistingCommentInfo <- Q.getLatestCausalComment causalHashId pure (causalHashId, mayExistingCommentInfo) let populatedMsg = fromMaybe commentInstructions $ do - HistoryComment {subject, content} <- mayHistoryComment + HistoryCommentRevision {subject, content} <- mayHistoryComment pure $ Text.unlines [subject, "", content, commentInstructions] mayNewMessage <- liftIO (editMessage (Just populatedMsg)) case mayNewMessage of Nothing -> Cli.respond $ CommentAborted Just (subject, content) -> do - let historyComment = HistoryComment {author = Config.unAuthorName authorName, subject, content, commentId = (), causal = causalHashId} + createdAt <- liftIO $ Time.getCurrentTime + let historyComment = HistoryCommentRevision {subject, content, createdAt, comment = HistoryComment {author = Config.unAuthorName authorName, commentId = (), causal = causalHashId, createdAt, authorThumbprint = authorThumbprintId}} Cli.runTransaction $ Q.commentOnCausal historyComment Cli.respond $ CommentedSuccessfully where diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index c6dcb18d79..ce1b8e4e20 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -30,7 +30,6 @@ import System.Exit (ExitCode) import U.Codebase.Branch.Diff (NameChanges) import U.Codebase.Config (ConfigKey) import U.Codebase.HashTags (CausalHash) -import U.Codebase.Sqlite.HistoryComment (HistoryComment) import U.Codebase.Sqlite.Project qualified as Sqlite import U.Codebase.Sqlite.ProjectBranch qualified as Sqlite import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog @@ -62,6 +61,7 @@ import Unison.DeclCoherencyCheck (IncoherentDeclReason, IncoherentDeclReasons (. import Unison.Hash (Hash) import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' +import Unison.HistoryComment (LatestHistoryComment) import Unison.LabeledDependency (LabeledDependency) import Unison.Merge qualified as Merge import Unison.Name (Name) @@ -136,8 +136,8 @@ data NumberedOutput History (Maybe Int) -- Amount of history to print HashLength - [(CausalHash, Maybe (HistoryComment () ()), Names.Diff)] - (Maybe (HistoryComment () ()), HistoryTail) -- 'origin point' of this view of history. + [(CausalHash, Maybe (LatestHistoryComment () () ()), Names.Diff)] + (Maybe (LatestHistoryComment () () ()), HistoryTail) -- 'origin point' of this view of history. | ListProjects [Sqlite.Project] | ListBranches ProjectName [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])] | AmbiguousSwitch ProjectName (ProjectAndBranch ProjectName ProjectBranchName) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 828d8da8b1..7828096e53 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -41,7 +41,7 @@ import U.Codebase.Branch.Diff (NameChanges (..)) import U.Codebase.Config qualified as Config import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reference qualified as Reference -import U.Codebase.Sqlite.HistoryComment (HistoryComment (..)) +import Unison.HistoryComment (HistoryComment (..), LatestHistoryComment, HistoryCommentRevision (..)) import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog @@ -307,10 +307,10 @@ notifyNumbered = \case reversedHistory = reverse history showNum :: Int -> Pretty showNum n = P.shown n <> ". " - displayComment :: Bool -> Maybe (HistoryComment () ()) -> [Pretty] + displayComment :: Bool -> Maybe (LatestHistoryComment () () () ) -> [Pretty] displayComment prefixSpacer mayComment = case mayComment of Nothing -> [] - Just (HistoryComment {author, subject, content}) -> + Just (HistoryCommentRevision {comment=HistoryComment{author}, subject, content}) -> Monoid.whenM prefixSpacer [""] <> [(P.text "⊙ " <> P.bold (P.text author))] <> [ P.indent (P.blue " ┃ ") (P.text subject) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 8e1c4dbd2f..86a16093ca 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -225,6 +225,7 @@ library , attoparsec , base , base64-bytestring + , blake3 , bytestring , cmark , co-log-core @@ -291,6 +292,7 @@ library , unison-core , unison-core1 , unison-hash + , unison-hashing-v2 , unison-merge , unison-parser-typechecker , unison-prelude diff --git a/unison-core/package.yaml b/unison-core/package.yaml index f63b7fa893..3d2bb694e0 100644 --- a/unison-core/package.yaml +++ b/unison-core/package.yaml @@ -28,6 +28,7 @@ library: - semigroups - text - text-builder + - time - these - transformers - unison-core diff --git a/unison-core/src/Unison/HistoryComment.hs b/unison-core/src/Unison/HistoryComment.hs new file mode 100644 index 0000000000..7da7ba6f8e --- /dev/null +++ b/unison-core/src/Unison/HistoryComment.hs @@ -0,0 +1,31 @@ +module Unison.HistoryComment + ( LatestHistoryComment, + HistoryComment (..), + HistoryCommentRevision (..), + ) +where + +import Data.Text (Text) +import Data.Time.Clock (UTCTime) + +type LatestHistoryComment thumbprint causal commentId = + HistoryCommentRevision UTCTime (HistoryComment UTCTime thumbprint causal commentId) + +data HistoryComment createdAt thumbprint causal commentId = HistoryComment + { author :: Text, + -- The time the comment was created. + createdAt :: createdAt, + authorThumbprint :: thumbprint, + causal :: causal, + commentId :: commentId + } + deriving (Show, Eq, Functor) + +data HistoryCommentRevision createdAt comment = HistoryCommentRevision + { subject :: Text, + content :: Text, + createdAt :: createdAt, + -- The comment this is a revision for. + comment :: comment + } + deriving (Show, Eq, Functor) diff --git a/unison-core/src/Unison/KeyThumbprint.hs b/unison-core/src/Unison/KeyThumbprint.hs new file mode 100644 index 0000000000..706a646961 --- /dev/null +++ b/unison-core/src/Unison/KeyThumbprint.hs @@ -0,0 +1,6 @@ +module Unison.KeyThumbprint (KeyThumbprint (..)) where + +import Data.Text (Text) + +newtype KeyThumbprint = KeyThumbprint {thumbprintToText :: Text} + deriving (Show, Eq, Ord) diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index 948360b616..f8e2a6715d 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack @@ -33,6 +33,8 @@ library Unison.Hashable Unison.HashQualified Unison.HashQualifiedPrime + Unison.HistoryComment + Unison.KeyThumbprint Unison.Kind Unison.LabeledDependency Unison.Name @@ -117,6 +119,7 @@ library , text , text-builder , these + , time , transformers , unison-core , unison-hash From 80a9142a17640635da64966bb53ab9330f82ee57 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Thu, 30 Oct 2025 17:34:51 -0700 Subject: [PATCH 07/30] Add revision ID --- .../codebase-sqlite/U/Codebase/Sqlite/DbId.hs | 14 ++++++++++++++ .../U/Codebase/Sqlite/Queries.hs | 19 ++++++++++++++----- unison-core/src/Unison/HistoryComment.hs | 9 +++++---- 3 files changed, 33 insertions(+), 9 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs index e2db33f6e0..ca26b5ed12 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs +++ b/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,12 @@ 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 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 36471c93ff..acf5ec6115 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -338,7 +338,7 @@ 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 (..), CommentHash (..), PatchHash (..)) +import U.Codebase.HashTags (BranchHash (..), CausalHash (..), CommentHash (..), CommentRevisionHash, PatchHash (..)) import U.Codebase.Reference (Reference' (..)) import U.Codebase.Reference qualified as C (Reference) import U.Codebase.Reference qualified as C.Reference @@ -351,6 +351,8 @@ import U.Codebase.Sqlite.DbId ( BranchHashId (..), BranchObjectId (..), CausalHashId (..), + CommentHashId, + CommentRevisionHashId, HashId (..), HashVersion, HistoryCommentId, @@ -411,7 +413,7 @@ 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.KeyThumbprint (KeyThumbprint (..)) import Unison.Name (Name) import Unison.Name qualified as Name import Unison.NameSegment.Internal (NameSegment (NameSegment)) @@ -634,6 +636,12 @@ expectCausalByCausalHash ch = do bhId <- expectCausalValueHashId hId pure (hId, bhId) +saveCommentHash :: CommentHash -> Transaction CommentHashId +saveCommentHash = fmap CommentHash . saveHashHash . unCommentHash + +saveCommentRevisionHash :: CommentRevisionHash -> Transaction CommentRevisionHashId +saveCommentRevisionHash = fmap CommentRevisionHash . saveHashHash . unCommentRevisionHash + expectHashIdByHash :: Hash -> Transaction HashId expectHashIdByHash = expectHashId . Hash32.fromHash @@ -4158,7 +4166,7 @@ getLatestCausalComment causalHashId = } } -commentOnCausal :: LatestHistoryComment KeyThumbprintId CausalHashId () -> Transaction () +commentOnCausal :: LatestHistoryComment KeyThumbprintId CausalHashId CommentRevisionHash CommentHash -> Transaction CommentHash commentOnCausal HistoryCommentRevision { content, @@ -4221,8 +4229,9 @@ getConfigValue key = expectPersonalKeyThumbprintId :: KeyThumbprint -> Transaction KeyThumbprintId expectPersonalKeyThumbprintId thumbprint = do let thumbprintText = thumbprintToText thumbprint - mayExisting <- queryMaybeCol - [sql| + mayExisting <- + queryMaybeCol + [sql| SELECT id FROM key_thumbprints WHERE thumbprint = :thumbprintText diff --git a/unison-core/src/Unison/HistoryComment.hs b/unison-core/src/Unison/HistoryComment.hs index 7da7ba6f8e..6adaf58392 100644 --- a/unison-core/src/Unison/HistoryComment.hs +++ b/unison-core/src/Unison/HistoryComment.hs @@ -8,8 +8,8 @@ where import Data.Text (Text) import Data.Time.Clock (UTCTime) -type LatestHistoryComment thumbprint causal commentId = - HistoryCommentRevision UTCTime (HistoryComment UTCTime thumbprint causal commentId) +type LatestHistoryComment thumbprint causal revisionId commentId = + HistoryCommentRevision revisionId UTCTime (HistoryComment UTCTime thumbprint causal commentId) data HistoryComment createdAt thumbprint causal commentId = HistoryComment { author :: Text, @@ -21,11 +21,12 @@ data HistoryComment createdAt thumbprint causal commentId = HistoryComment } deriving (Show, Eq, Functor) -data HistoryCommentRevision createdAt comment = HistoryCommentRevision +data HistoryCommentRevision revisionId createdAt comment = HistoryCommentRevision { subject :: Text, content :: Text, createdAt :: createdAt, -- The comment this is a revision for. - comment :: comment + comment :: comment, + revisionId :: revisionId } deriving (Show, Eq, Functor) From a66d16c6f01a1d22df27d6f3af1d87a911edaa3f Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Oct 2025 15:29:34 -0700 Subject: [PATCH 08/30] Implement comment hashing, switching away from Blake3 to sha512 --- .../codebase-sqlite/U/Codebase/Sqlite/DbId.hs | 4 + .../U/Codebase/Sqlite/Queries.hs | 48 +++++--- unison-cli/package.yaml | 1 - .../Codebase/Editor/HandleInput/History.hs | 6 +- .../Editor/HandleInput/HistoryComment.hs | 108 ++++++++++-------- .../src/Unison/Codebase/Editor/Output.hs | 4 +- .../src/Unison/CommandLine/OutputMessages.hs | 2 +- unison-cli/unison-cli.cabal | 1 - 8 files changed, 105 insertions(+), 69 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs index ca26b5ed12..a1cb6d9d55 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/DbId.hs @@ -85,6 +85,10 @@ 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 diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index acf5ec6115..3d9d7077db 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -338,7 +338,13 @@ 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 (..), CommentHash (..), CommentRevisionHash, PatchHash (..)) +import U.Codebase.HashTags + ( BranchHash (..), + CausalHash (..), + CommentHash (..), + CommentRevisionHash (..), + PatchHash (..), + ) import U.Codebase.Reference (Reference' (..)) import U.Codebase.Reference qualified as C (Reference) import U.Codebase.Reference qualified as C.Reference @@ -351,11 +357,12 @@ import U.Codebase.Sqlite.DbId ( BranchHashId (..), BranchObjectId (..), CausalHashId (..), - CommentHashId, - CommentRevisionHashId, + CommentHashId (..), + CommentRevisionHashId (..), HashId (..), HashVersion, HistoryCommentId, + HistoryCommentRevisionId, KeyThumbprintId, ObjectId (..), PatchObjectId (..), @@ -412,7 +419,11 @@ 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.HistoryComment + ( HistoryComment (..), + HistoryCommentRevision (..), + LatestHistoryComment, + ) import Unison.KeyThumbprint (KeyThumbprint (..)) import Unison.Name (Name) import Unison.Name qualified as Name @@ -637,10 +648,10 @@ expectCausalByCausalHash ch = do pure (hId, bhId) saveCommentHash :: CommentHash -> Transaction CommentHashId -saveCommentHash = fmap CommentHash . saveHashHash . unCommentHash +saveCommentHash = fmap CommentHashId . saveHashHash . unCommentHash saveCommentRevisionHash :: CommentRevisionHash -> Transaction CommentRevisionHashId -saveCommentRevisionHash = fmap CommentRevisionHash . saveHashHash . unCommentRevisionHash +saveCommentRevisionHash = fmap CommentRevisionHashId . saveHashHash . unCommentRevisionHash expectHashIdByHash :: Hash -> Transaction HashId expectHashIdByHash = expectHashId . Hash32.fromHash @@ -4138,11 +4149,11 @@ saveSquashResult bhId chId = getLatestCausalComment :: CausalHashId -> - Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash CommentHash)) + Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash HistoryCommentRevisionId CommentHash)) getLatestCausalComment causalHashId = - queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, Text, Text, Time.UTCTime) + queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, HistoryCommentRevisionId, Text, Text, Time.UTCTime) [sql| - SELECT comment_hash.base32, causal_hash.base32, cc.author, cc.author_thumbprint_id, ccr.subject, ccr.contents, ccr.created_at + SELECT comment_hash.base32, causal_hash.base32, cc.author, cc.author_thumbprint_id, ccr.id, ccr.subject, ccr.contents, ccr.created_at 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 @@ -4151,11 +4162,12 @@ getLatestCausalComment causalHashId = ORDER BY ccr.created_at DESC LIMIT 1 |] - <&> fmap \(commentHash, causalHash, author, authorThumbprint, subject, content, createdAt) -> + <&> fmap \(commentHash, causalHash, author, authorThumbprint, revisionId, subject, content, createdAt) -> HistoryCommentRevision { subject, content, createdAt, + revisionId, comment = HistoryComment { author, @@ -4166,13 +4178,17 @@ getLatestCausalComment causalHashId = } } -commentOnCausal :: LatestHistoryComment KeyThumbprintId CausalHashId CommentRevisionHash CommentHash -> Transaction CommentHash +commentOnCausal :: LatestHistoryComment KeyThumbprint CausalHashId CommentRevisionHash CommentHash -> Transaction () commentOnCausal HistoryCommentRevision { content, subject, - comment = HistoryComment {author, causal = causalHashId} + revisionId = commentRevisionHash, + comment = HistoryComment {author, authorThumbprint, causal = causalHashId, commentId = commentHash} } = do + commentHashId <- saveCommentHash commentHash + commentRevisionHashId <- saveCommentRevisionHash commentRevisionHash + thumbprintId <- expectPersonalKeyThumbprintId authorThumbprint mayExistingCommentId <- queryMaybeCol @HistoryCommentId [sql| @@ -4184,15 +4200,15 @@ commentOnCausal Nothing -> queryOneCol @HistoryCommentId [sql| - INSERT INTO history_comments (author, causal_hash_id, created_at) - VALUES (:author, :causalHashId, strftime('%s', 'now', 'subsec')) + INSERT INTO history_comments (comment_hash_id, author_thumbprint_id, author, causal_hash_id, created_at) + VALUES (:commentHashId, :thumbprintId, :author, :causalHashId, strftime('%s', 'now', 'subsec')) 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')) + INSERT INTO history_comment_revisions (revision_hash_id, comment_id, subject, contents, created_at) + VALUES (:commentRevisionHashId, :commentId, :subject, :content, strftime('%s', 'now', 'subsec')) |] getAuthorName :: Transaction (Maybe AuthorName) diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index 9518d539fe..c04a239d89 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -22,7 +22,6 @@ library: - attoparsec - base - base64-bytestring - - blake3 - bytestring - cmark - co-log-core diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs index 5dd572e878..5b104a3300 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/History.hs @@ -30,7 +30,7 @@ handleHistory resultsCap diffCap from = do history <- doHistory schLength 0 branch [] Cli.respondNumbered history where - doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (LatestHistoryComment () () ()), Names.Diff)] -> Cli.Cli NumberedOutput + doHistory :: Int -> Int -> Branch IO -> [(CausalHash, Maybe (LatestHistoryComment () () () ()), Names.Diff)] -> Cli.Cli NumberedOutput doHistory schLength !n b acc = if maybe False (n >=) resultsCap then do @@ -49,10 +49,10 @@ handleHistory resultsCap diffCap from = do mayComment <- getComment causalHash let elem = (causalHash, mayComment, Branch.namesDiff b' b) doHistory schLength (n + 1) b' (elem : acc) - getComment :: CausalHash -> Cli.Cli (Maybe (LatestHistoryComment () () ())) + getComment :: CausalHash -> Cli.Cli (Maybe (LatestHistoryComment () () () ())) getComment ch = Cli.runTransaction $ do causalHashId <- Q.expectCausalHashIdByCausalHash ch Q.getLatestCausalComment causalHashId <&> fmap \hcr -> let comment = hcr.comment {authorThumbprint = (), causal = (), commentId = ()} - in hcr {comment = comment} + in hcr {comment = comment, revisionId = ()} diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 5e272a8b48..291e0736a2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -2,11 +2,9 @@ module Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment) where -import BLAKE3 qualified import Control.Monad.Reader -import Data.ByteArray qualified as ByteArray -import Data.ByteArray.Sized (SizedByteArray) -import Data.ByteArray.Sized qualified as SBA +import Crypto.Hash qualified as CH +import Data.ByteArray qualified as BA import Data.ByteString.Builder qualified as Builder import Data.ByteString.Lazy.Char8 qualified as BL import Data.Text qualified as Text @@ -16,7 +14,7 @@ import Data.Time (UTCTime) import Data.Time.Clock.POSIX qualified as Time import Text.RawString.QQ (r) import U.Codebase.Config qualified as Config -import U.Codebase.HashTags (CausalHash, CommentHash) +import U.Codebase.HashTags (CausalHash, CommentHash (..), CommentRevisionHash (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Auth.CredentialManager qualified as CredMan import Unison.Auth.PersonalKey qualified as PK @@ -47,54 +45,53 @@ commentHashingVersion = 1 -- Hash a base comment instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash ()) where contentHash HistoryComment {createdAt, author, causal, authorThumbprint} = - let commentHash :: SizedByteArray BLAKE3.DEFAULT_DIGEST_LEN ByteString - commentHash = - BLAKE3.hash - Nothing - [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, - Hash.toByteString (into @Hash causal), - Text.encodeUtf8 $ thumbprintToText authorThumbprint, - Text.encodeUtf8 author, - -- Encode UTCTime as a UTC 8601 seconds since epoch - createdAt - & Time.utcTimeToPOSIXSeconds - & floor - & Builder.int64BE - & Builder.toLazyByteString - & BL.toStrict - ] - in Hash.fromByteString . SBA.unSizedByteArray $ commentHash + CH.hashUpdates + CH.hashInit + [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, + Hash.toByteString (into @Hash causal), + Text.encodeUtf8 $ thumbprintToText authorThumbprint, + Text.encodeUtf8 author, + -- Encode UTCTime as a UTC 8601 seconds since epoch + createdAt + & Time.utcTimeToPOSIXSeconds + & floor + & Builder.int64BE + & Builder.toLazyByteString + & BL.toStrict + ] + & CH.hashFinalize @CH.SHA3_512 + & BA.convert + & Hash.fromByteString -- Hash a comment revision -instance ContentAddressable (HistoryCommentRevision UTCTime CommentHash) where +instance ContentAddressable (HistoryCommentRevision () UTCTime CommentHash) where contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash} = - let hashDigest :: SizedByteArray BLAKE3.DEFAULT_DIGEST_LEN ByteString - hashDigest = - BLAKE3.hash - Nothing - [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, - Hash.toByteString (into @Hash commentHash), - Text.encodeUtf8 subject, - Text.encodeUtf8 content, - -- Encode UTCTime as a UTC 8601 seconds since epoch - createdAt - & Time.utcTimeToPOSIXSeconds - & floor - & Builder.int64BE - & Builder.toLazyByteString - & BL.toStrict - ] - in Hash.fromByteString . ByteArray.convert $ hashDigest + CH.hashUpdates + CH.hashInit + [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, + Hash.toByteString (into @Hash commentHash), + Text.encodeUtf8 subject, + Text.encodeUtf8 content, + -- Encode UTCTime as a UTC 8601 seconds since epoch + createdAt + & Time.utcTimeToPOSIXSeconds + & floor + & Builder.int64BE + & Builder.toLazyByteString + & BL.toStrict + ] + & CH.hashFinalize @CH.SHA3_512 + & BA.convert + & Hash.fromByteString handleHistoryComment :: Maybe BranchId2 -> Cli () handleHistoryComment mayThingToAnnotate = do Cli.Env {credentialManager} <- ask authorThumbprint <- PK.personalKeyThumbprint <$> liftIO (CredMan.getOrCreatePersonalKey credentialManager) - (mayAuthorName, authorThumbprintId) <- + mayAuthorName <- Cli.runTransaction do authorName <- Q.getAuthorName - authorThumbprintId <- Q.expectPersonalKeyThumbprintId authorThumbprint - pure (authorName, authorThumbprintId) + pure (authorName) authorName <- case mayAuthorName of Nothing -> Cli.returnEarly $ AuthorNameRequired Just authorName -> pure authorName @@ -127,8 +124,29 @@ handleHistoryComment mayThingToAnnotate = do Nothing -> Cli.respond $ CommentAborted Just (subject, content) -> do createdAt <- liftIO $ Time.getCurrentTime - let historyComment = HistoryCommentRevision {subject, content, createdAt, comment = HistoryComment {author = Config.unAuthorName authorName, commentId = (), causal = causalHashId, createdAt, authorThumbprint = authorThumbprintId}} - Cli.runTransaction $ Q.commentOnCausal historyComment + let historyComment = + HistoryComment + { author = + Config.unAuthorName authorName, + commentId = (), + causal = causalHash, + createdAt, + authorThumbprint + } + let commentHash = CommentHash $ contentHash historyComment + let historyCommentRevision = + HistoryCommentRevision + { revisionId = (), + subject, + content, + createdAt, + comment = commentHash + } + let commentRevisionHash = CommentRevisionHash $ contentHash historyComment + let hashedComment = + historyCommentRevision {revisionId = commentRevisionHash, comment = historyComment {commentId = commentHash, causal = causalHashId}} + + Cli.runTransaction $ Q.commentOnCausal hashedComment Cli.respond $ CommentedSuccessfully where commentInstructions = diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index ce1b8e4e20..c47e9736ae 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -136,8 +136,8 @@ data NumberedOutput History (Maybe Int) -- Amount of history to print HashLength - [(CausalHash, Maybe (LatestHistoryComment () () ()), Names.Diff)] - (Maybe (LatestHistoryComment () () ()), HistoryTail) -- 'origin point' of this view of history. + [(CausalHash, Maybe (LatestHistoryComment () () () ()), Names.Diff)] + (Maybe (LatestHistoryComment () () () ()), HistoryTail) -- 'origin point' of this view of history. | ListProjects [Sqlite.Project] | ListBranches ProjectName [(ProjectBranchName, [(URI, ProjectName, ProjectBranchName)])] | AmbiguousSwitch ProjectName (ProjectAndBranch ProjectName ProjectBranchName) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 7828096e53..75911c0763 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -307,7 +307,7 @@ notifyNumbered = \case reversedHistory = reverse history showNum :: Int -> Pretty showNum n = P.shown n <> ". " - displayComment :: Bool -> Maybe (LatestHistoryComment () () () ) -> [Pretty] + displayComment :: Bool -> Maybe (LatestHistoryComment () () () () ) -> [Pretty] displayComment prefixSpacer mayComment = case mayComment of Nothing -> [] Just (HistoryCommentRevision {comment=HistoryComment{author}, subject, content}) -> diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 86a16093ca..43c01d4541 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -225,7 +225,6 @@ library , attoparsec , base , base64-bytestring - , blake3 , bytestring , cmark , co-log-core From 6fed958721f2fdd357a842792fe7e6e8aaa59a68 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Oct 2025 19:23:52 -0700 Subject: [PATCH 09/30] History Comments hashing module --- .../unison-parser-typechecker.cabal | 1 + .../Editor/HandleInput/HistoryComment.hs | 45 ------------- .../Codebase/HistoryComments/Hashing.hs | 64 +++++++++++++++++++ unison-cli/unison-cli.cabal | 3 +- 4 files changed, 67 insertions(+), 46 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 3522a51b03..e3862f751b 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -62,6 +62,7 @@ library Unison.Codebase.SqliteCodebase.Conversions Unison.Codebase.SqliteCodebase.Migrations Unison.Codebase.SqliteCodebase.Migrations.Helpers + Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 291e0736a2..866c73f07e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -39,51 +39,6 @@ import UnliftIO.Directory (findExecutable) import UnliftIO.Environment qualified as Env import UnliftIO.Process qualified as Proc -commentHashingVersion :: Int32 -commentHashingVersion = 1 - --- Hash a base comment -instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash ()) where - contentHash HistoryComment {createdAt, author, causal, authorThumbprint} = - CH.hashUpdates - CH.hashInit - [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, - Hash.toByteString (into @Hash causal), - Text.encodeUtf8 $ thumbprintToText authorThumbprint, - Text.encodeUtf8 author, - -- Encode UTCTime as a UTC 8601 seconds since epoch - createdAt - & Time.utcTimeToPOSIXSeconds - & floor - & Builder.int64BE - & Builder.toLazyByteString - & BL.toStrict - ] - & CH.hashFinalize @CH.SHA3_512 - & BA.convert - & Hash.fromByteString - --- Hash a comment revision -instance ContentAddressable (HistoryCommentRevision () UTCTime CommentHash) where - contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash} = - CH.hashUpdates - CH.hashInit - [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, - Hash.toByteString (into @Hash commentHash), - Text.encodeUtf8 subject, - Text.encodeUtf8 content, - -- Encode UTCTime as a UTC 8601 seconds since epoch - createdAt - & Time.utcTimeToPOSIXSeconds - & floor - & Builder.int64BE - & Builder.toLazyByteString - & BL.toStrict - ] - & CH.hashFinalize @CH.SHA3_512 - & BA.convert - & Hash.fromByteString - handleHistoryComment :: Maybe BranchId2 -> Cli () handleHistoryComment mayThingToAnnotate = do Cli.Env {credentialManager} <- ask diff --git a/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs b/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs new file mode 100644 index 0000000000..3459d688ba --- /dev/null +++ b/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs @@ -0,0 +1,64 @@ +module Unison.Codebase.HistoryComments.Hashing + ( hashComment, + hashCommentRevision, + ) +where + +commentHashingVersion :: Int32 +commentHashingVersion = 1 + +-- Hash a base comment +instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash any) where + contentHash HistoryComment {createdAt, author, causal, authorThumbprint} = + CH.hashUpdates + CH.hashInit + [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, + Hash.toByteString (into @Hash causal), + Text.encodeUtf8 $ thumbprintToText authorThumbprint, + Text.encodeUtf8 author, + -- Encode UTCTime as a UTC 8601 seconds since epoch + createdAt + & Time.utcTimeToPOSIXSeconds + & floor + & Builder.int64BE + & Builder.toLazyByteString + & BL.toStrict + ] + & CH.hashFinalize @CH.SHA3_512 + & BA.convert + & Hash.fromByteString + +-- Hash a comment revision +instance ContentAddressable (HistoryCommentRevision any UTCTime CommentHash) where + contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash} = + CH.hashUpdates + CH.hashInit + [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, + Hash.toByteString (into @Hash commentHash), + Text.encodeUtf8 subject, + Text.encodeUtf8 content, + -- Encode UTCTime as a UTC 8601 seconds since epoch + createdAt + & Time.utcTimeToPOSIXSeconds + & floor + & Builder.int64BE + & Builder.toLazyByteString + & BL.toStrict + ] + & CH.hashFinalize @CH.SHA3_512 + & BA.convert + & Hash.fromByteString + +hashHistoryComment :: + HistoryComment UTCTime KeyThumbprint CausalHash any -> + HistoryComment UTCTime KeyThumbprint CausalHash HistoryCommentHash +hashHistoryComment historyComment = + let commentHash = CommentHash $ contentHash historyComment + in historyComment {commentId = commentHash} + +hashHistoryCommentRevision :: + HistoryCommentRevision any UTCTime CommentHash + -> HistoryCommentRevision CommentRevisionHash UTCTime CommentHash +hashHistoryCommentRevision historyCommentRevision = + let commentRevisionHash = CommentRevisionHash $ contentHash historyComment + in historyCommentRevision {revisionId = commentRevisionHash} diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 43c01d4541..43fb45bf34 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack @@ -115,6 +115,7 @@ library Unison.Codebase.Editor.StructuredArgument Unison.Codebase.Editor.UCMVersion Unison.Codebase.Editor.UriParser + Unison.Codebase.HistoryComments.Hashing Unison.Codebase.Transcript Unison.Codebase.Transcript.Parser Unison.Codebase.Transcript.Runner From 13405c41f5c0993c5a236ab3d261dece065365d8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 13:51:11 -0800 Subject: [PATCH 10/30] Rename hashes to HistoryCommentHash --- .../U/Codebase/Sqlite/Queries.hs | 18 +++--- codebase2/core/U/Codebase/HashTags.hs | 36 ++++++------ .../unison-parser-typechecker.cabal | 1 - .../Editor/HandleInput/HistoryComment.hs | 57 ++++++++----------- .../Codebase/HistoryComments/Hashing.hs | 33 ++++++++--- 5 files changed, 75 insertions(+), 70 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 3d9d7077db..abefd0eea7 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -341,8 +341,8 @@ import U.Codebase.Decl qualified as C.Decl import U.Codebase.HashTags ( BranchHash (..), CausalHash (..), - CommentHash (..), - CommentRevisionHash (..), + HistoryCommentHash (..), + HistoryCommentRevisionHash (..), PatchHash (..), ) import U.Codebase.Reference (Reference' (..)) @@ -647,11 +647,11 @@ expectCausalByCausalHash ch = do bhId <- expectCausalValueHashId hId pure (hId, bhId) -saveCommentHash :: CommentHash -> Transaction CommentHashId -saveCommentHash = fmap CommentHashId . saveHashHash . unCommentHash +saveCommentHash :: HistoryCommentHash -> Transaction CommentHashId +saveCommentHash = fmap CommentHashId . saveHashHash . unHistoryCommentHash -saveCommentRevisionHash :: CommentRevisionHash -> Transaction CommentRevisionHashId -saveCommentRevisionHash = fmap CommentRevisionHashId . saveHashHash . unCommentRevisionHash +saveCommentRevisionHash :: HistoryCommentRevisionHash -> Transaction CommentRevisionHashId +saveCommentRevisionHash = fmap CommentRevisionHashId . saveHashHash . unHistoryCommentRevisionHash expectHashIdByHash :: Hash -> Transaction HashId expectHashIdByHash = expectHashId . Hash32.fromHash @@ -4149,7 +4149,7 @@ saveSquashResult bhId chId = getLatestCausalComment :: CausalHashId -> - Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash HistoryCommentRevisionId CommentHash)) + Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash HistoryCommentRevisionId HistoryCommentHash)) getLatestCausalComment causalHashId = queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, HistoryCommentRevisionId, Text, Text, Time.UTCTime) [sql| @@ -4174,11 +4174,11 @@ getLatestCausalComment causalHashId = authorThumbprint, causal = CausalHash . Hash32.toHash $ causalHash, createdAt, - commentId = CommentHash . Hash32.toHash $ commentHash + commentId = HistoryCommentHash . Hash32.toHash $ commentHash } } -commentOnCausal :: LatestHistoryComment KeyThumbprint CausalHashId CommentRevisionHash CommentHash -> Transaction () +commentOnCausal :: LatestHistoryComment KeyThumbprint CausalHashId HistoryCommentRevisionHash HistoryCommentHash -> Transaction () commentOnCausal HistoryCommentRevision { content, diff --git a/codebase2/core/U/Codebase/HashTags.hs b/codebase2/core/U/Codebase/HashTags.hs index 9b0e1dee65..79bad7a8c0 100644 --- a/codebase2/core/U/Codebase/HashTags.hs +++ b/codebase2/core/U/Codebase/HashTags.hs @@ -18,10 +18,10 @@ newtype CausalHash = CausalHash {unCausalHash :: Hash} newtype PatchHash = PatchHash {unPatchHash :: Hash} deriving stock (Eq, Ord) -newtype CommentHash = CommentHash {unCommentHash :: Hash} +newtype HistoryCommentHash = HistoryCommentHash {unHistoryCommentHash :: Hash} deriving stock (Eq, Ord) -newtype CommentRevisionHash = CommentRevisionHash {unCommentRevisionHash :: Hash} +newtype HistoryCommentRevisionHash = HistoryCommentRevisionHash {unHistoryCommentRevisionHash :: Hash} deriving stock (Eq, Ord) instance Show ComponentHash where @@ -36,11 +36,11 @@ instance Show CausalHash where instance Show PatchHash where show h = "PatchHash (" ++ show (unPatchHash h) ++ ")" -instance Show CommentHash where - show h = "CommentHash (" ++ show (unCommentHash h) ++ ")" +instance Show HistoryCommentHash where + show h = "HistoryCommentHash (" ++ show (unHistoryCommentHash h) ++ ")" -instance Show CommentRevisionHash where - show h = "CommentRevisionHash (" ++ show (unCommentRevisionHash h) ++ ")" +instance Show HistoryCommentRevisionHash where + show h = "HistoryCommentRevisionHash (" ++ show (unHistoryCommentRevisionHash h) ++ ")" instance From ComponentHash Text where from = from @Hash @Text . unComponentHash @@ -54,11 +54,11 @@ instance From CausalHash Text where instance From PatchHash Text where from = from @Hash @Text . unPatchHash -instance From CommentHash Text where - from = from @Hash @Text . unCommentHash +instance From HistoryCommentHash Text where + from = from @Hash @Text . unHistoryCommentHash -instance From CommentRevisionHash Text where - from = from @Hash @Text . unCommentRevisionHash +instance From HistoryCommentRevisionHash Text where + from = from @Hash @Text . unHistoryCommentRevisionHash instance From ComponentHash Hash @@ -68,9 +68,9 @@ instance From CausalHash Hash instance From PatchHash Hash -instance From CommentHash Hash +instance From HistoryCommentHash Hash -instance From CommentRevisionHash Hash +instance From HistoryCommentRevisionHash Hash instance From Hash ComponentHash @@ -80,9 +80,9 @@ instance From Hash CausalHash instance From Hash PatchHash -instance From Hash CommentHash +instance From Hash HistoryCommentHash -instance From Hash CommentRevisionHash +instance From Hash HistoryCommentRevisionHash instance From ComponentHash Hash32 where from = from @Hash @Hash32 . unComponentHash @@ -108,8 +108,8 @@ instance From Hash32 CausalHash where instance From Hash32 PatchHash where from = PatchHash . from @Hash32 @Hash -instance From CommentHash Hash32 where - from = from @Hash @Hash32 . unCommentHash +instance From HistoryCommentHash Hash32 where + from = from @Hash @Hash32 . unHistoryCommentHash -instance From CommentRevisionHash Hash32 where - from = from @Hash @Hash32 . unCommentRevisionHash +instance From HistoryCommentRevisionHash Hash32 where + from = from @Hash @Hash32 . unHistoryCommentRevisionHash diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index e3862f751b..3522a51b03 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -62,7 +62,6 @@ library Unison.Codebase.SqliteCodebase.Conversions Unison.Codebase.SqliteCodebase.Migrations Unison.Codebase.SqliteCodebase.Migrations.Helpers - Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 866c73f07e..11f4110083 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -1,20 +1,11 @@ -{-# OPTIONS_GHC -Wno-orphans #-} - module Unison.Codebase.Editor.HandleInput.HistoryComment (handleHistoryComment) where import Control.Monad.Reader -import Crypto.Hash qualified as CH -import Data.ByteArray qualified as BA -import Data.ByteString.Builder qualified as Builder -import Data.ByteString.Lazy.Char8 qualified as BL import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text import Data.Text.IO qualified as Text -import Data.Time (UTCTime) import Data.Time.Clock.POSIX qualified as Time import Text.RawString.QQ (r) import U.Codebase.Config qualified as Config -import U.Codebase.HashTags (CausalHash, CommentHash (..), CommentRevisionHash (..)) import U.Codebase.Sqlite.Queries qualified as Q import Unison.Auth.CredentialManager qualified as CredMan import Unison.Auth.PersonalKey qualified as PK @@ -25,14 +16,14 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (BranchId2) import Unison.Codebase.Editor.Output (Output (..)) +import Unison.Codebase.HistoryComments.Hashing + ( hashHistoryComment, + hashHistoryCommentRevision, + ) import Unison.Codebase.Path qualified as Path import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.Core.Project (ProjectAndBranch (..)) -import Unison.Hash (Hash) -import Unison.Hash qualified as Hash -import Unison.Hashing.V2 (ContentAddressable (..)) import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..)) -import Unison.KeyThumbprint (KeyThumbprint (..)) import Unison.Prelude import UnliftIO qualified import UnliftIO.Directory (findExecutable) @@ -80,28 +71,26 @@ handleHistoryComment mayThingToAnnotate = do Just (subject, content) -> do createdAt <- liftIO $ Time.getCurrentTime let historyComment = - HistoryComment - { author = - Config.unAuthorName authorName, - commentId = (), - causal = causalHash, - createdAt, - authorThumbprint - } - let commentHash = CommentHash $ contentHash historyComment + hashHistoryComment $ + HistoryComment + { author = + Config.unAuthorName authorName, + commentId = (), + causal = causalHash, + createdAt, + authorThumbprint + } let historyCommentRevision = - HistoryCommentRevision - { revisionId = (), - subject, - content, - createdAt, - comment = commentHash - } - let commentRevisionHash = CommentRevisionHash $ contentHash historyComment - let hashedComment = - historyCommentRevision {revisionId = commentRevisionHash, comment = historyComment {commentId = commentHash, causal = causalHashId}} - - Cli.runTransaction $ Q.commentOnCausal hashedComment + hashHistoryCommentRevision $ + HistoryCommentRevision + { revisionId = (), + subject, + content, + createdAt, + comment = historyComment.commentId + } + let historyComment' = historyComment {causal = causalHashId} + Cli.runTransaction $ Q.commentOnCausal $ historyCommentRevision {comment = historyComment'} Cli.respond $ CommentedSuccessfully where commentInstructions = diff --git a/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs b/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs index 3459d688ba..9370b29031 100644 --- a/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs +++ b/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs @@ -1,9 +1,26 @@ +{-# OPTIONS_GHC -Wno-orphans #-} + module Unison.Codebase.HistoryComments.Hashing - ( hashComment, - hashCommentRevision, + ( hashHistoryComment, + hashHistoryCommentRevision, ) where +import Crypto.Hash qualified as CH +import Data.ByteArray qualified as BA +import Data.ByteString.Builder qualified as Builder +import Data.ByteString.Lazy.Char8 qualified as BL +import Data.Text.Encoding qualified as Text +import Data.Time (UTCTime) +import Data.Time.Clock.POSIX qualified as Time +import U.Codebase.HashTags (CausalHash, HistoryCommentHash (..), HistoryCommentRevisionHash (..)) +import Unison.Hash (Hash) +import Unison.Hash qualified as Hash +import Unison.Hashing.V2 (ContentAddressable (..)) +import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..)) +import Unison.KeyThumbprint (KeyThumbprint (..)) +import Unison.Prelude + commentHashingVersion :: Int32 commentHashingVersion = 1 @@ -29,7 +46,7 @@ instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash any & Hash.fromByteString -- Hash a comment revision -instance ContentAddressable (HistoryCommentRevision any UTCTime CommentHash) where +instance ContentAddressable (HistoryCommentRevision any UTCTime HistoryCommentHash) where contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash} = CH.hashUpdates CH.hashInit @@ -53,12 +70,12 @@ hashHistoryComment :: HistoryComment UTCTime KeyThumbprint CausalHash any -> HistoryComment UTCTime KeyThumbprint CausalHash HistoryCommentHash hashHistoryComment historyComment = - let commentHash = CommentHash $ contentHash historyComment + let commentHash = HistoryCommentHash $ contentHash historyComment in historyComment {commentId = commentHash} hashHistoryCommentRevision :: - HistoryCommentRevision any UTCTime CommentHash - -> HistoryCommentRevision CommentRevisionHash UTCTime CommentHash + HistoryCommentRevision any UTCTime HistoryCommentHash -> + HistoryCommentRevision HistoryCommentRevisionHash UTCTime HistoryCommentHash hashHistoryCommentRevision historyCommentRevision = - let commentRevisionHash = CommentRevisionHash $ contentHash historyComment - in historyCommentRevision {revisionId = commentRevisionHash} + let commentRevisionHash = HistoryCommentRevisionHash $ contentHash historyCommentRevision + in historyCommentRevision {revisionId = commentRevisionHash} From cea3a7b58a9af92279bc1d060a02db68faaffb31 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 31 Oct 2025 19:23:52 -0700 Subject: [PATCH 11/30] History Comments hashing migration --- .../Codebase/SqliteCodebase/Migrations.hs | 3 +- .../Migrations/MigrateHistoryComments.hs | 64 +++++++++++++++++++ 2 files changed, 66 insertions(+), 1 deletion(-) create mode 100644 parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index c39b90fee5..5312417845 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -90,7 +90,8 @@ migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath = sqlMigration 20 Q.addUpdateBranchTable, sqlMigration 21 Q.addDerivedDependentsByDependencyIndex, sqlMigration 22 Q.addUpgradeBranchTable, - sqlMigration 23 Q.addHistoryComments + sqlMigration 23 Q.addHistoryComments, + (24, runT hashHistoryCommentsMigration) ] where runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO () diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs new file mode 100644 index 0000000000..bf10b5d807 --- /dev/null +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +module Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments (hashHistoryCommentsMigration) where + +import Control.Lens +import Data.Aeson qualified as Aeson +import Data.Aeson.Text qualified as Aeson +import Data.Map qualified as Map +import Data.Text qualified as Text +import Data.Text.Encoding qualified as Text +import Data.Text.Lazy qualified as Text.Lazy +import Data.UUID (UUID) +import Data.UUID qualified as UUID +import U.Codebase.Branch.Type qualified as V2Branch +import U.Codebase.Causal qualified as V2Causal +import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId (..), ProjectId (..)) +import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..), ProjectBranchRow (..)) +import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Path qualified as Path +import Unison.Codebase.SqliteCodebase.Branch.Cache qualified as BranchCache +import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps +import Unison.Codebase.SqliteCodebase.Operations qualified as Ops +import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) +import Unison.Debug qualified as Debug +import Unison.NameSegment (NameSegment) +import Unison.NameSegment.Internal (NameSegment (..)) +import Unison.NameSegment.Internal qualified as NameSegment +import Unison.Prelude +import Unison.Sqlite (queryListCol) +import Unison.Sqlite qualified as Sqlite +import Unison.Sqlite.Connection qualified as Connection +import Unison.Syntax.NameSegment qualified as NameSegment +import Unison.Util.Cache qualified as Cache +import UnliftIO qualified +import UnliftIO qualified as UnsafeIO + +-- | 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 + Queries.expectSchemaVersion 23 + hashAllHistoryComments + Queries.setSchemaVersion 24 + +hashAllHistoryComments :: Sqlite.Transaction () +hashAllHistoryComments = do + historyComments <- + Sqlite.queryListRow @(HistoryCommentId, CausalHash, Text, UTCTime) + [Sqlite.sql| + SELECT id, causal_hash.base32, author, created_at + FROM history_comments + |] + for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, createdAt) -> do + let newCausalHash = hashHistoryComment causalHash author createdAt + Sqlite.execute + [Sqlite.sql| + UPDATE history_comments + SET causal_hash = ? + WHERE id = ? + |] + (newCausalHash, commentId) From d969eecf3a8a79eab06aebff5df626918d34b28a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 14:03:02 -0800 Subject: [PATCH 12/30] Reorganize modules --- .../U/Codebase/Sqlite/Queries.hs | 14 +-- parser-typechecker/package.yaml | 2 + .../Codebase/SqliteCodebase/Migrations.hs | 1 + .../Migrations/MigrateHistoryComments.hs | 90 +++++++++++-------- .../src/Unison/Hashing/HistoryComments.hs | 2 +- .../unison-parser-typechecker.cabal | 4 + unison-cli/package.yaml | 1 - .../Editor/HandleInput/HistoryComment.hs | 2 +- unison-cli/unison-cli.cabal | 2 - 9 files changed, 68 insertions(+), 50 deletions(-) rename unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs => parser-typechecker/src/Unison/Hashing/HistoryComments.hs (98%) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index abefd0eea7..44aaed6567 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -35,6 +35,8 @@ module U.Codebase.Sqlite.Queries expectCausalHash, expectBranchHashForCausalHash, saveBranchHash, + saveHistoryCommentHash, + saveHistoryCommentRevisionHash, -- * hash_object table saveHashObject, @@ -647,11 +649,11 @@ expectCausalByCausalHash ch = do bhId <- expectCausalValueHashId hId pure (hId, bhId) -saveCommentHash :: HistoryCommentHash -> Transaction CommentHashId -saveCommentHash = fmap CommentHashId . saveHashHash . unHistoryCommentHash +saveHistoryCommentHash :: HistoryCommentHash -> Transaction CommentHashId +saveHistoryCommentHash = fmap CommentHashId . saveHashHash . unHistoryCommentHash -saveCommentRevisionHash :: HistoryCommentRevisionHash -> Transaction CommentRevisionHashId -saveCommentRevisionHash = fmap CommentRevisionHashId . saveHashHash . unHistoryCommentRevisionHash +saveHistoryCommentRevisionHash :: HistoryCommentRevisionHash -> Transaction CommentRevisionHashId +saveHistoryCommentRevisionHash = fmap CommentRevisionHashId . saveHashHash . unHistoryCommentRevisionHash expectHashIdByHash :: Hash -> Transaction HashId expectHashIdByHash = expectHashId . Hash32.fromHash @@ -4186,8 +4188,8 @@ commentOnCausal revisionId = commentRevisionHash, comment = HistoryComment {author, authorThumbprint, causal = causalHashId, commentId = commentHash} } = do - commentHashId <- saveCommentHash commentHash - commentRevisionHashId <- saveCommentRevisionHash commentRevisionHash + commentHashId <- saveHistoryCommentHash commentHash + commentRevisionHashId <- saveHistoryCommentRevisionHash commentRevisionHash thumbprintId <- expectPersonalKeyThumbprintId authorThumbprint mayExistingCommentId <- queryMaybeCol @HistoryCommentId diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index 29ff1f65d0..2d5bc6a8af 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -20,6 +20,7 @@ library: - bytestring - concurrent-output - containers >= 0.6.3 + - cryptonite - errors - extra - filelock @@ -30,6 +31,7 @@ library: - hashtables - lens - megaparsec + - memory - mmorph - mtl - murmur-hash diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 5312417845..e6ec239608 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -20,6 +20,7 @@ import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (OpenCodebaseUn import Unison.Codebase.Init.OpenCodebaseError qualified as Codebase import Unison.Codebase.IntegrityCheck (IntegrityResult (..), integrityCheckAllBranches, integrityCheckAllCausals, prettyPrintIntegrityErrors) import Unison.Codebase.SqliteCodebase.Migrations.Helpers (abortMigration) +import Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments (hashHistoryCommentsMigration) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 (migrateSchema11To12) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 (migrateSchema16To17) import Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 (migrateSchema1To2) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs index bf10b5d807..c84a4bffae 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs @@ -3,62 +3,74 @@ module Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments (hashHistoryCommentsMigration) where -import Control.Lens -import Data.Aeson qualified as Aeson -import Data.Aeson.Text qualified as Aeson -import Data.Map qualified as Map -import Data.Text qualified as Text -import Data.Text.Encoding qualified as Text -import Data.Text.Lazy qualified as Text.Lazy -import Data.UUID (UUID) -import Data.UUID qualified as UUID -import U.Codebase.Branch.Type qualified as V2Branch -import U.Codebase.Causal qualified as V2Causal -import U.Codebase.Sqlite.DbId (CausalHashId, ProjectBranchId (..), ProjectId (..)) -import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..), ProjectBranchRow (..)) +import Data.Time (UTCTime) +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.Codebase qualified as Codebase -import Unison.Codebase.Branch qualified as Branch -import Unison.Codebase.Path qualified as Path -import Unison.Codebase.SqliteCodebase.Branch.Cache qualified as BranchCache -import Unison.Codebase.SqliteCodebase.Operations qualified as CodebaseOps -import Unison.Codebase.SqliteCodebase.Operations qualified as Ops -import Unison.Core.Project (ProjectBranchName (..), ProjectName (..)) -import Unison.Debug qualified as Debug -import Unison.NameSegment (NameSegment) -import Unison.NameSegment.Internal (NameSegment (..)) -import Unison.NameSegment.Internal qualified as NameSegment +import Unison.Hash (Hash) +import Unison.Hashing.HistoryComments (hashHistoryComment, hashHistoryCommentRevision) +import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..)) +import Unison.KeyThumbprint (KeyThumbprint (KeyThumbprint)) import Unison.Prelude -import Unison.Sqlite (queryListCol) import Unison.Sqlite qualified as Sqlite -import Unison.Sqlite.Connection qualified as Connection -import Unison.Syntax.NameSegment qualified as NameSegment -import Unison.Util.Cache qualified as Cache -import UnliftIO qualified -import UnliftIO qualified as UnsafeIO -- | 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 - Queries.expectSchemaVersion 23 + Q.expectSchemaVersion 23 hashAllHistoryComments - Queries.setSchemaVersion 24 + Q.setSchemaVersion 24 hashAllHistoryComments :: Sqlite.Transaction () hashAllHistoryComments = do historyComments <- - Sqlite.queryListRow @(HistoryCommentId, CausalHash, Text, UTCTime) + Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, Text, UTCTime) [Sqlite.sql| - SELECT id, causal_hash.base32, author, created_at + SELECT id, causal_hash.base32, author, thumbprint.thumbprint, created_at FROM history_comments + JOIN hash causal_hash ON history_comments.causal_hash_id = causal_hash.id + JOIN key_thumbprint thumbprint ON history_comments.author_thumbprint_id = thumbprint.id |] - for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, createdAt) -> do - let newCausalHash = hashHistoryComment causalHash author createdAt + for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, authorThumbprint, createdAt) -> do + let historyComment = + HistoryComment + { author, + createdAt, + authorThumbprint = KeyThumbprint authorThumbprint, + causal = coerce @_ @CausalHash causalHash, + commentId = () + } + let historyCommentHash = hashHistoryComment historyComment + historyCommentHashId <- Q.saveHistoryCommentHash historyCommentHash.commentId Sqlite.execute [Sqlite.sql| UPDATE history_comments - SET causal_hash = ? - WHERE id = ? + SET comment_hash_id = :historyCommentHashId + WHERE id = :commentId + |] + historyCommentRevisions <- + Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, UTCTime, AsSqlite Hash) + [Sqlite.sql| + SELECT id, subject, content, created_at, comment_hash.base32 + FROM history_comment_revisions + JOIN hash comment_hash ON history_comment_revisions.comment_hash_id = comment_hash.id + |] + for_ historyCommentRevisions $ \(HistoryCommentRevisionId revisionId, subject, content, createdAt, commentHash) -> do + let historyCommentRevision = + HistoryCommentRevision + { subject, + content, + createdAt, + comment = coerce @_ @HistoryCommentHash commentHash, + revisionId = () + } + let historyCommentRevisionHash = hashHistoryCommentRevision historyCommentRevision + commentRevisionHashId <- Q.saveHistoryCommentRevisionHash historyCommentRevisionHash.revisionId + Sqlite.execute + [Sqlite.sql| + UPDATE history_comment_revisions + SET revision_hash_id = :commentRevisionHashId + WHERE id = :revisionId |] - (newCausalHash, commentId) diff --git a/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs b/parser-typechecker/src/Unison/Hashing/HistoryComments.hs similarity index 98% rename from unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs rename to parser-typechecker/src/Unison/Hashing/HistoryComments.hs index 9370b29031..aa76f8436d 100644 --- a/unison-cli/src/Unison/Codebase/HistoryComments/Hashing.hs +++ b/parser-typechecker/src/Unison/Hashing/HistoryComments.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module Unison.Codebase.HistoryComments.Hashing +module Unison.Hashing.HistoryComments ( hashHistoryComment, hashHistoryCommentRevision, ) diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 3522a51b03..228ed067cf 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -62,6 +62,7 @@ library Unison.Codebase.SqliteCodebase.Conversions Unison.Codebase.SqliteCodebase.Migrations Unison.Codebase.SqliteCodebase.Migrations.Helpers + Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema11To12 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema16To17 Unison.Codebase.SqliteCodebase.Migrations.MigrateSchema1To2 @@ -82,6 +83,7 @@ library Unison.CodebasePath Unison.DataDeclaration.Dependencies Unison.FileParsers + Unison.Hashing.HistoryComments Unison.Hashing.V2.Convert Unison.KindInference Unison.KindInference.Constraint.Context @@ -203,6 +205,7 @@ library , bytestring , concurrent-output , containers >=0.6.3 + , cryptonite , errors , extra , filelock @@ -213,6 +216,7 @@ library , hashtables , lens , megaparsec + , memory , mmorph , mtl , murmur-hash diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index c04a239d89..fc93fd7597 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -88,7 +88,6 @@ library: - unison-core - unison-core1 - unison-hash - - unison-hashing-v2 - unison-merge - unison-parser-typechecker - unison-prelude diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 11f4110083..0a55f2d3ea 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -16,7 +16,7 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (BranchId2) import Unison.Codebase.Editor.Output (Output (..)) -import Unison.Codebase.HistoryComments.Hashing +import Unison.Hashing.HistoryComments ( hashHistoryComment, hashHistoryCommentRevision, ) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 43fb45bf34..a6e8f10d9c 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -115,7 +115,6 @@ library Unison.Codebase.Editor.StructuredArgument Unison.Codebase.Editor.UCMVersion Unison.Codebase.Editor.UriParser - Unison.Codebase.HistoryComments.Hashing Unison.Codebase.Transcript Unison.Codebase.Transcript.Parser Unison.Codebase.Transcript.Runner @@ -292,7 +291,6 @@ library , unison-core , unison-core1 , unison-hash - , unison-hashing-v2 , unison-merge , unison-parser-typechecker , unison-prelude From caf7eb653d8ec52781773a04272b855576ba80fb Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 14:30:48 -0800 Subject: [PATCH 13/30] Add missing migration steps --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 7 ++++++- .../src/Unison/Codebase/SqliteCodebase/Migrations.hs | 3 ++- .../SqliteCodebase/Migrations/MigrateHistoryComments.hs | 2 +- .../src/Unison/Codebase/SqliteCodebase/Operations.hs | 1 + 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 44aaed6567..00d3bf779d 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -262,6 +262,7 @@ module U.Codebase.Sqlite.Queries addDerivedDependentsByDependencyIndex, addUpgradeBranchTable, addHistoryComments, + addHistoryCommentHashing, -- ** schema version currentSchemaVersion, @@ -449,7 +450,7 @@ type TextPathSegments = [Text] -- * main squeeze currentSchemaVersion :: SchemaVersion -currentSchemaVersion = 23 +currentSchemaVersion = 25 runCreateSql :: Transaction () runCreateSql = @@ -539,6 +540,10 @@ addHistoryComments :: Transaction () addHistoryComments = executeStatements $(embedProjectStringFile "sql/020-add-history-comments.sql") +addHistoryCommentHashing :: Transaction () +addHistoryCommentHashing = + executeStatements $(embedProjectStringFile "sql/021-hash-history-comments.sql") + schemaVersion :: Transaction SchemaVersion schemaVersion = queryOneCol diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index e6ec239608..836f0a9021 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -92,7 +92,8 @@ migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath = sqlMigration 21 Q.addDerivedDependentsByDependencyIndex, sqlMigration 22 Q.addUpgradeBranchTable, sqlMigration 23 Q.addHistoryComments, - (24, runT hashHistoryCommentsMigration) + sqlMigration 24 Q.addHistoryComments, + (25, runT hashHistoryCommentsMigration) ] where runT :: Sqlite.Transaction () -> Sqlite.Connection -> IO () diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs index c84a4bffae..c893cc6bf7 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs @@ -31,7 +31,7 @@ hashAllHistoryComments = do SELECT id, causal_hash.base32, author, thumbprint.thumbprint, created_at FROM history_comments JOIN hash causal_hash ON history_comments.causal_hash_id = causal_hash.id - JOIN key_thumbprint thumbprint ON history_comments.author_thumbprint_id = thumbprint.id + JOIN key_thumbprints thumbprint ON history_comments.author_thumbprint_id = thumbprint.id |] for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, authorThumbprint, createdAt) -> do let historyComment = diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs index cbe8e5df0b..0e63d53fbd 100644 --- 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.addDerivedDependentsByDependencyIndex Q.addUpgradeBranchTable Q.addHistoryComments + Q.addHistoryCommentHashing (_, emptyCausalHashId) <- emptyCausalHash (_, ProjectBranchRow {projectId, branchId}) <- insertProjectAndBranch scratchProjectName scratchBranchName emptyCausalHashId From ccdc1b5d2779aa57f60bdbf698971c71a0040e2a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 15:48:09 -0800 Subject: [PATCH 14/30] Migration sql fixes --- .../sql/021-hash-history-comments.sql | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql index df08eabf37..978937eec8 100644 --- a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -8,10 +8,18 @@ CREATE TABLE IF NOT EXISTS key_thumbprints ( ALTER TABLE history_comments -- The hash used for comment identity. -- It's the hash of (causal_hash <> author <> created_at) - ADD COLUMN comment_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id), + ADD COLUMN comment_hash_id INTEGER NOT 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 NOT 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) - ADD COLUMN revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id); + ADD COLUMN revision_hash_id INTEGER NOT NULL REFERENCES hash(id); + +CREATE UNIQUE INDEX IF NOT EXISTS idx_history_comment_revisions_revision_hash_id + ON history_comment_revisions(revision_hash_id); From 6d7a9dd697fb2b5c7c3994598472b77672fc06e8 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 16:02:57 -0800 Subject: [PATCH 15/30] Add new sql for copying data in order to make non-null columns --- .../sql/021-hash-history-comments.sql | 6 +- .../sql/022-after-hash-history-comments.sql | 55 +++++++++++++++++++ 2 files changed, 58 insertions(+), 3 deletions(-) create mode 100644 codebase2/codebase-sqlite/sql/022-after-hash-history-comments.sql diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql index 978937eec8..fc71792fbc 100644 --- a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -8,18 +8,18 @@ CREATE TABLE IF NOT EXISTS key_thumbprints ( ALTER TABLE history_comments -- The hash used for comment identity. -- It's the hash of (causal_hash <> author <> created_at) - ADD COLUMN comment_hash_id INTEGER NOT NULL REFERENCES hash(id); + 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 NOT NULL REFERENCES key_thumbprints(id); + 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) - ADD COLUMN revision_hash_id INTEGER NOT NULL REFERENCES hash(id); + ADD COLUMN revision_hash_id INTEGER NULL REFERENCES hash(id); CREATE UNIQUE INDEX IF NOT EXISTS idx_history_comment_revisions_revision_hash_id ON history_comment_revisions(revision_hash_id); diff --git a/codebase2/codebase-sqlite/sql/022-after-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/022-after-hash-history-comments.sql new file mode 100644 index 0000000000..dd150ef48c --- /dev/null +++ b/codebase2/codebase-sqlite/sql/022-after-hash-history-comments.sql @@ -0,0 +1,55 @@ +-- Assert hash columns are non-nullable after we've filled in all the values. +-- SQLite annoying does not support doing this in place, so we need to make a new table. + +CREATE TABLE history_comments_new ( + id INTEGER PRIMARY KEY, + causal_hash_id INTEGER REFERENCES hash(id) NOT NULL, + author TEXT NOT NULL, + + -- Remember that SQLITE doesn't have any actual 'time' type, + -- This column contains float values constructed + -- using strftime('%s', 'now', 'subsec') + created_at TEXT NOT NULL, + + comment_hash_id UNIQUE INTEGER 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, + comment_id INTEGER REFERENCES history_comments(id), + subject TEXT NOT NULL, + contents TEXT NOT NULL, + + -- Remember that SQLITE doesn't have any actual 'time' type, + -- This column contains float values constructed + -- using strftime('%s', 'now', 'subsec') + created_at TEXT NOT NULL, + + -- - In a distributed system you really can’t ever truly delete comments, + -- but you can ask to hide them. + hidden BOOL NOT NULL DEFAULT FALSE, + + revision_hash_id UNIQUE INTEGER 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) + SELECT id, causal_hash_id, author, created_at, comment_hash_id, author_thumbprint_id + FROM history_comments; + +INSERT INTO history_comment_revisions_new (id, comment_id, subject, contents, created_at, hidden, revision_hash_id) + SELECT id, comment_id, subject, contents, created_at, hidden, revision_hash_id + FROM history_comment_revisions; + +-- Drop old tables +DROP TABLE history_comments; +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; From b9bdb87e9816fe90a3d01904e52c401e8ee0d210 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 16:02:57 -0800 Subject: [PATCH 16/30] Fix unqualified sql names --- .../Unison/Codebase/SqliteCodebase/Migrations.hs | 2 +- .../Migrations/MigrateHistoryComments.hs | 14 +++++++------- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 836f0a9021..8b14c34e8c 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -92,7 +92,7 @@ migrations regionVar getDeclType termBuffer declBuffer rootCodebasePath = sqlMigration 21 Q.addDerivedDependentsByDependencyIndex, sqlMigration 22 Q.addUpgradeBranchTable, sqlMigration 23 Q.addHistoryComments, - sqlMigration 24 Q.addHistoryComments, + sqlMigration 24 Q.addHistoryCommentHashing, (25, runT hashHistoryCommentsMigration) ] where diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs index c893cc6bf7..b4b7320110 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs @@ -19,17 +19,17 @@ import Unison.Sqlite qualified as Sqlite -- On share we'll rebuild only the required name lookups from scratch. hashHistoryCommentsMigration :: Sqlite.Transaction () hashHistoryCommentsMigration = do - Q.expectSchemaVersion 23 + Q.expectSchemaVersion 24 hashAllHistoryComments - Q.setSchemaVersion 24 + Q.setSchemaVersion 25 hashAllHistoryComments :: Sqlite.Transaction () hashAllHistoryComments = do historyComments <- Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, Text, UTCTime) [Sqlite.sql| - SELECT id, causal_hash.base32, author, thumbprint.thumbprint, created_at - FROM history_comments + 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 |] @@ -53,9 +53,9 @@ hashAllHistoryComments = do historyCommentRevisions <- Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, UTCTime, AsSqlite Hash) [Sqlite.sql| - SELECT id, subject, content, created_at, comment_hash.base32 - FROM history_comment_revisions - JOIN hash comment_hash ON history_comment_revisions.comment_hash_id = comment_hash.id + SELECT hcr.id, hcr.subject, hcr.content, hcr.created_at, comment_hash.base32 + FROM history_comment_revisions hcr + JOIN hash comment_hash ON hcr.comment_hash_id = comment_hash.id |] for_ historyCommentRevisions $ \(HistoryCommentRevisionId revisionId, subject, content, createdAt, commentHash) -> do let historyCommentRevision = From 82fd692463efb403c92da295e210fa55c9a746ba Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 3 Nov 2025 16:14:55 -0800 Subject: [PATCH 17/30] Start wiring in personal keys to migration --- .../U/Codebase/Sqlite/Queries.hs | 5 ++ ... => 022-hash-history-comments-cleanup.sql} | 9 +-- .../unison-codebase-sqlite.cabal | 1 + lib/unison-credentials/package.yaml | 55 +++++++++++++++ .../src/Unison/Auth/CredentialFile.hs | 0 .../src/Unison/Auth/CredentialManager.hs | 0 .../src/Unison/Auth/PersonalKey.hs | 0 .../src/Unison/Auth/Types.hs | 0 .../unison-credentials.cabal | 69 +++++++++++++++++++ parser-typechecker/package.yaml | 1 + .../Codebase/SqliteCodebase/Migrations.hs | 13 +++- .../Migrations/MigrateHistoryComments.hs | 31 +++++---- .../Codebase/SqliteCodebase/Operations.hs | 1 + .../unison-parser-typechecker.cabal | 2 +- stack.yaml | 1 + unison-cli/unison-cli.cabal | 4 -- unison-core/package.yaml | 3 + .../src/Unison/Share/Types.hs | 0 unison-core/unison-core1.cabal | 6 +- 19 files changed, 175 insertions(+), 26 deletions(-) rename codebase2/codebase-sqlite/sql/{022-after-hash-history-comments.sql => 022-hash-history-comments-cleanup.sql} (89%) create mode 100644 lib/unison-credentials/package.yaml rename {unison-cli => lib/unison-credentials}/src/Unison/Auth/CredentialFile.hs (100%) rename {unison-cli => lib/unison-credentials}/src/Unison/Auth/CredentialManager.hs (100%) rename {unison-cli => lib/unison-credentials}/src/Unison/Auth/PersonalKey.hs (100%) rename {unison-cli => lib/unison-credentials}/src/Unison/Auth/Types.hs (100%) create mode 100644 lib/unison-credentials/unison-credentials.cabal rename {parser-typechecker => unison-core}/src/Unison/Share/Types.hs (100%) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 00d3bf779d..e3fc2f9f82 100644 --- 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-after-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql similarity index 89% rename from codebase2/codebase-sqlite/sql/022-after-hash-history-comments.sql rename to codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql index dd150ef48c..155565353f 100644 --- a/codebase2/codebase-sqlite/sql/022-after-hash-history-comments.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 index a9e5658967..69db004787 100644 --- 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 new file mode 100644 index 0000000000..e0d61e392a --- /dev/null +++ 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/unison-cli/src/Unison/Auth/CredentialFile.hs b/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs similarity index 100% rename from unison-cli/src/Unison/Auth/CredentialFile.hs rename to lib/unison-credentials/src/Unison/Auth/CredentialFile.hs diff --git a/unison-cli/src/Unison/Auth/CredentialManager.hs b/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs similarity index 100% rename from unison-cli/src/Unison/Auth/CredentialManager.hs rename to lib/unison-credentials/src/Unison/Auth/CredentialManager.hs diff --git a/unison-cli/src/Unison/Auth/PersonalKey.hs b/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs similarity index 100% rename from unison-cli/src/Unison/Auth/PersonalKey.hs rename to lib/unison-credentials/src/Unison/Auth/PersonalKey.hs diff --git a/unison-cli/src/Unison/Auth/Types.hs b/lib/unison-credentials/src/Unison/Auth/Types.hs similarity index 100% rename from unison-cli/src/Unison/Auth/Types.hs rename to lib/unison-credentials/src/Unison/Auth/Types.hs diff --git a/lib/unison-credentials/unison-credentials.cabal b/lib/unison-credentials/unison-credentials.cabal new file mode 100644 index 0000000000..799ddbea5e --- /dev/null +++ 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 index 2d5bc6a8af..b1c7918ea4 100644 --- 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 index 8b14c34e8c..efcc0cad5a 100644 --- 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,6 +46,7 @@ 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) -> @@ -51,7 +54,7 @@ migrations :: 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 index b4b7320110..fd88328f12 100644 --- 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 index 0e63d53fbd..42317ac54e 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs @@ -88,6 +88,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 index 228ed067cf..408ade4071 100644 --- 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 index d6da607377..268100affb 100644 --- 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 index a6e8f10d9c..a8327d8f6e 100644 --- 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.DirectoryUtils Unison.Cli.DownloadUtils diff --git a/unison-core/package.yaml b/unison-core/package.yaml index 3d2bb694e0..af06f1e5fe 100644 --- 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/parser-typechecker/src/Unison/Share/Types.hs b/unison-core/src/Unison/Share/Types.hs similarity index 100% rename from parser-typechecker/src/Unison/Share/Types.hs rename to unison-core/src/Unison/Share/Types.hs diff --git a/unison-core/unison-core1.cabal b/unison-core/unison-core1.cabal index f8e2a6715d..d9e8dcd20c 100644 --- a/unison-core/unison-core1.cabal +++ b/unison-core/unison-core1.cabal @@ -52,6 +52,7 @@ library Unison.Referent Unison.ReferentPrime Unison.Settings + Unison.Share.Types Unison.Symbol Unison.Term Unison.Type @@ -99,7 +100,8 @@ library ViewPatterns ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-signatures -funbox-strict-fields build-depends: - base + aeson + , base , bytestring , containers >=0.6.3 , cryptonite @@ -112,10 +114,12 @@ library , megaparsec , memory , mtl + , network-uri , nonempty-containers , rfc5051 , semialign , semigroups + , servant-client , text , text-builder , these From dbbbe9c40bda0776660f4716141e129487342799 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Nov 2025 11:35:21 -0800 Subject: [PATCH 18/30] Finish pulling out unison-credentials as a separate package --- lib/unison-credentials/package.yaml | 6 +++++- lib/unison-credentials/unison-credentials.cabal | 4 ++++ parser-typechecker/package.yaml | 2 -- .../src/Unison/Codebase/SqliteCodebase/Migrations.hs | 6 ++++-- parser-typechecker/unison-parser-typechecker.cabal | 2 -- unison-cli/package.yaml | 4 +--- unison-cli/unison-cli.cabal | 4 +--- 7 files changed, 15 insertions(+), 13 deletions(-) diff --git a/lib/unison-credentials/package.yaml b/lib/unison-credentials/package.yaml index e0d61e392a..5e8c0ffc68 100644 --- a/lib/unison-credentials/package.yaml +++ b/lib/unison-credentials/package.yaml @@ -8,16 +8,19 @@ dependencies: - base - aeson - containers + - filepath - jose - text - base64-bytestring - lens + - lock-file - memory - network-uri - time + - transformers - unison-core1 - unison-prelude - - lock-file + - unliftio library: source-dirs: src @@ -44,6 +47,7 @@ default-extensions: - LambdaCase - MultiParamTypeClasses - NamedFieldPuns + - OverloadedRecordDot - OverloadedStrings - PatternSynonyms - RankNTypes diff --git a/lib/unison-credentials/unison-credentials.cabal b/lib/unison-credentials/unison-credentials.cabal index 799ddbea5e..a761056db2 100644 --- a/lib/unison-credentials/unison-credentials.cabal +++ b/lib/unison-credentials/unison-credentials.cabal @@ -42,6 +42,7 @@ library LambdaCase MultiParamTypeClasses NamedFieldPuns + OverloadedRecordDot OverloadedStrings PatternSynonyms RankNTypes @@ -57,6 +58,7 @@ library , base , base64-bytestring , containers + , filepath , jose , lens , lock-file @@ -64,6 +66,8 @@ library , network-uri , text , time + , transformers , unison-core1 , unison-prelude + , unliftio default-language: Haskell2010 diff --git a/parser-typechecker/package.yaml b/parser-typechecker/package.yaml index b1c7918ea4..e4d973f45f 100644 --- a/parser-typechecker/package.yaml +++ b/parser-typechecker/package.yaml @@ -36,12 +36,10 @@ library: - mtl - murmur-hash - mutable-containers - - network-uri - nonempty-containers - pretty-simple - regex-tdfa - semialign - - servant-client - stm - text - these diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index efcc0cad5a..282cc28674 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -14,7 +14,6 @@ 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)) @@ -42,6 +41,8 @@ import Unison.Sqlite.Connection qualified as Sqlite.Connection import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty qualified as Pretty import UnliftIO qualified +import Unison.Auth.CredentialManager qualified as CredMan +import Unison.Auth.PersonalKey qualified as PK -- | 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. @@ -161,7 +162,8 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh Region.displayConsoleRegions do (`UnliftIO.finally` finalizeRegion) do - getOrCreatePersonalKey + credMan <- CredMan.newCredentialManager + keyThumbprint <- PK.personalKeyThumbprint <$> CredMan.getOrCreatePersonalKey credMan 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 diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 408ade4071..05f123a071 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -220,12 +220,10 @@ library , mtl , murmur-hash , mutable-containers - , network-uri , nonempty-containers , pretty-simple , regex-tdfa , semialign - , servant-client , stm , text , these diff --git a/unison-cli/package.yaml b/unison-cli/package.yaml index fc93fd7597..c71ac1474c 100644 --- a/unison-cli/package.yaml +++ b/unison-cli/package.yaml @@ -21,7 +21,6 @@ library: - ansi-terminal - attoparsec - base - - base64-bytestring - bytestring - cmark - co-log-core @@ -47,10 +46,8 @@ library: - http-client >= 0.7.6 - http-client-tls - http-types - - jose - ki - lens - - lock-file - lsp >= 2.2.0.0 - lsp-types >= 2.0.2.0 - megaparsec @@ -87,6 +84,7 @@ library: - unison-codebase-sqlite-hashing-v2 - unison-core - unison-core1 + - unison-credentials - unison-hash - unison-merge - unison-parser-typechecker diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index a8327d8f6e..a7935bcf16 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -220,7 +220,6 @@ library , ansi-terminal , attoparsec , base - , base64-bytestring , bytestring , cmark , co-log-core @@ -246,10 +245,8 @@ library , http-client >=0.7.6 , http-client-tls , http-types - , jose , ki , lens - , lock-file , lsp >=2.2.0.0 , lsp-types >=2.0.2.0 , megaparsec @@ -286,6 +283,7 @@ library , unison-codebase-sqlite-hashing-v2 , unison-core , unison-core1 + , unison-credentials , unison-hash , unison-merge , unison-parser-typechecker From 6b6a6eac56bc664e9b20db8d7ef2f5eb43f598f7 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Nov 2025 12:06:03 -0800 Subject: [PATCH 19/30] Retool Credential manager to use a singleton --- hie.yaml | 6 +- .../src/Unison/Auth/CredentialFile.hs | 27 ++++---- .../src/Unison/Auth/CredentialManager.hs | 63 +++++++++++-------- unison-cli/src/Unison/Auth/Tokens.hs | 2 +- .../Codebase/Editor/HandleInput/AuthLogin.hs | 4 +- 5 files changed, 58 insertions(+), 44 deletions(-) diff --git a/hie.yaml b/hie.yaml index 66cbd83fcd..cda2695c12 100644 --- a/hie.yaml +++ b/hie.yaml @@ -42,6 +42,10 @@ cradle: - path: "lib/unison-hashing/src" component: "unison-hashing:lib" + - path: "lib/unison-credentials/src" + component: "unison-credentials:lib" + + - path: "lib/unison-prelude/src" component: "unison-prelude:lib" @@ -98,7 +102,7 @@ cradle: - path: "parser-typechecker/tests" component: "unison-parser-typechecker:test:parser-typechecker-tests" - + - path: "unison-runtime/src" component: "unison-runtime:lib" diff --git a/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs b/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs index 1e746bd701..8db3323fb4 100644 --- a/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs +++ b/lib/unison-credentials/src/Unison/Auth/CredentialFile.hs @@ -6,7 +6,6 @@ import Data.Aeson qualified as Aeson import System.FilePath (takeDirectory, ()) import System.IO.LockFile import Unison.Auth.Types -import Unison.Debug qualified as Debug import Unison.Prelude import UnliftIO.Directory @@ -26,26 +25,26 @@ getCredentialJSONFilePath = do -- | Atomically update the credential storage file. -- Creates an empty file automatically if one doesn't exist. -atomicallyModifyCredentialsFile :: (MonadIO m) => (Credentials -> Credentials) -> m Credentials -atomicallyModifyCredentialsFile f = liftIO $ do - credentialJSONPath <- getCredentialJSONFilePath - doesFileExist credentialJSONPath >>= \case +atomicallyModifyCredentialsFile :: (MonadUnliftIO m) => (Credentials -> m (Credentials, r)) -> m r +atomicallyModifyCredentialsFile f = do + credentialJSONPath <- liftIO $ getCredentialJSONFilePath + liftIO (doesFileExist credentialJSONPath) >>= \case True -> pure () - False -> do + False -> liftIO $ do createDirectoryIfMissing True $ takeDirectory credentialJSONPath Aeson.encodeFile credentialJSONPath emptyCredentials - withLockFile lockfileConfig (withLockExt credentialJSONPath) $ do + toIO <- askRunInIO + liftIO $ withLockFile lockfileConfig (withLockExt credentialJSONPath) $ toIO $ do credentials <- - Aeson.eitherDecodeFileStrict credentialJSONPath >>= \case + liftIO (Aeson.eitherDecodeFileStrict credentialJSONPath) >>= \case -- If something goes wrong, just wipe the credentials file so we're in a clean slate. -- In the worst case the user will simply need to log in again. - Left err -> do - Debug.debugM Debug.Auth "Error decoding credentials file" err - Aeson.encodeFile credentialJSONPath emptyCredentials + Left _err -> do + liftIO $ Aeson.encodeFile credentialJSONPath emptyCredentials pure emptyCredentials Right creds -> pure creds - let newCredentials = f credentials + (newCredentials, r) <- f credentials when (newCredentials /= credentials) $ do - Aeson.encodeFile credentialJSONPath $ newCredentials - pure newCredentials + liftIO $ Aeson.encodeFile credentialJSONPath newCredentials + pure r diff --git a/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs b/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs index 8a370b6f73..fafb56b46b 100644 --- a/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs +++ b/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs @@ -4,7 +4,7 @@ module Unison.Auth.CredentialManager ( saveCredentials, CredentialManager, newCredentialManager, - getCredentials, + getCodeserverCredentials, getOrCreatePersonalKey, isExpired, ) @@ -13,9 +13,11 @@ where import Control.Monad.Trans.Except import Data.Map qualified as Map import Data.Time.Clock (addUTCTime, diffUTCTime, getCurrentTime) -import Unison.Auth.CredentialFile +import System.IO.Unsafe (unsafePerformIO) +import Unison.Auth.CredentialFile qualified as CF import Unison.Auth.PersonalKey (PersonalPrivateKey, generatePersonalKey) -import Unison.Auth.Types +import Unison.Auth.Types hiding (getCodeserverCredentials) +import Unison.Auth.Types qualified as Auth import Unison.Prelude import Unison.Share.Types (CodeserverId) import UnliftIO qualified @@ -25,46 +27,55 @@ import UnliftIO qualified -- Note: Currently the in-memory cache is _not_ updated if a different UCM updates -- the credentials file, however this shouldn't pose any problems, since auth will still -- be refreshed if we encounter any auth failures on requests. -newtype CredentialManager = CredentialManager (UnliftIO.MVar Credentials) +newtype CredentialManager = CredentialManager (UnliftIO.MVar (Maybe Credentials {- Credentials may or may not be initialized -})) + +-- | A global CredentialManager instance/singleton. +globalCredentialsManager :: CredentialManager +globalCredentialsManager = unsafePerformIO do + CredentialManager <$> UnliftIO.newMVar Nothing +{-# NOINLINE globalCredentialsManager #-} -- | Fetches the user's personal key from the active profile, if it exists. -- Otherwise it creates a new personal key, saves it to the active profile, and returns it. getOrCreatePersonalKey :: (MonadUnliftIO m) => CredentialManager -> m PersonalPrivateKey -getOrCreatePersonalKey credMan@(CredentialManager credsVar) = do - Credentials {activeProfile, personalKeys} <- liftIO (UnliftIO.readMVar credsVar) - case Map.lookup activeProfile personalKeys of - Just pk -> pure pk - Nothing -> do - pk <- generatePersonalKey - _ <- modifyCredentials credMan $ \creds -> - creds {personalKeys = Map.insert activeProfile pk creds.personalKeys} - pure pk +getOrCreatePersonalKey credMan = do + modifyCredentials credMan \creds@(Credentials {activeProfile, personalKeys}) -> do + case Map.lookup activeProfile personalKeys of + Just pk -> pure (creds, pk) + Nothing -> do + pk <- generatePersonalKey + pure (creds {personalKeys = Map.insert activeProfile pk personalKeys}, pk) -- | Saves credentials to the active profile. saveCredentials :: (UnliftIO.MonadUnliftIO m) => CredentialManager -> CodeserverId -> CodeserverCredentials -> m () saveCredentials credManager aud creds = do - void . modifyCredentials credManager $ setCodeserverCredentials aud creds + void . modifyCredentials credManager $ \cf -> pure (setCodeserverCredentials aud creds cf, ()) -- | Atomically update the credential storage file, and update the in-memory cache. -modifyCredentials :: (UnliftIO.MonadUnliftIO m) => CredentialManager -> (Credentials -> Credentials) -> m Credentials +modifyCredentials :: (UnliftIO.MonadUnliftIO m) => CredentialManager -> (Credentials -> m (Credentials, r)) -> m r modifyCredentials (CredentialManager credsVar) f = do UnliftIO.modifyMVar credsVar $ \_ -> do - newCreds <- atomicallyModifyCredentialsFile f - pure (newCreds, newCreds) + (creds, r) <- CF.atomicallyModifyCredentialsFile (f >=> \(creds', r') -> pure (creds', (creds', r'))) + pure (Just creds, r) + +readCredentials :: (UnliftIO.MonadUnliftIO m) => CredentialManager -> m Credentials +readCredentials (CredentialManager credsVar) = do + UnliftIO.modifyMVar credsVar $ \mayCreds -> case mayCreds of + Just creds -> pure (mayCreds, creds) + Nothing -> do + creds <- CF.atomicallyModifyCredentialsFile \c -> pure (c, c) + pure (Just creds, creds) -getCredentials :: (MonadIO m) => CredentialManager -> CodeserverId -> m (Either CredentialFailure CodeserverCredentials) -getCredentials (CredentialManager credsVar) aud = runExceptT do - creds <- lift (UnliftIO.readMVar credsVar) - codeserverCreds <- except (getCodeserverCredentials aud creds) +getCodeserverCredentials :: (MonadIO m) => CredentialManager -> CodeserverId -> m (Either CredentialFailure CodeserverCredentials) +getCodeserverCredentials credMan aud = runExceptT do + creds <- liftIO $ readCredentials credMan + codeserverCreds <- except (Auth.getCodeserverCredentials aud creds) lift (isExpired codeserverCreds) >>= \case True -> throwE (ReauthRequired aud) False -> pure codeserverCreds -newCredentialManager :: (MonadIO m) => m CredentialManager -newCredentialManager = do - credentials <- atomicallyModifyCredentialsFile id - credentialsVar <- UnliftIO.newMVar credentials - pure (CredentialManager credentialsVar) +newCredentialManager :: CredentialManager +newCredentialManager = globalCredentialsManager -- | Checks whether CodeserverCredentials are expired. isExpired :: (MonadIO m) => CodeserverCredentials -> m Bool diff --git a/unison-cli/src/Unison/Auth/Tokens.hs b/unison-cli/src/Unison/Auth/Tokens.hs index be86430abf..4e122905c9 100644 --- a/unison-cli/src/Unison/Auth/Tokens.hs +++ b/unison-cli/src/Unison/Auth/Tokens.hs @@ -37,7 +37,7 @@ newTokenProvider manager host = UnliftIO.try @_ @CredentialFailure $ do -- If the access token is provided via environment variable, we don't need to refresh it. pure accessToken Nothing -> do - creds@CodeserverCredentials {tokens, discoveryURI} <- throwEitherM $ getCredentials manager host + creds@CodeserverCredentials {tokens, discoveryURI} <- throwEitherM $ getCodeserverCredentials manager host let Tokens {accessToken = currentAccessToken} = tokens expired <- isExpired creds if expired diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AuthLogin.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AuthLogin.hs index 3fd6860a38..0ab2ce335e 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/AuthLogin.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/AuthLogin.hs @@ -23,7 +23,7 @@ import Network.Wai import Network.Wai qualified as Wai import Network.Wai.Handler.Warp qualified as Warp import U.Codebase.Sqlite.Queries qualified as Q -import Unison.Auth.CredentialManager (getCredentials, saveCredentials) +import Unison.Auth.CredentialManager (getCodeserverCredentials, saveCredentials) import Unison.Auth.Discovery (discoveryURIForCodeserver, fetchDiscoveryDoc) import Unison.Auth.Types ( Code, @@ -55,7 +55,7 @@ ucmOAuthClientID = "ucm" ensureAuthenticatedWithCodeserver :: CodeserverURI -> Cli UserInfo ensureAuthenticatedWithCodeserver codeserverURI = do Cli.Env {credentialManager} <- ask - getCredentials credentialManager (codeserverIdFromCodeserverURI codeserverURI) >>= \case + getCodeserverCredentials credentialManager (codeserverIdFromCodeserverURI codeserverURI) >>= \case Right (CodeserverCredentials {userInfo}) -> pure userInfo Left _ -> authLogin codeserverURI From da98679fadcf4788c413741f2064d527ca3a40fc Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Nov 2025 12:34:50 -0800 Subject: [PATCH 20/30] Propagate Credential File changes --- .../src/Unison/Auth/CredentialManager.hs | 11 ++++------- .../src/Unison/Codebase/SqliteCodebase/Migrations.hs | 2 +- unison-cli/src/Unison/Auth/Tokens.hs | 3 ++- unison-cli/src/Unison/Codebase/Transcript/Runner.hs | 2 +- unison-cli/src/Unison/MCP/Cli.hs | 2 +- unison-cli/src/Unison/Main.hs | 8 ++++---- 6 files changed, 13 insertions(+), 15 deletions(-) diff --git a/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs b/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs index fafb56b46b..c3c5b434e1 100644 --- a/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs +++ b/lib/unison-credentials/src/Unison/Auth/CredentialManager.hs @@ -3,7 +3,7 @@ module Unison.Auth.CredentialManager ( saveCredentials, CredentialManager, - newCredentialManager, + globalCredentialManager, getCodeserverCredentials, getOrCreatePersonalKey, isExpired, @@ -30,10 +30,10 @@ import UnliftIO qualified newtype CredentialManager = CredentialManager (UnliftIO.MVar (Maybe Credentials {- Credentials may or may not be initialized -})) -- | A global CredentialManager instance/singleton. -globalCredentialsManager :: CredentialManager -globalCredentialsManager = unsafePerformIO do +globalCredentialManager :: CredentialManager +globalCredentialManager = unsafePerformIO do CredentialManager <$> UnliftIO.newMVar Nothing -{-# NOINLINE globalCredentialsManager #-} +{-# NOINLINE globalCredentialManager #-} -- | Fetches the user's personal key from the active profile, if it exists. -- Otherwise it creates a new personal key, saves it to the active profile, and returns it. @@ -74,9 +74,6 @@ getCodeserverCredentials credMan aud = runExceptT do True -> throwE (ReauthRequired aud) False -> pure codeserverCreds -newCredentialManager :: CredentialManager -newCredentialManager = globalCredentialsManager - -- | Checks whether CodeserverCredentials are expired. isExpired :: (MonadIO m) => CodeserverCredentials -> m Bool isExpired CodeserverCredentials {fetchTime, tokens = Tokens {expiresIn}} = liftIO do diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 282cc28674..8484081866 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -162,7 +162,7 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh Region.displayConsoleRegions do (`UnliftIO.finally` finalizeRegion) do - credMan <- CredMan.newCredentialManager + let credMan = CredMan.globalCredentialManager keyThumbprint <- PK.personalKeyThumbprint <$> CredMan.getOrCreatePersonalKey credMan let migs = migrations keyThumbprint regionVar getDeclType termBuffer declBuffer root -- The highest schema that this ucm knows how to migrate to. diff --git a/unison-cli/src/Unison/Auth/Tokens.hs b/unison-cli/src/Unison/Auth/Tokens.hs index 4e122905c9..3c5837f106 100644 --- a/unison-cli/src/Unison/Auth/Tokens.hs +++ b/unison-cli/src/Unison/Auth/Tokens.hs @@ -10,6 +10,7 @@ import Network.HTTP.Client.TLS qualified as HTTP import Network.HTTP.Types qualified as Network import System.Environment (lookupEnv) import Unison.Auth.CredentialManager +import Unison.Auth.CredentialManager qualified as CredMan import Unison.Auth.Discovery (fetchDiscoveryDoc) import Unison.Auth.Types import Unison.Auth.UserInfo (getUserInfo) @@ -37,7 +38,7 @@ newTokenProvider manager host = UnliftIO.try @_ @CredentialFailure $ do -- If the access token is provided via environment variable, we don't need to refresh it. pure accessToken Nothing -> do - creds@CodeserverCredentials {tokens, discoveryURI} <- throwEitherM $ getCodeserverCredentials manager host + creds@CodeserverCredentials {tokens, discoveryURI} <- throwEitherM $ CredMan.getCodeserverCredentials manager host let Tokens {accessToken = currentAccessToken} = tokens expired <- isExpired creds if expired diff --git a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs index bc12d089ba..cc58f179a6 100644 --- a/unison-cli/src/Unison/Codebase/Transcript/Runner.hs +++ b/unison-cli/src/Unison/Codebase/Transcript/Runner.hs @@ -96,7 +96,7 @@ withRunner :: (Runner -> m r) -> m r withRunner isTest verbosity ucmVersion action = do - credMan <- AuthN.newCredentialManager + let credMan = AuthN.globalCredentialManager authenticatedHTTPClient <- initTranscriptAuthenticatedHTTPClient credMan -- If we're in a transcript test, configure the environment to use a non-existent fzf binary diff --git a/unison-cli/src/Unison/MCP/Cli.hs b/unison-cli/src/Unison/MCP/Cli.hs index 0a0ea51ffa..b660d22053 100644 --- a/unison-cli/src/Unison/MCP/Cli.hs +++ b/unison-cli/src/Unison/MCP/Cli.hs @@ -107,7 +107,7 @@ cliToMCP projCtx onError cli = do MCP.Env {ucmVersion, codebase, runtime, workDir} <- ask initialPP <- ExceptT . liftIO $ Codebase.runTransactionExceptT codebase $ do ppForProjectContext projCtx - credMan <- AuthN.newCredentialManager + let credMan = AuthN.globalCredentialManager let tokenProvider :: AuthN.TokenProvider tokenProvider = AuthN.newTokenProvider credMan authenticatedHTTPClient <- AuthN.newAuthenticatedHTTPClient tokenProvider ucmVersion diff --git a/unison-cli/src/Unison/Main.hs b/unison-cli/src/Unison/Main.hs index 37467c83b7..b37ebd4934 100644 --- a/unison-cli/src/Unison/Main.hs +++ b/unison-cli/src/Unison/Main.hs @@ -147,7 +147,7 @@ main version = do Text.putStrLn $ Text.pack progName <> " version: " <> Version.gitDescribeWithDate version MCPServer -> do let ucmVersion = Version.gitDescribeWithDate version - credMan <- AuthN.newCredentialManager + let credMan = AuthN.globalCredentialManager authenticatedHTTPClient <- initTranscriptAuthenticatedHTTPClient ucmVersion credMan getCodebaseOrExit mCodePathOption SC.DontLock (SC.MigrateAfterPrompt SC.Backup SC.Vacuum) \(_initRes, _, theCodebase) -> do withRuntimes RTI.Persistent \(runtime, sbRuntime) -> do @@ -183,7 +183,7 @@ main version = do let noOpCheckForChanges _ = pure () let serverUrl = Nothing let ucmVersion = Version.gitDescribeWithDate version - credMan <- liftIO $ AuthN.newCredentialManager + let credMan = AuthN.globalCredentialManager authenticatedHTTPClient <- initTranscriptAuthenticatedHTTPClient ucmVersion credMan startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch @@ -211,7 +211,7 @@ main version = do let noOpCheckForChanges _ = pure () let serverUrl = Nothing let ucmVersion = Version.gitDescribeWithDate version - credMan <- liftIO $ AuthN.newCredentialManager + let credMan = AuthN.globalCredentialManager authenticatedHTTPClient <- initTranscriptAuthenticatedHTTPClient ucmVersion credMan startProjectPath <- Codebase.runTransaction theCodebase Codebase.expectCurrentProjectPath launch @@ -328,7 +328,7 @@ main version = do void . Ki.fork scope $ LSP.spawnLsp lspFormattingConfig theCodebase runtime changeSignal let isTest = False let ucmVersion = Version.gitDescribeWithDate version - credMan <- liftIO $ AuthN.newCredentialManager + let credMan = AuthN.globalCredentialManager authenticatedHTTPClient <- initTranscriptAuthenticatedHTTPClient ucmVersion credMan mcpServerConfig <- MCP.initServer theCodebase runtime sbRuntime (Just currentDir) ucmVersion authenticatedHTTPClient Server.startServer From e6800274e144734ab442b6f17465867b3e7061dc Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 12 Nov 2025 12:44:36 -0800 Subject: [PATCH 21/30] Fix up hash migration errors It seems to work now. --- .../U/Codebase/Sqlite/Queries.hs | 48 +++++++++++++------ .../sql/021-hash-history-comments.sql | 4 +- .../sql/022-hash-history-comments-cleanup.sql | 41 ++++++++-------- lib/unison-sqlite/src/Unison/Sqlite/Utils.hs | 5 +- lib/unison-sqlite/unison-sqlite.cabal | 2 +- .../Codebase/SqliteCodebase/Migrations.hs | 4 +- .../Migrations/MigrateHistoryComments.hs | 31 ++++++++---- 7 files changed, 86 insertions(+), 49 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index e3fc2f9f82..50ec3a8c6d 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE TemplateHaskell #-} -- | Some naming conventions used in this module: @@ -301,7 +302,7 @@ module U.Codebase.Sqlite.Queries setConfigValue, -- * Personal Keys - expectPersonalKeyThumbprintId, + ensurePersonalKeyThumbprintId, -- * Types TextPathSegments, @@ -335,6 +336,7 @@ 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 (..)) @@ -451,7 +453,7 @@ type TextPathSegments = [Text] -- * main squeeze currentSchemaVersion :: SchemaVersion -currentSchemaVersion = 25 +currentSchemaVersion = 26 runCreateSql :: Transaction () runCreateSql = @@ -4159,33 +4161,49 @@ 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 (LatestHistoryComment KeyThumbprintId CausalHash HistoryCommentRevisionId HistoryCommentHash)) getLatestCausalComment causalHashId = - queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, HistoryCommentRevisionId, Text, Text, Time.UTCTime) + queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, Int64, HistoryCommentRevisionId, Text, Text, Int64) [sql| - SELECT comment_hash.base32, causal_hash.base32, cc.author, cc.author_thumbprint_id, ccr.id, ccr.subject, ccr.contents, ccr.created_at + SELECT comment_hash.base32, causal_hash.base32, cc.author, cc.author_thumbprint_id, cc.created_at_ms, ccr.id, ccr.subject, ccr.contents, 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 \(commentHash, causalHash, author, authorThumbprint, revisionId, subject, content, createdAt) -> + <&> fmap \(commentHash, causalHash, author, authorThumbprint, commentCreatedAtMs, revisionId, subject, content, revisionCreatedAtMs) -> HistoryCommentRevision { subject, content, - createdAt, + createdAt = millisToUTCTime revisionCreatedAtMs, revisionId, comment = HistoryComment { author, authorThumbprint, causal = CausalHash . Hash32.toHash $ causalHash, - createdAt, + createdAt = millisToUTCTime commentCreatedAtMs, commentId = HistoryCommentHash . Hash32.toHash $ commentHash } } @@ -4200,7 +4218,7 @@ commentOnCausal } = do commentHashId <- saveHistoryCommentHash commentHash commentRevisionHashId <- saveHistoryCommentRevisionHash commentRevisionHash - thumbprintId <- expectPersonalKeyThumbprintId authorThumbprint + thumbprintId <- ensurePersonalKeyThumbprintId authorThumbprint mayExistingCommentId <- queryMaybeCol @HistoryCommentId [sql| @@ -4208,19 +4226,21 @@ commentOnCausal FROM history_comments WHERE causal_hash_id = :causalHashId |] + 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) - VALUES (:commentHashId, :thumbprintId, :author, :causalHashId, strftime('%s', 'now', 'subsec')) + 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 (revision_hash_id, comment_id, subject, contents, created_at) - VALUES (:commentRevisionHashId, :commentId, :subject, :content, strftime('%s', 'now', 'subsec')) + VALUES (:commentRevisionHashId, :commentId, :subject, :content, :createdAtMs) |] getAuthorName :: Transaction (Maybe AuthorName) @@ -4254,8 +4274,8 @@ getConfigValue key = |] -- | Save or return the id for a given key thumbprint -expectPersonalKeyThumbprintId :: KeyThumbprint -> Transaction KeyThumbprintId -expectPersonalKeyThumbprintId thumbprint = do +ensurePersonalKeyThumbprintId :: KeyThumbprint -> Transaction KeyThumbprintId +ensurePersonalKeyThumbprintId thumbprint = do let thumbprintText = thumbprintToText thumbprint mayExisting <- queryMaybeCol diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql index fc71792fbc..8dab37bb08 100644 --- a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -7,7 +7,7 @@ CREATE TABLE IF NOT EXISTS key_thumbprints ( ALTER TABLE history_comments -- The hash used for comment identity. - -- It's the hash of (causal_hash <> author <> created_at) + -- 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 @@ -18,7 +18,7 @@ ALTER TABLE history_comments 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) + -- It's the hash of (comment_hash <> subject <> contents <> hidden <> created_at_ms) ADD COLUMN revision_hash_id INTEGER NULL REFERENCES hash(id); CREATE UNIQUE INDEX IF NOT EXISTS idx_history_comment_revisions_revision_hash_id diff --git a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql index 155565353f..076fac0ca8 100644 --- a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql +++ b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql @@ -3,29 +3,35 @@ CREATE TABLE history_comments_new ( id INTEGER PRIMARY KEY, - causal_hash_id INTEGER REFERENCES hash(id) NOT NULL, + causal_hash_id INTEGER NOT NULL REFERENCES hash(id), author TEXT NOT NULL, -- Remember that SQLITE doesn't have any actual 'time' type, - -- This column contains float values constructed - -- using strftime('%s', 'now', 'subsec') - created_at TEXT NOT NULL, + -- This column contains the number of milliseconds since epoch + -- as an integer. + created_at_ms INTEGER NOT NULL, comment_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id), author_thumbprint_id INTEGER NOT NULL REFERENCES key_thumbprints(id) ); +-- Copy data from old tables to new tables. +-- We convert the created_at to created_at_ms by multiplying by 1000 and casting to INTEGER. +INSERT INTO history_comments_new (id, causal_hash_id, author, created_at_ms, comment_hash_id, author_thumbprint_id) + SELECT id, causal_hash_id, author, CAST((created_at * 1000) AS INTEGER), comment_hash_id, author_thumbprint_id + FROM history_comments; +-- Now do the revisions CREATE TABLE history_comment_revisions_new ( id INTEGER PRIMARY KEY, - comment_id INTEGER REFERENCES history_comments(id), + comment_id INTEGER NOT NULL REFERENCES history_comments_new(id), subject TEXT NOT NULL, contents TEXT NOT NULL, -- Remember that SQLITE doesn't have any actual 'time' type, - -- This column contains float values constructed - -- using strftime('%s', 'now', 'subsec') - created_at TEXT NOT NULL, + -- This column contains the number of milliseconds since epoch + -- as an integer. + created_at_ms INTEGER NOT NULL, -- - In a distributed system you really can’t ever truly delete comments, -- but you can ask to hide them. @@ -34,23 +40,18 @@ CREATE TABLE history_comment_revisions_new ( revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id) ); - --- 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) - SELECT id, causal_hash_id, author, created_at, comment_hash_id, author_thumbprint_id - FROM history_comments; - -INSERT INTO history_comment_revisions_new (id, comment_id, subject, contents, created_at, hidden, revision_hash_id) - SELECT id, comment_id, subject, contents, created_at, hidden, revision_hash_id +-- We convert the created_at to created_at_ms by multiplying by 1000 and casting to INTEGER. +INSERT INTO history_comment_revisions_new (id, comment_id, subject, contents, created_at_ms, hidden, revision_hash_id) + SELECT id, comment_id, subject, contents, CAST((created_at * 1000) AS INTEGER), hidden, revision_hash_id FROM history_comment_revisions; -- Drop old tables -DROP TABLE history_comments; DROP TABLE history_comment_revisions; +DROP TABLE history_comments; --- Rename new tables to old table names +-- Rename new tables to original 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); +CREATE INDEX history_comments_by_causal_hash_id ON history_comments(causal_hash_id, created_at_ms DESC); +CREATE INDEX history_comment_revisions_by_comment_id_and_created_at_ms ON history_comment_revisions(comment_id, created_at_ms DESC); diff --git a/lib/unison-sqlite/src/Unison/Sqlite/Utils.hs b/lib/unison-sqlite/src/Unison/Sqlite/Utils.hs index 84744b56b0..21f237041b 100644 --- a/lib/unison-sqlite/src/Unison/Sqlite/Utils.hs +++ b/lib/unison-sqlite/src/Unison/Sqlite/Utils.hs @@ -1,4 +1,7 @@ -module Unison.Sqlite.Utils (likeEscape) where +module Unison.Sqlite.Utils + ( likeEscape, + ) +where import Data.Text (Text) import Data.Text qualified as Text diff --git a/lib/unison-sqlite/unison-sqlite.cabal b/lib/unison-sqlite/unison-sqlite.cabal index 9bd012a20b..43388a8484 100644 --- a/lib/unison-sqlite/unison-sqlite.cabal +++ b/lib/unison-sqlite/unison-sqlite.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0. +-- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 8484081866..3789d14e18 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -14,6 +14,8 @@ 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 qualified as CredMan +import Unison.Auth.PersonalKey qualified as PK import Unison.Codebase (CodebasePath) import Unison.Codebase.Init (BackupStrategy (..), VacuumStrategy (..)) import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (OpenCodebaseUnknownSchemaVersion)) @@ -41,8 +43,6 @@ import Unison.Sqlite.Connection qualified as Sqlite.Connection import Unison.Util.Monoid (foldMapM) import Unison.Util.Pretty qualified as Pretty import UnliftIO qualified -import Unison.Auth.CredentialManager qualified as CredMan -import Unison.Auth.PersonalKey qualified as PK -- | 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. diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs index fd88328f12..9259ff4941 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs @@ -1,9 +1,11 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} module Unison.Codebase.SqliteCodebase.Migrations.MigrateHistoryComments (hashHistoryCommentsMigration) where import Data.Time (UTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import U.Codebase.HashTags import U.Codebase.Sqlite.DbId (HistoryCommentId (..), HistoryCommentRevisionId (HistoryCommentRevisionId)) import U.Codebase.Sqlite.Orphans (AsSqlite (..)) @@ -16,6 +18,15 @@ import Unison.KeyThumbprint (KeyThumbprint) import Unison.Prelude import Unison.Sqlite qualified as Sqlite +-- Convert milliseconds since epoch to UTCTime _exactly_. +-- UTCTime has picosecond precision so this is lossless. +millisToUTCTime :: Int64 -> UTCTime +millisToUTCTime ms = + toRational ms + & (/ (1_000 :: Rational)) + & fromRational + & posixSecondsToUTCTime + -- | 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 :: KeyThumbprint -> Sqlite.Transaction () @@ -26,19 +37,20 @@ hashHistoryCommentsMigration defaultKeyThumbprint = do hashAllHistoryComments :: KeyThumbprint -> Sqlite.Transaction () hashAllHistoryComments defaultKeyThumbprint = do + keyThumbprintId <- Q.ensurePersonalKeyThumbprintId defaultKeyThumbprint historyComments <- - Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, UTCTime) + Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, Int64) [Sqlite.sql| - SELECT comment.id, causal_hash.base32, comment.author, thumbprint.thumbprint, comment.created_at + SELECT comment.id, causal_hash.base32, comment.author, CAST(comment.created_at * 1000 AS INTEGER) FROM history_comments comment JOIN hash causal_hash ON comment.causal_hash_id = causal_hash.id |] Debug.debugM Debug.Temp "Got comments" historyComments - for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, createdAt) -> do + for_ historyComments $ \(HistoryCommentId commentId, causalHash, author, createdAtMs) -> do let historyComment = HistoryComment { author, - createdAt, + createdAt = millisToUTCTime createdAtMs, authorThumbprint = defaultKeyThumbprint, causal = coerce @_ @CausalHash causalHash, commentId = () @@ -49,25 +61,26 @@ hashAllHistoryComments defaultKeyThumbprint = do Sqlite.execute [Sqlite.sql| UPDATE history_comments - SET comment_hash_id = :historyCommentHashId + SET comment_hash_id = :historyCommentHashId, + author_thumbprint_id = :keyThumbprintId WHERE id = :commentId |] historyCommentRevisions <- - Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, UTCTime, AsSqlite Hash) + Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, Int64, AsSqlite Hash) [Sqlite.sql| - SELECT hcr.id, hcr.subject, hcr.contents, hcr.created_at, comment_hash.base32 + SELECT hcr.id, hcr.subject, hcr.contents, CAST(hcr.created_at * 1000 AS INTEGER), comment_hash.base32 FROM history_comment_revisions hcr 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 + for_ historyCommentRevisions $ \(HistoryCommentRevisionId revisionId, subject, content, createdAtMs, commentHash) -> do Debug.debugM Debug.Temp "Hashing history comment revision" (subject, content) let historyCommentRevision = HistoryCommentRevision { subject, content, - createdAt, + createdAt = millisToUTCTime createdAtMs, comment = coerce @_ @HistoryCommentHash commentHash, revisionId = () } From c9c6eb158f24fd4237855e3c76f0e8cf6284ed6e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 14:47:24 -0800 Subject: [PATCH 22/30] Add signature creation and verification for Personal Keys. --- lib/unison-credentials/package.yaml | 3 ++ .../src/Unison/Auth/PersonalKey.hs | 45 ++++++++++++++++++- .../unison-credentials.cabal | 3 ++ 3 files changed, 49 insertions(+), 2 deletions(-) diff --git a/lib/unison-credentials/package.yaml b/lib/unison-credentials/package.yaml index 5e8c0ffc68..6eac81cfcf 100644 --- a/lib/unison-credentials/package.yaml +++ b/lib/unison-credentials/package.yaml @@ -7,7 +7,9 @@ ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-missing-pattern-synonym-si dependencies: - base - aeson + - bytestring - containers + - crypton - filepath - jose - text @@ -15,6 +17,7 @@ dependencies: - lens - lock-file - memory + - mtl - network-uri - time - transformers diff --git a/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs b/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs index 09442d3609..350f9397ff 100644 --- a/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs +++ b/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs @@ -11,18 +11,27 @@ module Unison.Auth.PersonalKey ( PersonalPrivateKey, encodePrivateKey, PersonalPublicKey, + publicKey, generatePersonalKey, personalKeyThumbprint, + signWithPersonalKey, + verifyWithPersonalKey, ) where +import Control.Monad.Error.Class +import Control.Monad.Trans.Except +import Crypto.JOSE qualified as JOSE +import Crypto.JOSE.JWA.JWK qualified as JWA import Crypto.JOSE.JWK (JWK, KeyMaterialGenParam (OKPGenParam), OKPCrv (Ed25519), genJWK) import Crypto.JOSE.JWK qualified as JWK import Crypto.JOSE.JWS qualified as JWS +import Crypto.Random import Data.Aeson (ToJSON) import Data.Aeson qualified as Aeson import Data.Aeson.Types (Value) import Data.ByteArray qualified as ByteArray +import Data.ByteString qualified as BS import Data.ByteString.Base64.URL qualified as Base64URL import Data.Text.Encoding qualified as Text import Unison.KeyThumbprint (KeyThumbprint (..)) @@ -51,8 +60,8 @@ jwkThumbprint jwk = encodePrivateKey :: PersonalPrivateKey -> Value encodePrivateKey (PersonalPrivateKey jwk) = Aeson.toJSON jwk -_publicKey :: PersonalPrivateKey -> PersonalPublicKey -_publicKey (PersonalPrivateKey jwk) = case (jwk ^. JWK.asPublicKey) of +publicKey :: PersonalPrivateKey -> PersonalPublicKey +publicKey (PersonalPrivateKey jwk) = case (jwk ^. JWK.asPublicKey) of Just public -> PersonalPublicKey public Nothing -> error "publicKey: Failed to extract public key from private key. This should never happen." @@ -67,3 +76,35 @@ generatePersonalKey = liftIO $ do <&> JWK.jwkAlg .~ Just (JWK.JWSAlg JWS.EdDSA) <&> (\j -> j & JWK.jwkKid .~ Just (thumbprintToText $ jwkThumbprint j)) <&> PersonalPrivateKey + +newtype PersonalKeySignature = PersonalKeySignature {unPersonalKeySignature :: ByteString} + deriving (Show, Eq) + +-- | For some reason `sign` and `verify` require a single monad which implements both MonadRandom and MonadError, +-- but ExceptT doesn't implement MonadRandom :| +newtype SignM a = SignM {_unSignM :: ExceptT JOSE.Error IO a} + deriving newtype (Functor, Applicative, Monad, MonadIO, MonadError JOSE.Error) + +runSignM :: (MonadIO m) => SignM a -> m (Either JOSE.Error a) +runSignM (SignM e) = liftIO $ runExceptT e + +instance MonadRandom SignM where + getRandomBytes n = SignM . liftIO $ getRandomBytes n + +-- | Sign arbitrary bytes using a personal private key +-- +-- >>> key <- generatePersonalKey +-- >>> let msg = "Hello, world!" +-- >>> signature <- fromRight (error "failed to sign") <$> signWithPersonalKey key msg +-- >>> verifyWithPersonalKey (publicKey key) msg signature +-- True +signWithPersonalKey :: (MonadIO m) => PersonalPrivateKey -> BS.ByteString -> m (Either JOSE.Error PersonalKeySignature) +signWithPersonalKey (PersonalPrivateKey jwk) bytes = runSignM $ do + PersonalKeySignature <$> (JWA.sign @SignM JWS.EdDSA (jwk ^. JWS.jwkMaterial) bytes) + +-- | Verify a signature made with a personal private key +verifyWithPersonalKey :: (MonadIO m) => PersonalPublicKey -> BS.ByteString -> PersonalKeySignature -> m Bool +verifyWithPersonalKey (PersonalPublicKey jwk) bytes (PersonalKeySignature signature) = + (JWA.verify @JOSE.Error @SignM JWS.EdDSA (jwk ^. JWS.jwkMaterial) bytes signature) + & runSignM + <&> fromRight False diff --git a/lib/unison-credentials/unison-credentials.cabal b/lib/unison-credentials/unison-credentials.cabal index a761056db2..a209064b74 100644 --- a/lib/unison-credentials/unison-credentials.cabal +++ b/lib/unison-credentials/unison-credentials.cabal @@ -57,12 +57,15 @@ library aeson , base , base64-bytestring + , bytestring , containers + , crypton , filepath , jose , lens , lock-file , memory + , mtl , network-uri , text , time From d42838700a29f10b5a062a4a67dd2484b780e6ab Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 14:47:24 -0800 Subject: [PATCH 23/30] Add author signature --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 9 ++++++--- .../sql/022-hash-history-comments-cleanup.sql | 3 +++ unison-core/src/Unison/HistoryComment.hs | 3 +++ 3 files changed, 12 insertions(+), 3 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index 50ec3a8c6d..c007ef1c67 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -4181,9 +4181,10 @@ getLatestCausalComment :: CausalHashId -> Transaction (Maybe (LatestHistoryComment KeyThumbprintId CausalHash HistoryCommentRevisionId HistoryCommentHash)) getLatestCausalComment causalHashId = - queryMaybeRow @(Hash32, Hash32, Text, KeyThumbprintId, Int64, HistoryCommentRevisionId, Text, Text, Int64) + -- 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 comment_hash.base32, causal_hash.base32, cc.author, cc.author_thumbprint_id, cc.created_at_ms, ccr.id, ccr.subject, ccr.contents, ccr.created_at_ms + 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 @@ -4192,12 +4193,14 @@ getLatestCausalComment causalHashId = ORDER BY ccr.created_at_ms DESC LIMIT 1 |] - <&> fmap \(commentHash, causalHash, author, authorThumbprint, commentCreatedAtMs, revisionId, subject, content, revisionCreatedAtMs) -> + <&> fmap \((commentHash, causalHash, author, authorThumbprint, commentCreatedAtMs, revisionId, subject, content, isHidden) :. (authorSignature, revisionCreatedAtMs)) -> HistoryCommentRevision { subject, content, createdAt = millisToUTCTime revisionCreatedAtMs, revisionId, + isHidden, + authorSignature, comment = HistoryComment { author, diff --git a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql index 076fac0ca8..ef8ec16054 100644 --- a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql +++ b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql @@ -38,6 +38,9 @@ CREATE TABLE history_comment_revisions_new ( hidden BOOL NOT NULL DEFAULT FALSE, revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id) + + -- The signature of the author on the revision hash. + author_signature BLOB NOT NULL ); -- We convert the created_at to created_at_ms by multiplying by 1000 and casting to INTEGER. diff --git a/unison-core/src/Unison/HistoryComment.hs b/unison-core/src/Unison/HistoryComment.hs index 6adaf58392..ae16c19d09 100644 --- a/unison-core/src/Unison/HistoryComment.hs +++ b/unison-core/src/Unison/HistoryComment.hs @@ -7,6 +7,7 @@ where import Data.Text (Text) import Data.Time.Clock (UTCTime) +import Data.ByteString (ByteString) type LatestHistoryComment thumbprint causal revisionId commentId = HistoryCommentRevision revisionId UTCTime (HistoryComment UTCTime thumbprint causal commentId) @@ -27,6 +28,8 @@ data HistoryCommentRevision revisionId createdAt comment = HistoryCommentRevisio createdAt :: createdAt, -- The comment this is a revision for. comment :: comment, + isHidden :: Bool, + authorSignature :: ByteString, revisionId :: revisionId } deriving (Show, Eq, Functor) From bb9cb61af6ee1f124d921031875c64b2c1c06a2d Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 14:47:24 -0800 Subject: [PATCH 24/30] Move history comments hashing module --- .../HistoryComments.hs => HistoryComments/Hashing.hs} | 5 +++-- parser-typechecker/unison-parser-typechecker.cabal | 2 +- .../src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) rename parser-typechecker/src/Unison/{Hashing/HistoryComments.hs => HistoryComments/Hashing.hs} (96%) diff --git a/parser-typechecker/src/Unison/Hashing/HistoryComments.hs b/parser-typechecker/src/Unison/HistoryComments/Hashing.hs similarity index 96% rename from parser-typechecker/src/Unison/Hashing/HistoryComments.hs rename to parser-typechecker/src/Unison/HistoryComments/Hashing.hs index aa76f8436d..6476718899 100644 --- a/parser-typechecker/src/Unison/Hashing/HistoryComments.hs +++ b/parser-typechecker/src/Unison/HistoryComments/Hashing.hs @@ -1,6 +1,6 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module Unison.Hashing.HistoryComments +module Unison.HistoryComments.Hashing ( hashHistoryComment, hashHistoryCommentRevision, ) @@ -47,13 +47,14 @@ instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash any -- Hash a comment revision instance ContentAddressable (HistoryCommentRevision any UTCTime HistoryCommentHash) where - contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash} = + contentHash HistoryCommentRevision {subject, content, createdAt, comment = commentHash, isHidden} = CH.hashUpdates CH.hashInit [ BL.toStrict . Builder.toLazyByteString $ Builder.int32BE commentHashingVersion, Hash.toByteString (into @Hash commentHash), Text.encodeUtf8 subject, Text.encodeUtf8 content, + if isHidden then "1" else "0", -- Encode UTCTime as a UTC 8601 seconds since epoch createdAt & Time.utcTimeToPOSIXSeconds diff --git a/parser-typechecker/unison-parser-typechecker.cabal b/parser-typechecker/unison-parser-typechecker.cabal index 05f123a071..1f871ee276 100644 --- a/parser-typechecker/unison-parser-typechecker.cabal +++ b/parser-typechecker/unison-parser-typechecker.cabal @@ -83,8 +83,8 @@ library Unison.CodebasePath Unison.DataDeclaration.Dependencies Unison.FileParsers - Unison.Hashing.HistoryComments Unison.Hashing.V2.Convert + Unison.HistoryComments.Hashing Unison.KindInference Unison.KindInference.Constraint.Context Unison.KindInference.Constraint.Pretty diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 0a55f2d3ea..64891340b7 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -16,7 +16,7 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (BranchId2) import Unison.Codebase.Editor.Output (Output (..)) -import Unison.Hashing.HistoryComments +import Unison.HistoryComments.Hashing ( hashHistoryComment, hashHistoryCommentRevision, ) From aa40862ae14dd2a94d46a8f41ed2225819404c2e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 14:47:24 -0800 Subject: [PATCH 25/30] Wire in PersonalKey Signatures --- .../sql/021-hash-history-comments.sql | 3 +- .../sql/022-hash-history-comments-cleanup.sql | 4 +- .../src/Unison/Auth/PersonalKey.hs | 1 + .../Codebase/SqliteCodebase/Migrations.hs | 13 +++--- .../Migrations/MigrateHistoryComments.hs | 40 +++++++++++++------ .../Editor/HandleInput/HistoryComment.hs | 28 +++++++++---- .../src/Unison/Codebase/Editor/Output.hs | 2 + .../src/Unison/CommandLine/OutputMessages.hs | 5 ++- 8 files changed, 64 insertions(+), 32 deletions(-) diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql index 8dab37bb08..bfe2e5182b 100644 --- a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -19,7 +19,8 @@ ALTER TABLE history_comments 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); + ADD COLUMN revision_hash_id INTEGER NULL REFERENCES hash(id), + 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); diff --git a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql index ef8ec16054..c4c0112773 100644 --- a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql +++ b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql @@ -44,8 +44,8 @@ CREATE TABLE history_comment_revisions_new ( ); -- We convert the created_at to created_at_ms by multiplying by 1000 and casting to INTEGER. -INSERT INTO history_comment_revisions_new (id, comment_id, subject, contents, created_at_ms, hidden, revision_hash_id) - SELECT id, comment_id, subject, contents, CAST((created_at * 1000) AS INTEGER), hidden, revision_hash_id +INSERT INTO history_comment_revisions_new (id, comment_id, subject, contents, created_at_ms, hidden, author_signature, revision_hash_id) + SELECT id, comment_id, subject, contents, CAST((created_at * 1000) AS INTEGER), hidden, author_signature, revision_hash_id FROM history_comment_revisions; -- Drop old tables diff --git a/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs b/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs index 350f9397ff..e4ba11b4fc 100644 --- a/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs +++ b/lib/unison-credentials/src/Unison/Auth/PersonalKey.hs @@ -16,6 +16,7 @@ module Unison.Auth.PersonalKey personalKeyThumbprint, signWithPersonalKey, verifyWithPersonalKey, + PersonalKeySignature (..), ) where diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 3789d14e18..4927c52cea 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -15,7 +15,7 @@ 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 qualified as CredMan -import Unison.Auth.PersonalKey qualified as PK +import Unison.Auth.PersonalKey (PersonalPrivateKey) import Unison.Codebase (CodebasePath) import Unison.Codebase.Init (BackupStrategy (..), VacuumStrategy (..)) import Unison.Codebase.Init.OpenCodebaseError (OpenCodebaseError (OpenCodebaseUnknownSchemaVersion)) @@ -36,7 +36,6 @@ 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 @@ -47,7 +46,7 @@ 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 -> + PersonalPrivateKey -> (MVar Region.ConsoleRegion) -> -- | A 'getDeclType'-like lookup, possibly backed by a cache. (C.Reference.Reference -> Sqlite.Transaction CT.ConstructorType) -> @@ -55,7 +54,7 @@ migrations :: TVar (Map Hash Ops2.DeclBufferEntry) -> CodebasePath -> Map SchemaVersion (Sqlite.Connection -> IO ()) -migrations keyThumbprint regionVar getDeclType termBuffer declBuffer rootCodebasePath = +migrations personalKey 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 @@ -97,7 +96,7 @@ migrations keyThumbprint regionVar getDeclType termBuffer declBuffer rootCodebas sqlMigration 22 Q.addUpgradeBranchTable, sqlMigration 23 Q.addHistoryComments, sqlMigration 24 Q.addHistoryCommentHashing, - (25, runT $ hashHistoryCommentsMigration keyThumbprint), + (25, runT $ hashHistoryCommentsMigration personalKey), sqlMigration 26 Q.historyCommentHashingCleanup ] where @@ -163,8 +162,8 @@ ensureCodebaseIsUpToDate localOrRemote root getDeclType termBuffer declBuffer sh Region.displayConsoleRegions do (`UnliftIO.finally` finalizeRegion) do let credMan = CredMan.globalCredentialManager - keyThumbprint <- PK.personalKeyThumbprint <$> CredMan.getOrCreatePersonalKey credMan - let migs = migrations keyThumbprint regionVar getDeclType termBuffer declBuffer root + personalKey <- CredMan.getOrCreatePersonalKey credMan + let migs = migrations personalKey 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 index 9259ff4941..391ac2acd2 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations/MigrateHistoryComments.hs @@ -10,11 +10,13 @@ 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.Auth.PersonalKey (PersonalPrivateKey) +import Unison.Auth.PersonalKey qualified as PersonalKey import Unison.Debug qualified as Debug import Unison.Hash (Hash) -import Unison.Hashing.HistoryComments (hashHistoryComment, hashHistoryCommentRevision) +import Unison.Hash qualified as Hash import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..)) -import Unison.KeyThumbprint (KeyThumbprint) +import Unison.HistoryComments.Hashing (hashHistoryComment, hashHistoryCommentRevision) import Unison.Prelude import Unison.Sqlite qualified as Sqlite @@ -29,15 +31,16 @@ millisToUTCTime ms = -- | 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 :: KeyThumbprint -> Sqlite.Transaction () -hashHistoryCommentsMigration defaultKeyThumbprint = do +hashHistoryCommentsMigration :: PersonalPrivateKey -> Sqlite.Transaction () +hashHistoryCommentsMigration personalKey = do Q.expectSchemaVersion 24 - hashAllHistoryComments defaultKeyThumbprint + hashAllHistoryComments personalKey Q.setSchemaVersion 25 -hashAllHistoryComments :: KeyThumbprint -> Sqlite.Transaction () -hashAllHistoryComments defaultKeyThumbprint = do - keyThumbprintId <- Q.ensurePersonalKeyThumbprintId defaultKeyThumbprint +hashAllHistoryComments :: PersonalPrivateKey -> Sqlite.Transaction () +hashAllHistoryComments personalKey = do + let keyThumbprint = PersonalKey.personalKeyThumbprint personalKey + keyThumbprintId <- Q.ensurePersonalKeyThumbprintId keyThumbprint historyComments <- Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, Int64) [Sqlite.sql| @@ -51,7 +54,7 @@ hashAllHistoryComments defaultKeyThumbprint = do HistoryComment { author, createdAt = millisToUTCTime createdAtMs, - authorThumbprint = defaultKeyThumbprint, + authorThumbprint = keyThumbprint, causal = coerce @_ @CausalHash causalHash, commentId = () } @@ -66,29 +69,40 @@ hashAllHistoryComments defaultKeyThumbprint = do WHERE id = :commentId |] historyCommentRevisions <- - Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, Int64, AsSqlite Hash) + Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, Bool, Int64, AsSqlite Hash) [Sqlite.sql| - SELECT hcr.id, hcr.subject, hcr.contents, CAST(hcr.created_at * 1000 AS INTEGER), comment_hash.base32 + SELECT hcr.id, hcr.subject, hcr.contents, hcr.hidden, CAST(hcr.created_at * 1000 AS INTEGER), comment_hash.base32 FROM history_comment_revisions hcr 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, createdAtMs, commentHash) -> do + for_ historyCommentRevisions $ \(HistoryCommentRevisionId revisionId, subject, content, isHidden, createdAtMs, commentHash) -> do Debug.debugM Debug.Temp "Hashing history comment revision" (subject, content) let historyCommentRevision = HistoryCommentRevision { subject, content, + isHidden, + authorSignature = mempty, createdAt = millisToUTCTime createdAtMs, comment = coerce @_ @HistoryCommentHash commentHash, revisionId = () } let historyCommentRevisionHash = hashHistoryCommentRevision historyCommentRevision + let historyCommentRevisionHashBytes = + historyCommentRevisionHash.revisionId + & unHistoryCommentRevisionHash + & Hash.toByteString + PersonalKey.PersonalKeySignature authorSignature <- + Sqlite.unsafeIO (PersonalKey.signWithPersonalKey personalKey historyCommentRevisionHashBytes) >>= \case + Left err -> error $ "Migration failure: Failed to sign history comment revision: " ++ show err + Right sig -> pure sig commentRevisionHashId <- Q.saveHistoryCommentRevisionHash historyCommentRevisionHash.revisionId Sqlite.execute [Sqlite.sql| UPDATE history_comment_revisions - SET revision_hash_id = :commentRevisionHashId + SET revision_hash_id = :commentRevisionHashId, + author_signature = :authorSignature WHERE id = :revisionId |] diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs index 64891340b7..6a11021767 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/HistoryComment.hs @@ -6,6 +6,7 @@ import Data.Text.IO qualified as Text import Data.Time.Clock.POSIX qualified as Time import Text.RawString.QQ (r) import U.Codebase.Config qualified as Config +import U.Codebase.HashTags import U.Codebase.Sqlite.Queries qualified as Q import Unison.Auth.CredentialManager qualified as CredMan import Unison.Auth.PersonalKey qualified as PK @@ -16,14 +17,15 @@ import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Editor.Input (BranchId2) import Unison.Codebase.Editor.Output (Output (..)) -import Unison.HistoryComments.Hashing - ( hashHistoryComment, - hashHistoryCommentRevision, - ) import Unison.Codebase.Path qualified as Path import Unison.CommandLine.BranchRelativePath (BranchRelativePath (..)) import Unison.Core.Project (ProjectAndBranch (..)) +import Unison.Hash qualified as Hash import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..)) +import Unison.HistoryComments.Hashing + ( hashHistoryComment, + hashHistoryCommentRevision, + ) import Unison.Prelude import UnliftIO qualified import UnliftIO.Directory (findExecutable) @@ -33,7 +35,8 @@ import UnliftIO.Process qualified as Proc handleHistoryComment :: Maybe BranchId2 -> Cli () handleHistoryComment mayThingToAnnotate = do Cli.Env {credentialManager} <- ask - authorThumbprint <- PK.personalKeyThumbprint <$> liftIO (CredMan.getOrCreatePersonalKey credentialManager) + personalKey <- liftIO (CredMan.getOrCreatePersonalKey credentialManager) + let authorThumbprint = PK.personalKeyThumbprint personalKey mayAuthorName <- Cli.runTransaction do authorName <- Q.getAuthorName @@ -67,7 +70,7 @@ handleHistoryComment mayThingToAnnotate = do pure $ Text.unlines [subject, "", content, commentInstructions] mayNewMessage <- liftIO (editMessage (Just populatedMsg)) case mayNewMessage of - Nothing -> Cli.respond $ CommentAborted + Nothing -> Cli.returnEarly $ CommentAborted Just (subject, content) -> do createdAt <- liftIO $ Time.getCurrentTime let historyComment = @@ -87,10 +90,21 @@ handleHistoryComment mayThingToAnnotate = do subject, content, createdAt, + -- Hard coded for now, we can change this later if we want to support hiding comments + isHidden = False, + authorSignature = "", comment = historyComment.commentId } let historyComment' = historyComment {causal = causalHashId} - Cli.runTransaction $ Q.commentOnCausal $ historyCommentRevision {comment = historyComment'} + let historyCommentRevisionHashBytes = + historyCommentRevision.revisionId + & unHistoryCommentRevisionHash + & Hash.toByteString + PK.PersonalKeySignature authorSignature <- + PK.signWithPersonalKey personalKey historyCommentRevisionHashBytes >>= \case + Left err -> Cli.returnEarly $ CommentFailed (Text.pack (show err)) + Right sig -> pure sig + Cli.runTransaction $ Q.commentOnCausal $ historyCommentRevision {comment = historyComment', authorSignature = authorSignature} Cli.respond $ CommentedSuccessfully where commentInstructions = diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index c47e9736ae..08e1ea5079 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -478,6 +478,7 @@ data Output | InvalidCommentTarget Text | CommentedSuccessfully | CommentAborted + | CommentFailed Text | AuthorNameRequired | ConfigValueGet ConfigKey (Maybe Text) @@ -728,6 +729,7 @@ isFailure o = case o of InvalidCommentTarget {} -> True CommentedSuccessfully {} -> False CommentAborted {} -> True + CommentFailed {} -> True AuthorNameRequired {} -> True ConfigValueGet {} -> False diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 75911c0763..4262a246b8 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2633,9 +2633,10 @@ notifyUser dir issueFn = \case prettyMain :: Pretty prettyMain = prettyName main - InvalidCommentTarget msg -> pure (P.wrap $ "Annotation failed, " <> P.text msg) + InvalidCommentTarget msg -> pure (P.wrap $ "Comment failed, " <> P.text msg) CommentedSuccessfully -> pure $ P.bold "Done." - CommentAborted -> pure (P.wrap "Annotation aborted.") + CommentAborted -> pure (P.wrap "Comment aborted.") + CommentFailed err -> pure (P.fatalCallout $ P.wrap $ "Comment failed, " <> P.text err) AuthorNameRequired -> pure $ P.hang "Please configure your a display name for your user." $ From e53ff9a8c62c1daf7c34dec694c022789d3493dd Mon Sep 17 00:00:00 2001 From: ChrisPenner <6439644+ChrisPenner@users.noreply.github.com> Date: Tue, 18 Nov 2025 00:09:49 +0000 Subject: [PATCH 26/30] automatically run ormolu --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 6 +++--- unison-core/src/Unison/HistoryComment.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 4262a246b8..c0797ca5a2 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -41,7 +41,6 @@ import U.Codebase.Branch.Diff (NameChanges (..)) import U.Codebase.Config qualified as Config import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reference qualified as Reference -import Unison.HistoryComment (HistoryComment (..), LatestHistoryComment, HistoryCommentRevision (..)) import U.Codebase.Sqlite.Project (Project (..)) import U.Codebase.Sqlite.ProjectBranch (ProjectBranch (..)) import U.Codebase.Sqlite.ProjectReflog qualified as ProjectReflog @@ -93,6 +92,7 @@ import Unison.Hash qualified as Hash import Unison.Hash32 (Hash32) import Unison.HashQualified qualified as HQ import Unison.HashQualifiedPrime qualified as HQ' +import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..), LatestHistoryComment) import Unison.LabeledDependency (LabeledDependency) import Unison.LabeledDependency qualified as LD import Unison.Merge (GUpdated (..), TwoWay (..)) @@ -307,10 +307,10 @@ notifyNumbered = \case reversedHistory = reverse history showNum :: Int -> Pretty showNum n = P.shown n <> ". " - displayComment :: Bool -> Maybe (LatestHistoryComment () () () () ) -> [Pretty] + displayComment :: Bool -> Maybe (LatestHistoryComment () () () ()) -> [Pretty] displayComment prefixSpacer mayComment = case mayComment of Nothing -> [] - Just (HistoryCommentRevision {comment=HistoryComment{author}, subject, content}) -> + Just (HistoryCommentRevision {comment = HistoryComment {author}, subject, content}) -> Monoid.whenM prefixSpacer [""] <> [(P.text "⊙ " <> P.bold (P.text author))] <> [ P.indent (P.blue " ┃ ") (P.text subject) diff --git a/unison-core/src/Unison/HistoryComment.hs b/unison-core/src/Unison/HistoryComment.hs index ae16c19d09..53e2b853ba 100644 --- a/unison-core/src/Unison/HistoryComment.hs +++ b/unison-core/src/Unison/HistoryComment.hs @@ -5,9 +5,9 @@ module Unison.HistoryComment ) where +import Data.ByteString (ByteString) import Data.Text (Text) import Data.Time.Clock (UTCTime) -import Data.ByteString (ByteString) type LatestHistoryComment thumbprint causal revisionId commentId = HistoryCommentRevision revisionId UTCTime (HistoryComment UTCTime thumbprint causal commentId) From b39f1109b895e121a2239f6f9973b0af2a15990a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 16:15:39 -0800 Subject: [PATCH 27/30] Add in missing author_signature inserts --- codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs | 5 +++-- codebase2/codebase-sqlite/sql/021-hash-history-comments.sql | 4 +++- .../sql/022-hash-history-comments-cleanup.sql | 2 +- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs index c007ef1c67..b5baf1c1db 100644 --- a/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs +++ b/codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs @@ -4217,6 +4217,7 @@ commentOnCausal { content, subject, revisionId = commentRevisionHash, + authorSignature, comment = HistoryComment {author, authorThumbprint, causal = causalHashId, commentId = commentHash} } = do commentHashId <- saveHistoryCommentHash commentHash @@ -4242,8 +4243,8 @@ commentOnCausal Just cid -> pure cid execute [sql| - INSERT INTO history_comment_revisions (revision_hash_id, comment_id, subject, contents, created_at) - VALUES (:commentRevisionHashId, :commentId, :subject, :content, :createdAtMs) + 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) diff --git a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql index bfe2e5182b..08aaffc852 100644 --- a/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql +++ b/codebase2/codebase-sqlite/sql/021-hash-history-comments.sql @@ -19,7 +19,9 @@ ALTER TABLE history_comments 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), + 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 diff --git a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql index c4c0112773..96e111ea66 100644 --- a/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql +++ b/codebase2/codebase-sqlite/sql/022-hash-history-comments-cleanup.sql @@ -37,7 +37,7 @@ CREATE TABLE history_comment_revisions_new ( -- but you can ask to hide them. hidden BOOL NOT NULL DEFAULT FALSE, - revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id) + revision_hash_id INTEGER UNIQUE NOT NULL REFERENCES hash(id), -- The signature of the author on the revision hash. author_signature BLOB NOT NULL From 080fe0dea8d97d96a9f8811f6d4456e60fac067e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 16:24:42 -0800 Subject: [PATCH 28/30] Remove unused blake3 references --- stack.yaml | 6 ------ stack.yaml.lock | 7 ------- 2 files changed, 13 deletions(-) diff --git a/stack.yaml b/stack.yaml index 268100affb..6b8402c869 100644 --- a/stack.yaml +++ b/stack.yaml @@ -66,7 +66,6 @@ extra-deps: - recover-rtti-0.4.3@sha256:01adcbab70a6542914df28ac120a23a923d8566236f2c0295998e9419f53dd62,4672 - numerals-0.4.1@sha256:f138b4a0efbde3b3c6cbccb788eff683cb8a5d046f449729712fd174c5ee8a78,11430 - network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 - - blake3-0.3@sha256:5517c394b60f88918df78eb8356799fd3b1a09e16b82af36be6edb85d6c3e108,2838 # TODO: The revision pinned here doesn’t exist in the Nix snapshot of Hackage we use. Uncomment this once we update # the Nix inputs (likely via #5796). @@ -76,11 +75,6 @@ extra-deps: flags: haskeline: terminfo: false - blake3: - avx512: false - avx2: false - sse41: false - sse2: false allow-newer: true allow-newer-deps: diff --git a/stack.yaml.lock b/stack.yaml.lock index d80b72e627..00046af8e6 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -68,13 +68,6 @@ packages: size: 284 original: hackage: network-udp-0.0.0@sha256:408d2d4fa1a25e49e95752ee124cca641993404bb133ae10fb81daef22d876ae,1075 -- completed: - hackage: blake3-0.3@sha256:5517c394b60f88918df78eb8356799fd3b1a09e16b82af36be6edb85d6c3e108,2838 - pantry-tree: - sha256: d5200c6f006a3a790a25d63b9823ce125c8a64c15300259ce467643f364683a2 - size: 1649 - original: - hackage: blake3-0.3@sha256:5517c394b60f88918df78eb8356799fd3b1a09e16b82af36be6edb85d6c3e108,2838 snapshots: - completed: sha256: 8e7996960d864443a66eb4105338bbdd6830377b9f6f99cd5527ef73c10c01e7 From c88a25ef43bd625cf0c857d1355d6aa9fb95fddd Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Mon, 17 Nov 2025 16:36:02 -0800 Subject: [PATCH 29/30] Back compat credentials file. --- lib/unison-credentials/src/Unison/Auth/Types.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lib/unison-credentials/src/Unison/Auth/Types.hs b/lib/unison-credentials/src/Unison/Auth/Types.hs index 6ecbd6ae24..09df35258e 100644 --- a/lib/unison-credentials/src/Unison/Auth/Types.hs +++ b/lib/unison-credentials/src/Unison/Auth/Types.hs @@ -150,7 +150,8 @@ instance Aeson.ToJSON Credentials where instance Aeson.FromJSON Credentials where parseJSON = Aeson.withObject "Credentials" $ \obj -> do credentials <- obj .: "credentials" - personalKeys <- obj .: "personal_keys" + -- If there are no personal keys, default to an empty map for back-compat. + personalKeys <- fromMaybe Map.empty <$> obj .:? "personal_keys" activeProfile <- obj .: "active_profile" pure Credentials {..} From 28e1af13faa6727b9d58068362bc2b63e0ff8251 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 19 Nov 2025 12:10:01 -0800 Subject: [PATCH 30/30] Satisfy weeder for now, I'll be using these methods in Share --- .../src/Unison/Codebase/SqliteCodebase/Migrations.hs | 2 -- weeder.toml | 2 ++ 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs index 4927c52cea..51a857942e 100644 --- a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs +++ b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Migrations.hs @@ -132,8 +132,6 @@ 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. diff --git a/weeder.toml b/weeder.toml index ccc4bf1b01..308be160cc 100644 --- a/weeder.toml +++ b/weeder.toml @@ -863,6 +863,8 @@ roots = [ '''^Unison\.Test\.Ucm\.deleteCodebase$''', '''^Unison\.Test\.UriParser\.mkPath$''', '''^Unison\.Test\.UriParser\.sch$''', + '''^Unison\.Auth^.PersonalKey\.publicKey$''', + '''^Unison\.Auth^.PersonalKey\.verifyWithPersonalKey$''', ] type-class-roots = true unused-types = true