{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.SafeHash
  ( SafeHash,
    SafeToHash (..),
    castSafeHash,
    HashAnnotated,
    hashAnnotated,
    indexProxy,
    HashWithCrypto (..),
    HasAlgorithm,
    extractHash,
    hashSafeList,
    Safe (..),
    unsafeMakeSafeHash,
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Ledger.Crypto as CC
import Cardano.Prelude (HeapWords (..))
import Control.DeepSeq (NFData)
import Data.ByteString (ByteString)
import Data.ByteString.Short (ShortByteString, fromShort)
import Data.Foldable (fold)
import Data.MemoBytes (MemoBytes (..))
import Data.Typeable
import NoThunks.Class (NoThunks (..))

-- ==========================================================

-- | A SafeHash is a hash of something that is safe to hash. Such types store
--     their own serialisation bytes. The prime example is (MemoBytes t), but other
--     examples are things that consist of only ByteStrings.
--
--     We do NOT export the constructor SafeHash, but instead export other functions
--     such as 'hashWithCrypto, 'hashAnnotated' and 'extractHash' which have constraints
--     that limit their application to types which preserve their original serialization
--     bytes.
newtype SafeHash crypto index = SafeHash (Hash.Hash (CC.HASH crypto) index)
  deriving (Int -> SafeHash crypto index -> ShowS
[SafeHash crypto index] -> ShowS
SafeHash crypto index -> String
(Int -> SafeHash crypto index -> ShowS)
-> (SafeHash crypto index -> String)
-> ([SafeHash crypto index] -> ShowS)
-> Show (SafeHash crypto index)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall crypto index. Int -> SafeHash crypto index -> ShowS
forall crypto index. [SafeHash crypto index] -> ShowS
forall crypto index. SafeHash crypto index -> String
showList :: [SafeHash crypto index] -> ShowS
$cshowList :: forall crypto index. [SafeHash crypto index] -> ShowS
show :: SafeHash crypto index -> String
$cshow :: forall crypto index. SafeHash crypto index -> String
showsPrec :: Int -> SafeHash crypto index -> ShowS
$cshowsPrec :: forall crypto index. Int -> SafeHash crypto index -> ShowS
Show, SafeHash crypto index -> SafeHash crypto index -> Bool
(SafeHash crypto index -> SafeHash crypto index -> Bool)
-> (SafeHash crypto index -> SafeHash crypto index -> Bool)
-> Eq (SafeHash crypto index)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
/= :: SafeHash crypto index -> SafeHash crypto index -> Bool
$c/= :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
== :: SafeHash crypto index -> SafeHash crypto index -> Bool
$c== :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
Eq, Eq (SafeHash crypto index)
Eq (SafeHash crypto index)
-> (SafeHash crypto index -> SafeHash crypto index -> Ordering)
-> (SafeHash crypto index -> SafeHash crypto index -> Bool)
-> (SafeHash crypto index -> SafeHash crypto index -> Bool)
-> (SafeHash crypto index -> SafeHash crypto index -> Bool)
-> (SafeHash crypto index -> SafeHash crypto index -> Bool)
-> (SafeHash crypto index
    -> SafeHash crypto index -> SafeHash crypto index)
-> (SafeHash crypto index
    -> SafeHash crypto index -> SafeHash crypto index)
-> Ord (SafeHash crypto index)
SafeHash crypto index -> SafeHash crypto index -> Bool
SafeHash crypto index -> SafeHash crypto index -> Ordering
SafeHash crypto index
-> SafeHash crypto index -> SafeHash crypto index
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall crypto index. Eq (SafeHash crypto index)
forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Ordering
forall crypto index.
SafeHash crypto index
-> SafeHash crypto index -> SafeHash crypto index
min :: SafeHash crypto index
-> SafeHash crypto index -> SafeHash crypto index
$cmin :: forall crypto index.
SafeHash crypto index
-> SafeHash crypto index -> SafeHash crypto index
max :: SafeHash crypto index
-> SafeHash crypto index -> SafeHash crypto index
$cmax :: forall crypto index.
SafeHash crypto index
-> SafeHash crypto index -> SafeHash crypto index
>= :: SafeHash crypto index -> SafeHash crypto index -> Bool
$c>= :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
> :: SafeHash crypto index -> SafeHash crypto index -> Bool
$c> :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
<= :: SafeHash crypto index -> SafeHash crypto index -> Bool
$c<= :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
< :: SafeHash crypto index -> SafeHash crypto index -> Bool
$c< :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Bool
compare :: SafeHash crypto index -> SafeHash crypto index -> Ordering
$ccompare :: forall crypto index.
SafeHash crypto index -> SafeHash crypto index -> Ordering
$cp1Ord :: forall crypto index. Eq (SafeHash crypto index)
Ord, Context -> SafeHash crypto index -> IO (Maybe ThunkInfo)
Proxy (SafeHash crypto index) -> String
(Context -> SafeHash crypto index -> IO (Maybe ThunkInfo))
-> (Context -> SafeHash crypto index -> IO (Maybe ThunkInfo))
-> (Proxy (SafeHash crypto index) -> String)
-> NoThunks (SafeHash crypto index)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall crypto index.
Context -> SafeHash crypto index -> IO (Maybe ThunkInfo)
forall crypto index. Proxy (SafeHash crypto index) -> String
showTypeOf :: Proxy (SafeHash crypto index) -> String
$cshowTypeOf :: forall crypto index. Proxy (SafeHash crypto index) -> String
wNoThunks :: Context -> SafeHash crypto index -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto index.
Context -> SafeHash crypto index -> IO (Maybe ThunkInfo)
noThunks :: Context -> SafeHash crypto index -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto index.
Context -> SafeHash crypto index -> IO (Maybe ThunkInfo)
NoThunks, SafeHash crypto index -> ()
(SafeHash crypto index -> ()) -> NFData (SafeHash crypto index)
forall a. (a -> ()) -> NFData a
forall crypto index. SafeHash crypto index -> ()
rnf :: SafeHash crypto index -> ()
$crnf :: forall crypto index. SafeHash crypto index -> ()
NFData)

deriving newtype instance
  Hash.HashAlgorithm (CC.HASH crypto) =>
  SafeToHash (SafeHash crypto index)

deriving newtype instance HeapWords (Hash.Hash (CC.HASH c) i) => HeapWords (SafeHash c i)

deriving instance (Typeable index, CC.Crypto c) => ToCBOR (SafeHash c index)

deriving instance (Typeable index, CC.Crypto c) => FromCBOR (SafeHash c index)

type HasAlgorithm c = Hash.HashAlgorithm (CC.HASH c)

extractHash :: SafeHash crypto i -> Hash.Hash (CC.HASH crypto) i
extractHash :: SafeHash crypto i -> Hash (HASH crypto) i
extractHash (SafeHash Hash (HASH crypto) i
h) = Hash (HASH crypto) i
h

-- | To change the index parameter of SafeHash (which is a phantom type) use castSafeHash
castSafeHash :: forall i j c. SafeHash c i -> SafeHash c j
castSafeHash :: SafeHash c i -> SafeHash c j
castSafeHash (SafeHash Hash (HASH c) i
h) = Hash (HASH c) j -> SafeHash c j
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
SafeHash (Hash (HASH c) i -> Hash (HASH c) j
forall h a b. Hash h a -> Hash h b
Hash.castHash Hash (HASH c) i
h)

-- Don't use this except in Testing to make Arbitrary instances, etc.
unsafeMakeSafeHash :: Hash.Hash (CC.HASH crypto) index -> SafeHash crypto index
unsafeMakeSafeHash :: Hash (HASH crypto) index -> SafeHash crypto index
unsafeMakeSafeHash = Hash (HASH crypto) index -> SafeHash crypto index
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
SafeHash

-- =====================================================================

-- | Only Types that preserve their serialisation bytes are members of the
--   class SafeToHash. There are only a limited number of primitive direct
--   instances of SafeToHash, all but two of them are present in this file. Instead
--   of making explicit instances, we almost always use a newtype (around a type S)
--   where their is already an instance (SafeToHash S). In that case the newtype
--   has its SafeToHash instance derived using newtype deriving. The only exceptions
--   are the legacy Shelley types: Metadata and Tx, that preserve their serialisation bytes
--   using a different mechanism than MemoBytes.  SafeToHash is a superclass
--   requirement of the classes HashAnnotated and HashWithCrypto (below) which
--   provide more convenient ways to construct SafeHashes than using makeHashWithExplicitProxys.
class SafeToHash t where
  originalBytes :: t -> ByteString
  makeHashWithExplicitProxys :: HasAlgorithm c => Proxy c -> Proxy index -> t -> SafeHash c index
  makeHashWithExplicitProxys Proxy c
_ Proxy index
_ t
x = Hash (HASH c) index -> SafeHash c index
forall crypto index.
Hash (HASH crypto) index -> SafeHash crypto index
SafeHash (Hash (HASH c) index -> SafeHash c index)
-> Hash (HASH c) index -> SafeHash c index
forall a b. (a -> b) -> a -> b
$ Hash (HASH c) t -> Hash (HASH c) index
forall h a b. Hash h a -> Hash h b
Hash.castHash ((t -> ByteString) -> t -> Hash (HASH c) t
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith t -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes t
x)

-- There are a limited number of direct instances. Everything else should come
-- from newtype deriving.

instance SafeToHash (MemoBytes t) where
  originalBytes :: MemoBytes t -> ByteString
originalBytes = ShortByteString -> ByteString
fromShort (ShortByteString -> ByteString)
-> (MemoBytes t -> ShortByteString) -> MemoBytes t -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoBytes t -> ShortByteString
forall t. MemoBytes t -> ShortByteString
memobytes

instance SafeToHash ShortByteString where
  originalBytes :: ShortByteString -> ByteString
originalBytes ShortByteString
x = ShortByteString -> ByteString
fromShort ShortByteString
x

instance SafeToHash ByteString where
  originalBytes :: ByteString -> ByteString
originalBytes ByteString
x = ByteString
x

-- If one looks at the deriving clause in the definitions of SafeHash, we see that we
-- derive that it is SafeToHash. We can derive this instance because SafeHash is
-- a newtype around (Hash.Hash c i) which is a primitive SafeToHash type.

instance Hash.HashAlgorithm c => SafeToHash (Hash.Hash c i) where
  originalBytes :: Hash c i -> ByteString
originalBytes = Hash c i -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes

-- =====================================================================
{- Types that are SafeToHash, AND have both of the following two invariants,
     are made members of the HashAnnotated class. The preconditions are:
     1) The type uniquely determines the 'index' type tag of (SafeHash crypto index)
     2) The type uniquely determines the 'crypto' type of (SafeHash crytop index)

     The SafeToHash and the HashAnnotated classes are designed so that their
     instances can be easily derived (because their methods have default methods
     when the type is a newtype around a type that is SafeToHash). For example,
     given (SafeToHash S) then:

     newtype T era = T S
        deriving Eq
        deriving newtype SafeToHash   -- Uses {-# LANGUAGE DerivingStrategies #-}

     instance HashAnnotated (T era) Index (Crypto era)

     After these declarations. One specialization of 'hashAnnotated' is
     hashAnnotated :: Era e => T e -> SafeHash (Crypto e) Index
-}

-- | Determine the index from the type 'x'
class SafeToHash x => HashAnnotated x index crypto | x -> index crypto where
  indexProxy :: x -> Proxy index
  indexProxy x
_ = Proxy index
forall k (t :: k). Proxy t
Proxy @index

hashAnnotated :: forall c i x. (HasAlgorithm c, HashAnnotated x i c) => x -> SafeHash c i
hashAnnotated :: x -> SafeHash c i
hashAnnotated = Proxy c -> Proxy i -> x -> SafeHash c i
forall t c index.
(SafeToHash t, HasAlgorithm c) =>
Proxy c -> Proxy index -> t -> SafeHash c index
makeHashWithExplicitProxys (Proxy c
forall k (t :: k). Proxy t
Proxy @c) (Proxy i
forall k (t :: k). Proxy t
Proxy @i)

-- ========================================================================

-- | When the type being hashed: 'x' determines the 'index' tag but not the 'crypto'
class SafeToHash x => HashWithCrypto x index | x -> index where
  hashWithCrypto :: forall crypto. HasAlgorithm crypto => Proxy crypto -> x -> SafeHash crypto index
  hashWithCrypto Proxy crypto
proxy x
y = Proxy crypto -> Proxy index -> x -> SafeHash crypto index
forall t c index.
(SafeToHash t, HasAlgorithm c) =>
Proxy c -> Proxy index -> t -> SafeHash c index
makeHashWithExplicitProxys Proxy crypto
proxy (Proxy index
forall k (t :: k). Proxy t
Proxy @index) x
y

-- ======================================================================

-- | Sometimes one wants to hash multiple things, simply by concatenating
--   all the bytes. This abstraction allows one to do that safely.
data Safe where
  Safe :: SafeToHash x => x -> Safe

instance SafeToHash Safe where
  originalBytes :: Safe -> ByteString
originalBytes (Safe x
x) = x -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes x
x

hashSafeList :: HasAlgorithm c => Proxy c -> Proxy index -> [Safe] -> SafeHash c index
hashSafeList :: Proxy c -> Proxy index -> [Safe] -> SafeHash c index
hashSafeList Proxy c
pc Proxy index
pindex [Safe]
xs = Proxy c -> Proxy index -> ByteString -> SafeHash c index
forall t c index.
(SafeToHash t, HasAlgorithm c) =>
Proxy c -> Proxy index -> t -> SafeHash c index
makeHashWithExplicitProxys Proxy c
pc Proxy index
pindex ([ByteString] -> ByteString
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Safe -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes (Safe -> ByteString) -> [Safe] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Safe]
xs)