{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Various identifiers in the ledger are hashes of particular structures.
-- While the structures may change from era to era, the hash will remain the
-- same, and we can refer to the hash of, say, a transaction, without knowing
-- the actual transaction type. As such, we define a number of these hashes
-- here.
module Cardano.Ledger.Hashes
  ( -- * Era-independent hash type identifiers.
    -- $eraIndep
    EraIndependentTxBody,
    EraIndependentBlockHeader,
    EraIndependentBlockBody,
    EraIndependentMetadata,
    EraIndependentScript,
    EraIndependentData,
    EraIndependentScriptData,
    EraIndependentAuxiliaryData,
    EraIndependentPParamView,
    EraIndependentScriptIntegrity,

    -- * Script hashes
    ScriptHash (..),
    DataHash,
  )
where

import Cardano.Binary (FromCBOR, ToCBOR)
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Crypto (ADDRHASH)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.SafeHash (SafeHash)
import Control.DeepSeq (NFData)
import Data.Aeson
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))

--   $eraIndep
--
--   Hashes carry around a phantom type parameter to identify the sort of thing
--   they are hashing. This is useful to allow us to distinguish, say, a place
--   where we expect the hash for a block from the hash for a script. However,
--   the exact structure that makes up a "block" will differ from era to era. We
--   still want to share the same namespace for the identifiers. Consequently we
--   define some era-independent indices here.

data EraIndependentTxBody

data EraIndependentBlockHeader

data EraIndependentBlockBody

data EraIndependentMetadata

data EraIndependentAuxiliaryData

data EraIndependentScript

data EraIndependentData

type DataHash crypto = SafeHash crypto EraIndependentData

data EraIndependentScriptData

data EraIndependentPParamView

data EraIndependentScriptIntegrity

newtype ScriptHash crypto
  = ScriptHash (Hash.Hash (ADDRHASH crypto) EraIndependentScript)
  deriving (Int -> ScriptHash crypto -> ShowS
[ScriptHash crypto] -> ShowS
ScriptHash crypto -> String
(Int -> ScriptHash crypto -> ShowS)
-> (ScriptHash crypto -> String)
-> ([ScriptHash crypto] -> ShowS)
-> Show (ScriptHash crypto)
forall crypto. Int -> ScriptHash crypto -> ShowS
forall crypto. [ScriptHash crypto] -> ShowS
forall crypto. ScriptHash crypto -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScriptHash crypto] -> ShowS
$cshowList :: forall crypto. [ScriptHash crypto] -> ShowS
show :: ScriptHash crypto -> String
$cshow :: forall crypto. ScriptHash crypto -> String
showsPrec :: Int -> ScriptHash crypto -> ShowS
$cshowsPrec :: forall crypto. Int -> ScriptHash crypto -> ShowS
Show, ScriptHash crypto -> ScriptHash crypto -> Bool
(ScriptHash crypto -> ScriptHash crypto -> Bool)
-> (ScriptHash crypto -> ScriptHash crypto -> Bool)
-> Eq (ScriptHash crypto)
forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScriptHash crypto -> ScriptHash crypto -> Bool
$c/= :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
== :: ScriptHash crypto -> ScriptHash crypto -> Bool
$c== :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
Eq, Eq (ScriptHash crypto)
Eq (ScriptHash crypto)
-> (ScriptHash crypto -> ScriptHash crypto -> Ordering)
-> (ScriptHash crypto -> ScriptHash crypto -> Bool)
-> (ScriptHash crypto -> ScriptHash crypto -> Bool)
-> (ScriptHash crypto -> ScriptHash crypto -> Bool)
-> (ScriptHash crypto -> ScriptHash crypto -> Bool)
-> (ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto)
-> (ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto)
-> Ord (ScriptHash crypto)
ScriptHash crypto -> ScriptHash crypto -> Bool
ScriptHash crypto -> ScriptHash crypto -> Ordering
ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto
forall crypto. Eq (ScriptHash crypto)
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. ScriptHash crypto -> ScriptHash crypto -> Bool
forall crypto. ScriptHash crypto -> ScriptHash crypto -> Ordering
forall crypto.
ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto
min :: ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto
$cmin :: forall crypto.
ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto
max :: ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto
$cmax :: forall crypto.
ScriptHash crypto -> ScriptHash crypto -> ScriptHash crypto
>= :: ScriptHash crypto -> ScriptHash crypto -> Bool
$c>= :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
> :: ScriptHash crypto -> ScriptHash crypto -> Bool
$c> :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
<= :: ScriptHash crypto -> ScriptHash crypto -> Bool
$c<= :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
< :: ScriptHash crypto -> ScriptHash crypto -> Bool
$c< :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Bool
compare :: ScriptHash crypto -> ScriptHash crypto -> Ordering
$ccompare :: forall crypto. ScriptHash crypto -> ScriptHash crypto -> Ordering
$cp1Ord :: forall crypto. Eq (ScriptHash crypto)
Ord, (forall x. ScriptHash crypto -> Rep (ScriptHash crypto) x)
-> (forall x. Rep (ScriptHash crypto) x -> ScriptHash crypto)
-> Generic (ScriptHash crypto)
forall x. Rep (ScriptHash crypto) x -> ScriptHash crypto
forall x. ScriptHash crypto -> Rep (ScriptHash crypto) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall crypto x. Rep (ScriptHash crypto) x -> ScriptHash crypto
forall crypto x. ScriptHash crypto -> Rep (ScriptHash crypto) x
$cto :: forall crypto x. Rep (ScriptHash crypto) x -> ScriptHash crypto
$cfrom :: forall crypto x. ScriptHash crypto -> Rep (ScriptHash crypto) x
Generic)
  deriving newtype (ScriptHash crypto -> ()
(ScriptHash crypto -> ()) -> NFData (ScriptHash crypto)
forall crypto. ScriptHash crypto -> ()
forall a. (a -> ()) -> NFData a
rnf :: ScriptHash crypto -> ()
$crnf :: forall crypto. ScriptHash crypto -> ()
NFData, Context -> ScriptHash crypto -> IO (Maybe ThunkInfo)
Proxy (ScriptHash crypto) -> String
(Context -> ScriptHash crypto -> IO (Maybe ThunkInfo))
-> (Context -> ScriptHash crypto -> IO (Maybe ThunkInfo))
-> (Proxy (ScriptHash crypto) -> String)
-> NoThunks (ScriptHash crypto)
forall crypto. Context -> ScriptHash crypto -> IO (Maybe ThunkInfo)
forall crypto. Proxy (ScriptHash crypto) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ScriptHash crypto) -> String
$cshowTypeOf :: forall crypto. Proxy (ScriptHash crypto) -> String
wNoThunks :: Context -> ScriptHash crypto -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall crypto. Context -> ScriptHash crypto -> IO (Maybe ThunkInfo)
noThunks :: Context -> ScriptHash crypto -> IO (Maybe ThunkInfo)
$cnoThunks :: forall crypto. Context -> ScriptHash crypto -> IO (Maybe ThunkInfo)
NoThunks)

deriving newtype instance CC.Crypto crypto => ToCBOR (ScriptHash crypto)

deriving newtype instance CC.Crypto crypto => FromCBOR (ScriptHash crypto)

deriving newtype instance CC.Crypto crypto => ToJSON (ScriptHash crypto)

deriving newtype instance CC.Crypto crypto => FromJSON (ScriptHash crypto)