{-# 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 (..))
import U.Codebase.Sqlite.Queries qualified as Q
import Unison.Auth.PersonalKey (PersonalPrivateKey)
import Unison.Auth.PersonalKey qualified as PersonalKey
import Unison.Hash (Hash)
import Unison.Hash qualified as Hash
import Unison.Hashing.V2 (hashHistoryComment, hashHistoryCommentRevision)
import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..))
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 :: Int64 -> UTCTime
millisToUTCTime Int64
ms =
  Int64 -> Rational
forall a. Real a => a -> Rational
toRational Int64
ms
    Rational -> (Rational -> Rational) -> Rational
forall a b. a -> (a -> b) -> b
& (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
1_000 :: Rational))
    Rational -> (Rational -> POSIXTime) -> POSIXTime
forall a b. a -> (a -> b) -> b
& Rational -> POSIXTime
forall a. Fractional a => Rational -> a
fromRational
    POSIXTime -> (POSIXTime -> UTCTime) -> UTCTime
forall a b. a -> (a -> b) -> b
& POSIXTime -> UTCTime
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 :: PersonalPrivateKey -> Sqlite.Transaction ()
hashHistoryCommentsMigration :: PersonalPrivateKey -> Transaction ()
hashHistoryCommentsMigration PersonalPrivateKey
personalKey = do
  SchemaVersion -> Transaction ()
Q.expectSchemaVersion SchemaVersion
24
  PersonalPrivateKey -> Transaction ()
hashAllHistoryComments PersonalPrivateKey
personalKey
  SchemaVersion -> Transaction ()
Q.setSchemaVersion SchemaVersion
25

hashAllHistoryComments :: PersonalPrivateKey -> Sqlite.Transaction ()
hashAllHistoryComments :: PersonalPrivateKey -> Transaction ()
hashAllHistoryComments PersonalPrivateKey
personalKey = do
  let keyThumbprint :: KeyThumbprint
keyThumbprint = PersonalPrivateKey -> KeyThumbprint
PersonalKey.personalKeyThumbprint PersonalPrivateKey
personalKey
  KeyThumbprintId
keyThumbprintId <- KeyThumbprint -> Transaction KeyThumbprintId
Q.ensurePersonalKeyThumbprintId KeyThumbprint
keyThumbprint
  [(HistoryCommentId, AsSqlite Hash, Text, Int64)]
historyComments <-
    forall a. (FromRow a, HasCallStack) => Sql -> Transaction [a]
Sqlite.queryListRow @(HistoryCommentId, AsSqlite Hash, Text, Int64)
      [Sqlite.sql|
    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
    |]
  [(HistoryCommentId, AsSqlite Hash, Text, Int64)]
-> ((HistoryCommentId, AsSqlite Hash, Text, Int64)
    -> Transaction ())
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(HistoryCommentId, AsSqlite Hash, Text, Int64)]
historyComments (((HistoryCommentId, AsSqlite Hash, Text, Int64) -> Transaction ())
 -> Transaction ())
-> ((HistoryCommentId, AsSqlite Hash, Text, Int64)
    -> Transaction ())
-> Transaction ()
forall a b. (a -> b) -> a -> b
$ \(HistoryCommentId Word64
commentId, AsSqlite Hash
causalHash, Text
author, Int64
createdAtMs) -> do
    let historyComment :: HistoryComment UTCTime KeyThumbprint CausalHash ()
historyComment =
          HistoryComment
            { Text
author :: Text
$sel:author:HistoryComment :: Text
author,
              $sel:createdAt:HistoryComment :: UTCTime
createdAt = Int64 -> UTCTime
millisToUTCTime Int64
createdAtMs,
              $sel:authorThumbprint:HistoryComment :: KeyThumbprint
authorThumbprint = KeyThumbprint
keyThumbprint,
              $sel:causal:HistoryComment :: CausalHash
causal = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @CausalHash AsSqlite Hash
causalHash,
              $sel:commentId:HistoryComment :: ()
commentId = ()
            }
    let historyCommentHash :: HistoryComment UTCTime KeyThumbprint CausalHash HistoryCommentHash
historyCommentHash = HistoryComment UTCTime KeyThumbprint CausalHash ()
-> HistoryComment
     UTCTime KeyThumbprint CausalHash HistoryCommentHash
forall any.
HistoryComment UTCTime KeyThumbprint CausalHash any
-> HistoryComment
     UTCTime KeyThumbprint CausalHash HistoryCommentHash
hashHistoryComment HistoryComment UTCTime KeyThumbprint CausalHash ()
historyComment
    CommentHashId
historyCommentHashId <- HistoryCommentHash -> Transaction CommentHashId
Q.saveHistoryCommentHash HistoryComment UTCTime KeyThumbprint CausalHash HistoryCommentHash
historyCommentHash.commentId
    HasCallStack => Sql -> Transaction ()
Sql -> Transaction ()
Sqlite.execute
      [Sqlite.sql|
      UPDATE history_comments
         SET comment_hash_id = :historyCommentHashId,
             author_thumbprint_id = :keyThumbprintId
       WHERE id = :commentId
      |]
  [(HistoryCommentRevisionId, Text, Text, Bool, Int64,
  AsSqlite Hash)]
historyCommentRevisions <-
    forall a. (FromRow a, HasCallStack) => Sql -> Transaction [a]
Sqlite.queryListRow @(HistoryCommentRevisionId, Text, Text, Bool, Int64, AsSqlite Hash)
      [Sqlite.sql|
    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
    |]
  [(HistoryCommentRevisionId, Text, Text, Bool, Int64,
  AsSqlite Hash)]
-> ((HistoryCommentRevisionId, Text, Text, Bool, Int64,
     AsSqlite Hash)
    -> Transaction ())
-> Transaction ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(HistoryCommentRevisionId, Text, Text, Bool, Int64,
  AsSqlite Hash)]
historyCommentRevisions (((HistoryCommentRevisionId, Text, Text, Bool, Int64,
   AsSqlite Hash)
  -> Transaction ())
 -> Transaction ())
-> ((HistoryCommentRevisionId, Text, Text, Bool, Int64,
     AsSqlite Hash)
    -> Transaction ())
-> Transaction ()
forall a b. (a -> b) -> a -> b
$ \(HistoryCommentRevisionId Word64
revisionId, Text
subject, Text
content, Bool
isHidden, Int64
createdAtMs, AsSqlite Hash
commentHash) -> do
    let historyCommentRevision :: HistoryCommentRevision () UTCTime HistoryCommentHash
historyCommentRevision =
          HistoryCommentRevision
            { Text
subject :: Text
$sel:subject:HistoryCommentRevision :: Text
subject,
              Text
content :: Text
$sel:content:HistoryCommentRevision :: Text
content,
              Bool
isHidden :: Bool
$sel:isHidden:HistoryCommentRevision :: Bool
isHidden,
              $sel:authorSignature:HistoryCommentRevision :: ByteString
authorSignature = ByteString
forall a. Monoid a => a
mempty,
              $sel:createdAt:HistoryCommentRevision :: UTCTime
createdAt = Int64 -> UTCTime
millisToUTCTime Int64
createdAtMs,
              $sel:comment:HistoryCommentRevision :: HistoryCommentHash
comment = forall a b. Coercible a b => a -> b
forall a b. Coercible a b => a -> b
coerce @_ @HistoryCommentHash AsSqlite Hash
commentHash,
              $sel:revisionId:HistoryCommentRevision :: ()
revisionId = ()
            }
    let historyCommentRevisionHash :: HistoryCommentRevision
  HistoryCommentRevisionHash UTCTime HistoryCommentHash
historyCommentRevisionHash = HistoryCommentRevision () UTCTime HistoryCommentHash
-> HistoryCommentRevision
     HistoryCommentRevisionHash UTCTime HistoryCommentHash
forall any.
HistoryCommentRevision any UTCTime HistoryCommentHash
-> HistoryCommentRevision
     HistoryCommentRevisionHash UTCTime HistoryCommentHash
hashHistoryCommentRevision HistoryCommentRevision () UTCTime HistoryCommentHash
historyCommentRevision
    let historyCommentRevisionHashBytes :: ByteString
historyCommentRevisionHashBytes =
          HistoryCommentRevision
  HistoryCommentRevisionHash UTCTime HistoryCommentHash
historyCommentRevisionHash.revisionId
            HistoryCommentRevisionHash
-> (HistoryCommentRevisionHash -> Hash) -> Hash
forall a b. a -> (a -> b) -> b
& HistoryCommentRevisionHash -> Hash
unHistoryCommentRevisionHash
            Hash -> (Hash -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Hash -> ByteString
Hash.toByteString
    PersonalKey.PersonalKeySignature ByteString
authorSignature <-
      IO (Either Error PersonalKeySignature)
-> Transaction (Either Error PersonalKeySignature)
forall a. HasCallStack => IO a -> Transaction a
Sqlite.unsafeIO (PersonalPrivateKey
-> ByteString -> IO (Either Error PersonalKeySignature)
forall (m :: * -> *).
MonadIO m =>
PersonalPrivateKey
-> ByteString -> m (Either Error PersonalKeySignature)
PersonalKey.signWithPersonalKey PersonalPrivateKey
personalKey ByteString
historyCommentRevisionHashBytes) Transaction (Either Error PersonalKeySignature)
-> (Either Error PersonalKeySignature
    -> Transaction PersonalKeySignature)
-> Transaction PersonalKeySignature
forall a b. Transaction a -> (a -> Transaction b) -> Transaction b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left Error
err -> [Char] -> Transaction PersonalKeySignature
forall a. HasCallStack => [Char] -> a
error ([Char] -> Transaction PersonalKeySignature)
-> [Char] -> Transaction PersonalKeySignature
forall a b. (a -> b) -> a -> b
$ [Char]
"Migration failure: Failed to sign history comment revision: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Error -> [Char]
forall a. Show a => a -> [Char]
show Error
err
        Right PersonalKeySignature
sig -> PersonalKeySignature -> Transaction PersonalKeySignature
forall a. a -> Transaction a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PersonalKeySignature
sig
    CommentRevisionHashId
commentRevisionHashId <- HistoryCommentRevisionHash -> Transaction CommentRevisionHashId
Q.saveHistoryCommentRevisionHash HistoryCommentRevision
  HistoryCommentRevisionHash UTCTime HistoryCommentHash
historyCommentRevisionHash.revisionId
    HasCallStack => Sql -> Transaction ()
Sql -> Transaction ()
Sqlite.execute
      [Sqlite.sql|
      UPDATE history_comment_revisions
         SET revision_hash_id = :commentRevisionHashId,
             author_signature = :authorSignature
       WHERE id = :revisionId
      |]