{-# 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,
  EraIndependentTxAuxData,
  EraIndependentPParamView,
  EraIndependentScriptIntegrity,

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

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Binary (DecCBOR, EncCBOR)
import Cardano.Ledger.Binary.Plain (FromCBOR, ToCBOR)
import Cardano.Ledger.Crypto (ADDRHASH, Crypto)
import Cardano.Ledger.SafeHash (SafeHash)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
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 EraIndependentTxAuxData

data EraIndependentScript

data EraIndependentData

type DataHash c = SafeHash c EraIndependentData

data EraIndependentScriptData

data EraIndependentPParamView

data EraIndependentScriptIntegrity

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

deriving newtype instance Crypto c => ToCBOR (ScriptHash c)

deriving newtype instance Crypto c => FromCBOR (ScriptHash c)

deriving newtype instance Crypto c => EncCBOR (ScriptHash c)

deriving newtype instance Crypto c => DecCBOR (ScriptHash c)

deriving newtype instance Crypto c => ToJSON (ScriptHash c)

deriving newtype instance Crypto c => FromJSON (ScriptHash c)

deriving newtype instance Crypto c => ToJSONKey (ScriptHash c)

deriving newtype instance Crypto c => FromJSONKey (ScriptHash c)