{-# LANGUAGE DuplicateRecordFields #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Unison.Hashing.V2.HistoryComments
  ( hashHistoryComment,
    hashHistoryCommentRevision,
  )
where

import Codec.CBOR.Encoding qualified as CBOR
import Codec.CBOR.Write qualified as CBOR.Write
import Crypto.Hash qualified as CH
import Data.ByteArray qualified as BA
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX qualified as Time
import Unison.Hash (Hash)
import Unison.Hash qualified as Hash
import Unison.HashTags
import Unison.Hashing.ContentAddressable (ContentAddressable (..))
import Unison.HistoryComment (HistoryComment (..), HistoryCommentRevision (..))
import Unison.KeyThumbprint (KeyThumbprint (..))
import Unison.Prelude

commentHashingVersion :: Int32
commentHashingVersion :: Int32
commentHashingVersion = Int32
1

revisionHashingVersion :: Int32
revisionHashingVersion :: Int32
revisionHashingVersion = Int32
1

-- Hash a base comment
instance ContentAddressable (HistoryComment UTCTime KeyThumbprint CausalHash any) where
  contentHash :: HistoryComment UTCTime KeyThumbprint CausalHash any -> Hash
contentHash HistoryComment {UTCTime
createdAt :: UTCTime
createdAt :: forall createdAt thumbprint causal commentId.
HistoryComment createdAt thumbprint causal commentId -> createdAt
createdAt, Text
author :: Text
author :: forall createdAt thumbprint causal commentId.
HistoryComment createdAt thumbprint causal commentId -> Text
author, CausalHash
causal :: CausalHash
causal :: forall createdAt thumbprint causal commentId.
HistoryComment createdAt thumbprint causal commentId -> causal
causal, KeyThumbprint
authorThumbprint :: KeyThumbprint
authorThumbprint :: forall createdAt thumbprint causal commentId.
HistoryComment createdAt thumbprint causal commentId -> thumbprint
authorThumbprint} =
    Context SHA3_512 -> [ByteString] -> Context SHA3_512
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
CH.hashUpdates
      Context SHA3_512
forall a. HashAlgorithm a => Context a
CH.hashInit
      [ByteString
commentBytes]
      Context SHA3_512
-> (Context SHA3_512 -> Digest SHA3_512) -> Digest SHA3_512
forall a b. a -> (a -> b) -> b
& forall a. HashAlgorithm a => Context a -> Digest a
CH.hashFinalize @CH.SHA3_512
      Digest SHA3_512 -> (Digest SHA3_512 -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
      ByteString -> (ByteString -> Hash) -> Hash
forall a b. a -> (a -> b) -> b
& ByteString -> Hash
Hash.fromByteString
    where
      -- First encode as CBOR to normalize the representation,
      -- this ensures each value is unambiguously represented as a separate _field_, and that
      -- we don't get the same hash for something like (title: "ab", contents: "c") and (title: "a", contents "bc")
      -- when they get concatenated together for hashing.
      -- CBOR has a canonical encoding, so this is deterministic, even across different architectures.
      commentBytes :: ByteString
      commentBytes :: ByteString
commentBytes =
        Encoding -> ByteString
CBOR.Write.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
          Integer -> Encoding
CBOR.encodeInteger (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
commentHashingVersion)
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes (Hash -> ByteString
Hash.toByteString (Hash -> ByteString) -> Hash -> ByteString
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Hash CausalHash
causal)
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
CBOR.encodeString Text
author
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
CBOR.encodeString (KeyThumbprint -> Text
thumbprintToText KeyThumbprint
authorThumbprint)
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
CBOR.encodeInteger (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
Time.utcTimeToPOSIXSeconds UTCTime
createdAt)

-- Hash a comment revision
instance ContentAddressable (HistoryCommentRevision any UTCTime HistoryCommentHash) where
  contentHash :: HistoryCommentRevision any UTCTime HistoryCommentHash -> Hash
contentHash HistoryCommentRevision {Text
subject :: Text
subject :: forall revisionId createdAt comment.
HistoryCommentRevision revisionId createdAt comment -> Text
subject, Text
content :: Text
content :: forall revisionId createdAt comment.
HistoryCommentRevision revisionId createdAt comment -> Text
content, UTCTime
createdAt :: UTCTime
createdAt :: forall revisionId createdAt comment.
HistoryCommentRevision revisionId createdAt comment -> createdAt
createdAt, comment :: forall revisionId createdAt comment.
HistoryCommentRevision revisionId createdAt comment -> comment
comment = HistoryCommentHash
commentHash, Bool
isHidden :: Bool
isHidden :: forall revisionId createdAt comment.
HistoryCommentRevision revisionId createdAt comment -> Bool
isHidden} =
    Context SHA3_512 -> [ByteString] -> Context SHA3_512
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
CH.hashUpdates
      Context SHA3_512
forall a. HashAlgorithm a => Context a
CH.hashInit
      [ ByteString
commentBytes
      ]
      Context SHA3_512
-> (Context SHA3_512 -> Digest SHA3_512) -> Digest SHA3_512
forall a b. a -> (a -> b) -> b
& forall a. HashAlgorithm a => Context a -> Digest a
CH.hashFinalize @CH.SHA3_512
      Digest SHA3_512 -> (Digest SHA3_512 -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
      ByteString -> (ByteString -> Hash) -> Hash
forall a b. a -> (a -> b) -> b
& ByteString -> Hash
Hash.fromByteString
    where
      -- First encode as CBOR to normalize the representation,
      -- this ensures each value is unambiguously represented as a separate _field_, and that
      -- we don't get the same hash for something like (title: "ab", contents: "c") and (title: "a", contents "bc")
      -- when they get concatenated together for hashing.
      -- CBOR has a canonical encoding, so this is deterministic, even across different architectures.
      commentBytes :: ByteString
      commentBytes :: ByteString
commentBytes =
        Encoding -> ByteString
CBOR.Write.toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
          Integer -> Encoding
CBOR.encodeInteger (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
revisionHashingVersion)
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
CBOR.encodeBytes (Hash -> ByteString
Hash.toByteString (Hash -> ByteString) -> Hash -> ByteString
forall a b. (a -> b) -> a -> b
$ forall target source. From source target => source -> target
into @Hash HistoryCommentHash
commentHash)
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
CBOR.encodeString Text
subject
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Text -> Encoding
CBOR.encodeString Text
content
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Bool -> Encoding
CBOR.encodeBool Bool
isHidden
            Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
CBOR.encodeInteger (POSIXTime -> Integer
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
Time.utcTimeToPOSIXSeconds UTCTime
createdAt)

hashHistoryComment ::
  HistoryComment UTCTime KeyThumbprint CausalHash any ->
  HistoryComment UTCTime KeyThumbprint CausalHash HistoryCommentHash
hashHistoryComment :: forall any.
HistoryComment UTCTime KeyThumbprint CausalHash any
-> HistoryComment
     UTCTime KeyThumbprint CausalHash HistoryCommentHash
hashHistoryComment HistoryComment UTCTime KeyThumbprint CausalHash any
historyComment =
  let commentHash :: HistoryCommentHash
commentHash = Hash -> HistoryCommentHash
HistoryCommentHash (Hash -> HistoryCommentHash) -> Hash -> HistoryCommentHash
forall a b. (a -> b) -> a -> b
$ HistoryComment UTCTime KeyThumbprint CausalHash any -> Hash
forall a. ContentAddressable a => a -> Hash
contentHash HistoryComment UTCTime KeyThumbprint CausalHash any
historyComment
   in HistoryComment UTCTime KeyThumbprint CausalHash any
historyComment {commentId = commentHash}

hashHistoryCommentRevision ::
  HistoryCommentRevision any UTCTime HistoryCommentHash ->
  HistoryCommentRevision HistoryCommentRevisionHash UTCTime HistoryCommentHash
hashHistoryCommentRevision :: forall any.
HistoryCommentRevision any UTCTime HistoryCommentHash
-> HistoryCommentRevision
     HistoryCommentRevisionHash UTCTime HistoryCommentHash
hashHistoryCommentRevision HistoryCommentRevision any UTCTime HistoryCommentHash
historyCommentRevision =
  let commentRevisionHash :: HistoryCommentRevisionHash
commentRevisionHash = Hash -> HistoryCommentRevisionHash
HistoryCommentRevisionHash (Hash -> HistoryCommentRevisionHash)
-> Hash -> HistoryCommentRevisionHash
forall a b. (a -> b) -> a -> b
$ HistoryCommentRevision any UTCTime HistoryCommentHash -> Hash
forall a. ContentAddressable a => a -> Hash
contentHash HistoryCommentRevision any UTCTime HistoryCommentHash
historyCommentRevision
   in HistoryCommentRevision any UTCTime HistoryCommentHash
historyCommentRevision {revisionId = commentRevisionHash}