{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
-- This is needed for the `HeapWords (StrictMaybe (DataHash c))` instance
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cardano.Ledger.Plutus.Data (
  PlutusData (..),
  Data (Data),
  unData,
  DataHash,
  upgradeData,
  hashData,
  getPlutusData,
  dataHashSize,
  BinaryData,
  hashBinaryData,
  makeBinaryData,
  binaryDataToData,
  dataToBinaryData,
  Datum (..),
  datumDataHash,
  translateDatum,
)
where

import Cardano.Crypto.Hash.Class (HashAlgorithm)
import Cardano.HeapWords (HeapWords (..), heapWords0, heapWords1)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  ToCBOR (..),
  decodeFullAnnotator,
  decodeNestedCborBytes,
  encodeTag,
  fromPlainDecoder,
  fromPlainEncoding,
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core
import Cardano.Ledger.Crypto (Crypto (HASH))
import Cardano.Ledger.MemoBytes (
  Mem,
  MemoBytes (..),
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  mkMemoBytes,
  mkMemoized,
  shortToLazy,
 )
import Cardano.Ledger.SafeHash (
  HashAnnotated,
  SafeToHash (..),
  hashAnnotated,
 )
import qualified Codec.Serialise as Cborg (Serialise (..))
import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON (..), Value (Null))
import Data.ByteString.Lazy (fromStrict)
import Data.ByteString.Short (ShortByteString, fromShort, toShort)
import Data.Coerce (coerce)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.V1 as PV1

-- ============================================================================
-- the newtype Data is a wrapper around the type that Plutus expects as data.
-- The newtype will memoize the serialized bytes.

-- | This is a wrapper with a phantom era for PV1.Data, since we need
-- something with kind (* -> *) for MemoBytes
newtype PlutusData era = PlutusData PV1.Data
  deriving newtype (PlutusData era -> PlutusData era -> Bool
forall era. PlutusData era -> PlutusData era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlutusData era -> PlutusData era -> Bool
$c/= :: forall era. PlutusData era -> PlutusData era -> Bool
== :: PlutusData era -> PlutusData era -> Bool
$c== :: forall era. PlutusData era -> PlutusData era -> Bool
Eq, forall x. Rep (PlutusData era) x -> PlutusData era
forall x. PlutusData era -> Rep (PlutusData era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PlutusData era) x -> PlutusData era
forall era x. PlutusData era -> Rep (PlutusData era) x
to :: forall x. Rep (PlutusData era) x -> PlutusData era
$cto :: forall era x. Rep (PlutusData era) x -> PlutusData era
from :: forall x. PlutusData era -> Rep (PlutusData era) x
$cfrom :: forall era x. PlutusData era -> Rep (PlutusData era) x
Generic, Int -> PlutusData era -> ShowS
[PlutusData era] -> ShowS
PlutusData era -> String
forall era. Int -> PlutusData era -> ShowS
forall era. [PlutusData era] -> ShowS
forall era. PlutusData era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlutusData era] -> ShowS
$cshowList :: forall era. [PlutusData era] -> ShowS
show :: PlutusData era -> String
$cshow :: forall era. PlutusData era -> String
showsPrec :: Int -> PlutusData era -> ShowS
$cshowsPrec :: forall era. Int -> PlutusData era -> ShowS
Show, PlutusData era -> ()
forall era. PlutusData era -> ()
forall a. (a -> ()) -> NFData a
rnf :: PlutusData era -> ()
$crnf :: forall era. PlutusData era -> ()
NFData, Context -> PlutusData era -> IO (Maybe ThunkInfo)
Proxy (PlutusData era) -> String
forall era. Context -> PlutusData era -> IO (Maybe ThunkInfo)
forall era. Proxy (PlutusData era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (PlutusData era) -> String
$cshowTypeOf :: forall era. Proxy (PlutusData era) -> String
wNoThunks :: Context -> PlutusData era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> PlutusData era -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusData era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> PlutusData era -> IO (Maybe ThunkInfo)
NoThunks, [PlutusData era] -> Encoding
PlutusData era -> Encoding
forall s. Decoder s [PlutusData era]
forall s. Decoder s (PlutusData era)
forall era. [PlutusData era] -> Encoding
forall era. PlutusData era -> Encoding
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
forall era s. Decoder s [PlutusData era]
forall era s. Decoder s (PlutusData era)
decodeList :: forall s. Decoder s [PlutusData era]
$cdecodeList :: forall era s. Decoder s [PlutusData era]
encodeList :: [PlutusData era] -> Encoding
$cencodeList :: forall era. [PlutusData era] -> Encoding
decode :: forall s. Decoder s (PlutusData era)
$cdecode :: forall era s. Decoder s (PlutusData era)
encode :: PlutusData era -> Encoding
$cencode :: forall era. PlutusData era -> Encoding
Cborg.Serialise)

instance Typeable era => EncCBOR (PlutusData era) where
  encCBOR :: PlutusData era -> Encoding
encCBOR (PlutusData Data
d) = Encoding -> Encoding
fromPlainEncoding forall a b. (a -> b) -> a -> b
$ forall a. Serialise a => a -> Encoding
Cborg.encode Data
d

instance Typeable era => DecCBOR (Annotator (PlutusData era)) where
  decCBOR :: forall s. Decoder s (Annotator (PlutusData era))
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. Decoder s a -> Decoder s a
fromPlainDecoder forall a s. Serialise a => Decoder s a
Cborg.decode

newtype Data era = DataConstr (MemoBytes PlutusData era)
  deriving (Data era -> Data era -> Bool
forall era. Data era -> Data era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Data era -> Data era -> Bool
$c/= :: forall era. Data era -> Data era -> Bool
== :: Data era -> Data era -> Bool
$c== :: forall era. Data era -> Data era -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Data era) x -> Data era
forall era x. Data era -> Rep (Data era) x
$cto :: forall era x. Rep (Data era) x -> Data era
$cfrom :: forall era x. Data era -> Rep (Data era) x
Generic)
  deriving newtype (Data era -> Int
Data era -> ByteString
forall era. Data era -> Int
forall era. Data era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Data era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Data era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Data era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> Data era -> SafeHash c index
originalBytesSize :: Data era -> Int
$coriginalBytesSize :: forall era. Data era -> Int
originalBytes :: Data era -> ByteString
$coriginalBytes :: forall era. Data era -> ByteString
SafeToHash, Data era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Data era] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Data era) -> Size
forall {era}. Typeable era => Typeable (Data era)
forall era. Typeable era => Data era -> Encoding
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Data era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Data era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Data era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Data era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Data era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy (Data era) -> Size
toCBOR :: Data era -> Encoding
$ctoCBOR :: forall era. Typeable era => Data era -> Encoding
ToCBOR, Data era -> ()
forall era. Data era -> ()
forall a. (a -> ()) -> NFData a
rnf :: Data era -> ()
$crnf :: forall era. Data era -> ()
NFData)

-- | Encodes memoized bytes created upon construction.
instance Typeable era => EncCBOR (Data era)

instance Memoized Data where
  type RawType Data = PlutusData

deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (Data era)

deriving via Mem PlutusData era instance Era era => DecCBOR (Annotator (Data era))

type instance MemoHashIndex PlutusData = EraIndependentData

instance EraCrypto era ~ c => HashAnnotated (Data era) EraIndependentData c where
  hashAnnotated :: HashAlgorithm (HASH c) => Data era -> SafeHash c EraIndependentData
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (EraCrypto era) (MemoHashIndex (RawType t))
getMemoSafeHash

instance Typeable era => NoThunks (Data era)

pattern Data :: Era era => PV1.Data -> Data era
pattern $bData :: forall era. Era era => Data -> Data era
$mData :: forall {r} {era}.
Era era =>
Data era -> (Data -> r) -> ((# #) -> r) -> r
Data p <- (getMemoRawType -> PlutusData p)
  where
    Data Data
p = forall era (t :: * -> *).
(Era era, EncCBOR (RawType t era), Memoized t) =>
RawType t era -> t era
mkMemoized forall a b. (a -> b) -> a -> b
$ forall era. Data -> PlutusData era
PlutusData Data
p

{-# COMPLETE Data #-}

unData :: Data era -> PV1.Data
unData :: forall era. Data era -> Data
unData Data era
eraData =
  case forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType Data era
eraData of
    PlutusData Data
plutusData -> Data
plutusData

-- | Upgrade 'Data' from one era to another. While the underlying data will
-- remain the same, the memoised serialisation may change to reflect the
-- versioned serialisation of the new era.
upgradeData :: (Era era1, Era era2) => Data era1 -> Data era2
upgradeData :: forall era1 era2. (Era era1, Era era2) => Data era1 -> Data era2
upgradeData (Data Data
d) = forall era. Era era => Data -> Data era
Data Data
d

getPlutusData :: Data era -> PV1.Data
getPlutusData :: forall era. Data era -> Data
getPlutusData (forall (t :: * -> *) era. Memoized t => t era -> RawType t era
getMemoRawType -> PlutusData Data
d) = Data
d

-- | Inlined data must be stored in the most compact form because it contributes
-- to the memory overhead of the ledger state. Constructor is intentionally not
-- exported, in order to prevent invalid creation of data from arbitrary binary
-- data. Use `makeBinaryData` for smart construction.
newtype BinaryData era = BinaryData ShortByteString
  deriving newtype (BinaryData era -> BinaryData era -> Bool
forall era. BinaryData era -> BinaryData era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinaryData era -> BinaryData era -> Bool
$c/= :: forall era. BinaryData era -> BinaryData era -> Bool
== :: BinaryData era -> BinaryData era -> Bool
$c== :: forall era. BinaryData era -> BinaryData era -> Bool
Eq, Context -> BinaryData era -> IO (Maybe ThunkInfo)
Proxy (BinaryData era) -> String
forall era. Context -> BinaryData era -> IO (Maybe ThunkInfo)
forall era. Proxy (BinaryData era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (BinaryData era) -> String
$cshowTypeOf :: forall era. Proxy (BinaryData era) -> String
wNoThunks :: Context -> BinaryData era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> BinaryData era -> IO (Maybe ThunkInfo)
noThunks :: Context -> BinaryData era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> BinaryData era -> IO (Maybe ThunkInfo)
NoThunks, BinaryData era -> BinaryData era -> Bool
BinaryData era -> BinaryData era -> Ordering
BinaryData era -> BinaryData era -> BinaryData era
forall era. Eq (BinaryData era)
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 era. BinaryData era -> BinaryData era -> Bool
forall era. BinaryData era -> BinaryData era -> Ordering
forall era. BinaryData era -> BinaryData era -> BinaryData era
min :: BinaryData era -> BinaryData era -> BinaryData era
$cmin :: forall era. BinaryData era -> BinaryData era -> BinaryData era
max :: BinaryData era -> BinaryData era -> BinaryData era
$cmax :: forall era. BinaryData era -> BinaryData era -> BinaryData era
>= :: BinaryData era -> BinaryData era -> Bool
$c>= :: forall era. BinaryData era -> BinaryData era -> Bool
> :: BinaryData era -> BinaryData era -> Bool
$c> :: forall era. BinaryData era -> BinaryData era -> Bool
<= :: BinaryData era -> BinaryData era -> Bool
$c<= :: forall era. BinaryData era -> BinaryData era -> Bool
< :: BinaryData era -> BinaryData era -> Bool
$c< :: forall era. BinaryData era -> BinaryData era -> Bool
compare :: BinaryData era -> BinaryData era -> Ordering
$ccompare :: forall era. BinaryData era -> BinaryData era -> Ordering
Ord, Int -> BinaryData era -> ShowS
[BinaryData era] -> ShowS
BinaryData era -> String
forall era. Int -> BinaryData era -> ShowS
forall era. [BinaryData era] -> ShowS
forall era. BinaryData era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinaryData era] -> ShowS
$cshowList :: forall era. [BinaryData era] -> ShowS
show :: BinaryData era -> String
$cshow :: forall era. BinaryData era -> String
showsPrec :: Int -> BinaryData era -> ShowS
$cshowsPrec :: forall era. Int -> BinaryData era -> ShowS
Show, BinaryData era -> Int
BinaryData era -> ByteString
forall era. BinaryData era -> Int
forall era. BinaryData era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> BinaryData era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> BinaryData era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> BinaryData era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> BinaryData era -> SafeHash c index
originalBytesSize :: BinaryData era -> Int
$coriginalBytesSize :: forall era. BinaryData era -> Int
originalBytes :: BinaryData era -> ByteString
$coriginalBytes :: forall era. BinaryData era -> ByteString
SafeToHash)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (BinaryData era) x -> BinaryData era
forall era x. BinaryData era -> Rep (BinaryData era) x
$cto :: forall era x. Rep (BinaryData era) x -> BinaryData era
$cfrom :: forall era x. BinaryData era -> Rep (BinaryData era) x
Generic)

instance EraCrypto era ~ c => HashAnnotated (BinaryData era) EraIndependentData c

instance Typeable era => EncCBOR (BinaryData era) where
  encCBOR :: BinaryData era -> Encoding
encCBOR (BinaryData ShortByteString
sbs) = Word -> Encoding
encodeTag Word
24 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ShortByteString
sbs

instance Era era => DecCBOR (BinaryData era) where
  decCBOR :: forall s. Decoder s (BinaryData era)
decCBOR = do
    ByteString
bs <- forall s. Decoder s ByteString
decodeNestedCborBytes
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall era.
Era era =>
ShortByteString -> Either String (BinaryData era)
makeBinaryData (ByteString -> ShortByteString
toShort ByteString
bs)

-- | Construct `BinaryData` from a buffer of bytes, while ensuring that it can be later
-- safely converted to `Data` with `binaryDataToData`
makeBinaryData :: Era era => ShortByteString -> Either String (BinaryData era)
makeBinaryData :: forall era.
Era era =>
ShortByteString -> Either String (BinaryData era)
makeBinaryData ShortByteString
sbs = do
  let binaryData :: BinaryData era
binaryData = forall era. ShortByteString -> BinaryData era
BinaryData ShortByteString
sbs
  -- We need to verify that binary data is indeed valid Plutus Data.
  case forall era.
Era era =>
BinaryData era -> Either DecoderError (Data era)
decodeBinaryData BinaryData era
binaryData of
    Left DecoderError
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid CBOR for Data: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DecoderError
e
    Right Data era
_d -> forall a b. b -> Either a b
Right BinaryData era
binaryData

decodeBinaryData :: forall era. Era era => BinaryData era -> Either DecoderError (Data era)
decodeBinaryData :: forall era.
Era era =>
BinaryData era -> Either DecoderError (Data era)
decodeBinaryData (BinaryData ShortByteString
sbs) = do
  PlutusData era
plutusData <- forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator (forall era. Era era => Version
eraProtVerLow @era) Text
"Data" forall a s. DecCBOR a => Decoder s a
decCBOR (ByteString -> ByteString
fromStrict (ShortByteString -> ByteString
fromShort ShortByteString
sbs))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall era. MemoBytes PlutusData era -> Data era
DataConstr (forall era (t :: * -> *).
Era era =>
t era -> ByteString -> MemoBytes t era
mkMemoBytes PlutusData era
plutusData forall a b. (a -> b) -> a -> b
$ ShortByteString -> ByteString
shortToLazy ShortByteString
sbs))

-- | It is safe to convert `BinaryData` to `Data` because the only way to
-- construct `BinaryData` is through the smart constructor `makeBinaryData` that
-- takes care of validation.
binaryDataToData :: Era era => BinaryData era -> Data era
binaryDataToData :: forall era. Era era => BinaryData era -> Data era
binaryDataToData BinaryData era
binaryData =
  case forall era.
Era era =>
BinaryData era -> Either DecoderError (Data era)
decodeBinaryData BinaryData era
binaryData of
    Left DecoderError
errMsg ->
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Impossible: incorrectly encoded data: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DecoderError
errMsg
    Right Data era
d -> Data era
d

dataToBinaryData :: Era era => Data era -> BinaryData era
dataToBinaryData :: forall era. Era era => Data era -> BinaryData era
dataToBinaryData (DataConstr (Memo PlutusData era
_ ShortByteString
sbs)) = forall era. ShortByteString -> BinaryData era
BinaryData ShortByteString
sbs

hashBinaryData :: Era era => BinaryData era -> DataHash (EraCrypto era)
hashBinaryData :: forall era. Era era => BinaryData era -> DataHash (EraCrypto era)
hashBinaryData = forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated

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

hashData :: Era era => Data era -> DataHash (EraCrypto era)
hashData :: forall era. Era era => Data era -> DataHash (EraCrypto era)
hashData = forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated

-- Size of the datum hash attached to the output (could be Nothing)
dataHashSize :: StrictMaybe (DataHash c) -> Integer
dataHashSize :: forall c. StrictMaybe (DataHash c) -> Integer
dataHashSize StrictMaybe (DataHash c)
SNothing = Integer
0
dataHashSize (SJust DataHash c
_) = Integer
10

instance Crypto c => HeapWords (StrictMaybe (DataHash c)) where
  heapWords :: StrictMaybe (DataHash c) -> Int
heapWords StrictMaybe (DataHash c)
SNothing = Int
heapWords0
  heapWords (SJust DataHash c
a) = forall a. HeapWords a => a -> Int
heapWords1 DataHash c
a

-- ============================================================================
-- Datum

-- | Datum can be described by a either a data hash or binary data, but not
-- both. It can also be neither one of them.
data Datum era
  = NoDatum
  | DatumHash !(DataHash (EraCrypto era))
  | Datum !(BinaryData era)
  deriving (Datum era -> Datum era -> Bool
forall era. Datum era -> Datum era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Datum era -> Datum era -> Bool
$c/= :: forall era. Datum era -> Datum era -> Bool
== :: Datum era -> Datum era -> Bool
$c== :: forall era. Datum era -> Datum era -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (Datum era) x -> Datum era
forall era x. Datum era -> Rep (Datum era) x
$cto :: forall era x. Rep (Datum era) x -> Datum era
$cfrom :: forall era x. Datum era -> Rep (Datum era) x
Generic, forall era. Context -> Datum era -> IO (Maybe ThunkInfo)
forall era. Proxy (Datum era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (Datum era) -> String
$cshowTypeOf :: forall era. Proxy (Datum era) -> String
wNoThunks :: Context -> Datum era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> Datum era -> IO (Maybe ThunkInfo)
noThunks :: Context -> Datum era -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era. Context -> Datum era -> IO (Maybe ThunkInfo)
NoThunks, Datum era -> Datum era -> Bool
Datum era -> Datum era -> Ordering
forall era. Eq (Datum era)
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 era. Datum era -> Datum era -> Bool
forall era. Datum era -> Datum era -> Ordering
forall era. Datum era -> Datum era -> Datum era
min :: Datum era -> Datum era -> Datum era
$cmin :: forall era. Datum era -> Datum era -> Datum era
max :: Datum era -> Datum era -> Datum era
$cmax :: forall era. Datum era -> Datum era -> Datum era
>= :: Datum era -> Datum era -> Bool
$c>= :: forall era. Datum era -> Datum era -> Bool
> :: Datum era -> Datum era -> Bool
$c> :: forall era. Datum era -> Datum era -> Bool
<= :: Datum era -> Datum era -> Bool
$c<= :: forall era. Datum era -> Datum era -> Bool
< :: Datum era -> Datum era -> Bool
$c< :: forall era. Datum era -> Datum era -> Bool
compare :: Datum era -> Datum era -> Ordering
$ccompare :: forall era. Datum era -> Datum era -> Ordering
Ord, Int -> Datum era -> ShowS
forall era. Int -> Datum era -> ShowS
forall era. [Datum era] -> ShowS
forall era. Datum era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Datum era] -> ShowS
$cshowList :: forall era. [Datum era] -> ShowS
show :: Datum era -> String
$cshow :: forall era. Datum era -> String
showsPrec :: Int -> Datum era -> ShowS
$cshowsPrec :: forall era. Int -> Datum era -> ShowS
Show)

instance Era era => EncCBOR (Datum era) where
  encCBOR :: Datum era -> Encoding
encCBOR Datum era
d = forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ case Datum era
d of
    DatumHash DataHash (EraCrypto era)
dh -> forall t. t -> Word -> Encode 'Open t
Sum forall era. DataHash (EraCrypto era) -> Datum era
DatumHash Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To DataHash (EraCrypto era)
dh
    Datum BinaryData era
d' -> forall t. t -> Word -> Encode 'Open t
Sum forall era. BinaryData era -> Datum era
Datum Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To BinaryData era
d'
    Datum era
NoDatum -> forall t (w :: Wrapped). t -> Encode w t
OmitC forall era. Datum era
NoDatum

instance Era era => DecCBOR (Datum era) where
  decCBOR :: forall s. Decoder s (Datum era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"Datum" forall {era}. Era era => Word -> Decode 'Open (Datum era)
decodeDatum)
    where
      decodeDatum :: Word -> Decode 'Open (Datum era)
decodeDatum Word
0 = forall t. t -> Decode 'Open t
SumD forall era. DataHash (EraCrypto era) -> Datum era
DatumHash forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      decodeDatum Word
1 = forall t. t -> Decode 'Open t
SumD forall era. BinaryData era -> Datum era
Datum forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      decodeDatum Word
k = forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k

instance Era era => ToJSON (Datum era) where
  toJSON :: Datum era -> Value
toJSON Datum era
d =
    case forall era.
Era era =>
Datum era -> StrictMaybe (DataHash (EraCrypto era))
datumDataHash Datum era
d of
      StrictMaybe (DataHash (EraCrypto era))
SNothing -> Value
Null
      SJust DataHash (EraCrypto era)
dh -> forall a. ToJSON a => a -> Value
toJSON DataHash (EraCrypto era)
dh
  toEncoding :: Datum era -> Encoding
toEncoding Datum era
d =
    case forall era.
Era era =>
Datum era -> StrictMaybe (DataHash (EraCrypto era))
datumDataHash Datum era
d of
      StrictMaybe (DataHash (EraCrypto era))
SNothing -> forall a. ToJSON a => a -> Encoding
toEncoding Value
Null
      SJust DataHash (EraCrypto era)
dh -> forall a. ToJSON a => a -> Encoding
toEncoding DataHash (EraCrypto era)
dh

-- | Get the Hash of the datum.
datumDataHash :: Era era => Datum era -> StrictMaybe (DataHash (EraCrypto era))
datumDataHash :: forall era.
Era era =>
Datum era -> StrictMaybe (DataHash (EraCrypto era))
datumDataHash = \case
  Datum era
NoDatum -> forall a. StrictMaybe a
SNothing
  DatumHash DataHash (EraCrypto era)
dh -> forall a. a -> StrictMaybe a
SJust DataHash (EraCrypto era)
dh
  Datum BinaryData era
bd -> forall a. a -> StrictMaybe a
SJust (forall era. Era era => BinaryData era -> DataHash (EraCrypto era)
hashBinaryData BinaryData era
bd)

translateDatum ::
  EraCrypto era1 ~ EraCrypto era2 =>
  Datum era1 ->
  Datum era2
translateDatum :: forall era1 era2.
(EraCrypto era1 ~ EraCrypto era2) =>
Datum era1 -> Datum era2
translateDatum = \case
  Datum era1
NoDatum -> forall era. Datum era
NoDatum
  DatumHash DataHash (EraCrypto era1)
dh -> forall era. DataHash (EraCrypto era) -> Datum era
DatumHash DataHash (EraCrypto era1)
dh
  Datum BinaryData era1
bd -> forall era. BinaryData era -> Datum era
Datum (coerce :: forall a b. Coercible a b => a -> b
coerce BinaryData era1
bd)