module Unison.Hashable
  ( accumulate',
    hash,
    Accumulate (..),
    Token (..),
  )
where

import Crypto.Hash qualified as CH
import Data.ByteArray qualified as BA
import Data.ByteString qualified as B
import Data.ByteString.Builder (doubleBE, int64BE, toLazyByteString, word64BE)
import Data.ByteString.Lazy qualified as BL
import Data.Map qualified as Map
import Data.Set qualified as Set
import Unison.Hash (Hash)
import Unison.Hash qualified as Hash
import Unison.Prelude
import Unison.Util.Relation (Relation)
import Unison.Util.Relation qualified as Relation
import Unison.Util.Relation3 (Relation3)
import Unison.Util.Relation3 qualified as Relation3
import Unison.Util.Relation4 (Relation4)
import Unison.Util.Relation4 qualified as Relation4

data Token h
  = Tag !Word8
  | Bytes !ByteString
  | Int !Int64
  | Text !Text
  | Double !Double
  | Hashed !h
  | Nat !Word64
  deriving stock (Int -> Token h -> ShowS
[Token h] -> ShowS
Token h -> String
(Int -> Token h -> ShowS)
-> (Token h -> String) -> ([Token h] -> ShowS) -> Show (Token h)
forall h. Show h => Int -> Token h -> ShowS
forall h. Show h => [Token h] -> ShowS
forall h. Show h => Token h -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall h. Show h => Int -> Token h -> ShowS
showsPrec :: Int -> Token h -> ShowS
$cshow :: forall h. Show h => Token h -> String
show :: Token h -> String
$cshowList :: forall h. Show h => [Token h] -> ShowS
showList :: [Token h] -> ShowS
Show)

class Accumulate h where
  accumulate :: [Token h] -> h
  fromBytes :: ByteString -> h
  toBytes :: h -> ByteString

accumulateToken :: (Accumulate h, Hashable t) => t -> Token h
accumulateToken :: forall h t. (Accumulate h, Hashable t) => t -> Token h
accumulateToken = h -> Token h
forall h. h -> Token h
Hashed (h -> Token h) -> (t -> h) -> t -> Token h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> h
forall h t. (Accumulate h, Hashable t) => t -> h
accumulate'

hash, accumulate' :: (Accumulate h, Hashable t) => t -> h
accumulate' :: forall h t. (Accumulate h, Hashable t) => t -> h
accumulate' = [Token h] -> h
forall h. Accumulate h => [Token h] -> h
accumulate ([Token h] -> h) -> (t -> [Token h]) -> t -> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [Token h]
forall t h. (Hashable t, Accumulate h) => t -> [Token h]
forall h. Accumulate h => t -> [Token h]
tokens
hash :: forall h t. (Accumulate h, Hashable t) => t -> h
hash = t -> h
forall h t. (Accumulate h, Hashable t) => t -> h
accumulate'

-- | NOTE: This typeclass is distinct from 'Unison.Hashing.V2.Hashable', which is the
-- content-based hashish class used for Unison types & terms.
--
-- This class however, is meant only to be used as a utility when hash-based identities are
-- useful in algorithms, the runtime, etc.
-- Consider carefully which class you want in each use-case.
class Hashable t where
  tokens :: (Accumulate h) => t -> [Token h]

instance (Hashable a) => Hashable [a] where
  tokens :: forall h. Accumulate h => [a] -> [Token h]
tokens = (a -> Token h) -> [a] -> [Token h]
forall a b. (a -> b) -> [a] -> [b]
map a -> Token h
forall h t. (Accumulate h, Hashable t) => t -> Token h
accumulateToken

instance (Hashable a, Hashable b) => Hashable (a, b) where
  tokens :: forall h. Accumulate h => (a, b) -> [Token h]
tokens (a
a, b
b) = [a -> Token h
forall h t. (Accumulate h, Hashable t) => t -> Token h
accumulateToken a
a, b -> Token h
forall h t. (Accumulate h, Hashable t) => t -> Token h
accumulateToken b
b]

instance (Hashable a) => Hashable (Set.Set a) where
  tokens :: forall h. Accumulate h => Set a -> [Token h]
tokens = [a] -> [Token h]
forall t h. (Hashable t, Accumulate h) => t -> [Token h]
forall h. Accumulate h => [a] -> [Token h]
tokens ([a] -> [Token h]) -> (Set a -> [a]) -> Set a -> [Token h]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList

instance (Hashable k, Hashable v) => Hashable (Map.Map k v) where
  tokens :: forall h. Accumulate h => Map k v -> [Token h]
tokens = [(k, v)] -> [Token h]
forall t h. (Hashable t, Accumulate h) => t -> [Token h]
forall h. Accumulate h => [(k, v)] -> [Token h]
tokens ([(k, v)] -> [Token h])
-> (Map k v -> [(k, v)]) -> Map k v -> [Token h]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList

instance (Hashable a, Hashable b) => Hashable (Relation a b) where
  tokens :: forall h. Accumulate h => Relation a b -> [Token h]
tokens = [(a, b)] -> [Token h]
forall t h. (Hashable t, Accumulate h) => t -> [Token h]
forall h. Accumulate h => [(a, b)] -> [Token h]
tokens ([(a, b)] -> [Token h])
-> (Relation a b -> [(a, b)]) -> Relation a b -> [Token h]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Relation a b -> [(a, b)]
forall a b. Relation a b -> [(a, b)]
Relation.toList

instance (Hashable d1, Hashable d2, Hashable d3) => Hashable (Relation3 d1 d2 d3) where
  tokens :: forall h. Accumulate h => Relation3 d1 d2 d3 -> [Token h]
tokens Relation3 d1 d2 d3
s = [[(d1, (d2, d3))] -> Token h
forall h t. (Accumulate h, Hashable t) => t -> Token h
accumulateToken ([(d1, (d2, d3))] -> Token h) -> [(d1, (d2, d3))] -> Token h
forall a b. (a -> b) -> a -> b
$ Relation3 d1 d2 d3 -> [(d1, (d2, d3))]
forall a b c. Relation3 a b c -> [(a, (b, c))]
Relation3.toNestedList Relation3 d1 d2 d3
s]

instance (Hashable d1, Hashable d2, Hashable d3, Hashable d4) => Hashable (Relation4 d1 d2 d3 d4) where
  tokens :: forall h. Accumulate h => Relation4 d1 d2 d3 d4 -> [Token h]
tokens Relation4 d1 d2 d3 d4
s = [[(d1, (d2, (d3, d4)))] -> Token h
forall h t. (Accumulate h, Hashable t) => t -> Token h
accumulateToken ([(d1, (d2, (d3, d4)))] -> Token h)
-> [(d1, (d2, (d3, d4)))] -> Token h
forall a b. (a -> b) -> a -> b
$ Relation4 d1 d2 d3 d4 -> [(d1, (d2, (d3, d4)))]
forall a b c d. Relation4 a b c d -> [(a, (b, (c, d)))]
Relation4.toNestedList Relation4 d1 d2 d3 d4
s]

instance Hashable () where
  tokens :: forall h. Accumulate h => () -> [Token h]
tokens ()
_ = []

instance Hashable Double where
  tokens :: forall h. Accumulate h => Double -> [Token h]
tokens Double
d = [Double -> Token h
forall h. Double -> Token h
Double Double
d]

instance Hashable Text where
  tokens :: forall h. Accumulate h => Text -> [Token h]
tokens Text
s = [Text -> Token h
forall h. Text -> Token h
Text Text
s]

instance Hashable Char where
  tokens :: forall h. Accumulate h => Char -> [Token h]
tokens Char
c = [Word64 -> Token h
forall h. Word64 -> Token h
Nat (Word64 -> Token h) -> Word64 -> Token h
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c]

instance Hashable ByteString where
  tokens :: forall h. Accumulate h => ByteString -> [Token h]
tokens ByteString
bs = [ByteString -> Token h
forall h. ByteString -> Token h
Bytes ByteString
bs]

instance Hashable Word64 where
  tokens :: forall h. Accumulate h => Word64 -> [Token h]
tokens Word64
w = [Word64 -> Token h
forall h. Word64 -> Token h
Nat Word64
w]

instance Hashable Int64 where
  tokens :: forall h. Accumulate h => Int64 -> [Token h]
tokens Int64
w = [Int64 -> Token h
forall h. Int64 -> Token h
Int Int64
w]

instance Hashable Bool where
  tokens :: forall h. Accumulate h => Bool -> [Token h]
tokens Bool
b = [Word8 -> Token h
forall h. Word8 -> Token h
Tag (Word8 -> Token h) -> (Int -> Word8) -> Int -> Token h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Token h) -> Int -> Token h
forall a b. (a -> b) -> a -> b
$ Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
b]

instance Hashable Hash where
  tokens :: forall h. Accumulate h => Hash -> [Token h]
tokens Hash
h = [ByteString -> Token h
forall h. ByteString -> Token h
Bytes (Hash -> ByteString
Hash.toByteString Hash
h)]

instance Accumulate Hash where
  accumulate :: [Token Hash] -> Hash
accumulate = ByteString -> Hash
forall h. Accumulate h => ByteString -> h
fromBytes (ByteString -> Hash)
-> ([Token Hash] -> ByteString) -> [Token Hash] -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA3_512 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest SHA3_512 -> ByteString)
-> ([Token Hash] -> Digest SHA3_512) -> [Token Hash] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SHA3_512 -> Digest SHA3_512
forall a. HashAlgorithm a => Context a -> Digest a
CH.hashFinalize (Context SHA3_512 -> Digest SHA3_512)
-> ([Token Hash] -> Context SHA3_512)
-> [Token Hash]
-> Digest SHA3_512
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context SHA3_512 -> [Token Hash] -> Context SHA3_512
go Context SHA3_512
forall a. HashAlgorithm a => Context a
CH.hashInit
    where
      go :: CH.Context CH.SHA3_512 -> [Token Hash] -> CH.Context CH.SHA3_512
      go :: Context SHA3_512 -> [Token Hash] -> Context SHA3_512
go Context SHA3_512
acc [Token Hash]
tokens = Context SHA3_512 -> [ByteString] -> Context SHA3_512
forall a ba.
(HashAlgorithm a, ByteArrayAccess ba) =>
Context a -> [ba] -> Context a
CH.hashUpdates Context SHA3_512
acc ([Token Hash]
tokens [Token Hash] -> (Token Hash -> [ByteString]) -> [ByteString]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token Hash -> [ByteString]
toBS)
      toBS :: Token Hash -> [ByteString]
toBS (Tag Word8
b) = [Word8 -> ByteString
B.singleton Word8
b]
      toBS (Bytes ByteString
bs) = [Int -> ByteString
forall n. Integral n => n -> ByteString
encodeLength (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
bs, ByteString
bs]
      toBS (Int Int64
i) = ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> (Int64 -> ByteString) -> Int64 -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Int64 -> Builder) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
int64BE (Int64 -> [ByteString]) -> Int64 -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int64
i
      toBS (Nat Word64
i) = ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> (Word64 -> ByteString) -> Word64 -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Word64 -> Builder) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
word64BE (Word64 -> [ByteString]) -> Word64 -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Word64
i
      toBS (Double Double
d) = ByteString -> [ByteString]
BL.toChunks (ByteString -> [ByteString])
-> (Double -> ByteString) -> Double -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Double -> Builder) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
doubleBE (Double -> [ByteString]) -> Double -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Double
d
      toBS (Text Text
txt) =
        let tbytes :: ByteString
tbytes = Text -> ByteString
encodeUtf8 Text
txt
         in [Int -> ByteString
forall n. Integral n => n -> ByteString
encodeLength (ByteString -> Int
B.length ByteString
tbytes), ByteString
tbytes]
      toBS (Hashed Hash
h) = [Hash -> ByteString
Hash.toByteString Hash
h]
      encodeLength :: (Integral n) => n -> B.ByteString
      encodeLength :: forall n. Integral n => n -> ByteString
encodeLength = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (n -> ByteString) -> n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> (n -> Builder) -> n -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Builder
word64BE (Word64 -> Builder) -> (n -> Word64) -> n -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
  fromBytes :: ByteString -> Hash
fromBytes = ByteString -> Hash
Hash.fromByteString
  toBytes :: Hash -> ByteString
toBytes = Hash -> ByteString
Hash.toByteString