{-# 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 UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

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

import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  ToCBOR (..),
  decodeFull',
  decodeNestedCborBytes,
  encodeTag,
  fromPlainDecoder,
  fromPlainEncoding,
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core
import Cardano.Ledger.MemoBytes (
  MemoBytes (..),
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  mkMemoizedEra,
 )
import Cardano.Ledger.MemoBytes.Internal (mkMemoBytesStrict)
import qualified Codec.Serialise as Cborg (Serialise (..))
import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON (..), Value (Null))
import Data.ByteString.Short (ShortByteString, fromShort, toShort)
import Data.Coerce (coerce)
import Data.MemPack
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
(PlutusData era -> PlutusData era -> Bool)
-> (PlutusData era -> PlutusData era -> Bool)
-> Eq (PlutusData era)
forall era. PlutusData era -> PlutusData era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. PlutusData era -> PlutusData era -> Bool
== :: PlutusData era -> PlutusData era -> Bool
$c/= :: forall era. PlutusData era -> PlutusData era -> Bool
/= :: PlutusData era -> PlutusData era -> Bool
Eq, (forall x. PlutusData era -> Rep (PlutusData era) x)
-> (forall x. Rep (PlutusData era) x -> PlutusData era)
-> Generic (PlutusData era)
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
$cfrom :: forall era x. PlutusData era -> Rep (PlutusData era) x
from :: forall x. PlutusData era -> Rep (PlutusData era) x
$cto :: forall era x. Rep (PlutusData era) x -> PlutusData era
to :: forall x. Rep (PlutusData era) x -> PlutusData era
Generic, Int -> PlutusData era -> ShowS
[PlutusData era] -> ShowS
PlutusData era -> String
(Int -> PlutusData era -> ShowS)
-> (PlutusData era -> String)
-> ([PlutusData era] -> ShowS)
-> Show (PlutusData era)
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
$cshowsPrec :: forall era. Int -> PlutusData era -> ShowS
showsPrec :: Int -> PlutusData era -> ShowS
$cshow :: forall era. PlutusData era -> String
show :: PlutusData era -> String
$cshowList :: forall era. [PlutusData era] -> ShowS
showList :: [PlutusData era] -> ShowS
Show, PlutusData era -> ()
(PlutusData era -> ()) -> NFData (PlutusData era)
forall era. PlutusData era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. PlutusData era -> ()
rnf :: PlutusData era -> ()
NFData, Context -> PlutusData era -> IO (Maybe ThunkInfo)
Proxy (PlutusData era) -> String
(Context -> PlutusData era -> IO (Maybe ThunkInfo))
-> (Context -> PlutusData era -> IO (Maybe ThunkInfo))
-> (Proxy (PlutusData era) -> String)
-> NoThunks (PlutusData era)
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
$cnoThunks :: forall era. Context -> PlutusData era -> IO (Maybe ThunkInfo)
noThunks :: Context -> PlutusData era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> PlutusData era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> PlutusData era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (PlutusData era) -> String
showTypeOf :: Proxy (PlutusData era) -> String
NoThunks, [PlutusData era] -> Encoding
PlutusData era -> Encoding
(PlutusData era -> Encoding)
-> (forall s. Decoder s (PlutusData era))
-> ([PlutusData era] -> Encoding)
-> (forall s. Decoder s [PlutusData era])
-> Serialise (PlutusData era)
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)
$cencode :: forall era. PlutusData era -> Encoding
encode :: PlutusData era -> Encoding
$cdecode :: forall era s. Decoder s (PlutusData era)
decode :: forall s. Decoder s (PlutusData era)
$cencodeList :: forall era. [PlutusData era] -> Encoding
encodeList :: [PlutusData era] -> Encoding
$cdecodeList :: forall era s. Decoder s [PlutusData era]
decodeList :: forall s. Decoder s [PlutusData era]
Cborg.Serialise)

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

instance Typeable era => DecCBOR (PlutusData era) where
  decCBOR :: forall s. Decoder s (PlutusData era)
decCBOR = Decoder s (PlutusData era) -> Decoder s (PlutusData era)
forall s a. Decoder s a -> Decoder s a
fromPlainDecoder Decoder s (PlutusData era)
forall s. Decoder s (PlutusData era)
forall a s. Serialise a => Decoder s a
Cborg.decode

newtype Data era = MkData (MemoBytes (PlutusData era))
  deriving (Data era -> Data era -> Bool
(Data era -> Data era -> Bool)
-> (Data era -> Data era -> Bool) -> Eq (Data era)
forall era. Data era -> Data era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. Data era -> Data era -> Bool
== :: Data era -> Data era -> Bool
$c/= :: forall era. Data era -> Data era -> Bool
/= :: Data era -> Data era -> Bool
Eq, (forall x. Data era -> Rep (Data era) x)
-> (forall x. Rep (Data era) x -> Data era) -> Generic (Data era)
forall x. Rep (Data era) x -> Data era
forall x. Data era -> Rep (Data era) x
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
$cfrom :: forall era x. Data era -> Rep (Data era) x
from :: forall x. Data era -> Rep (Data era) x
$cto :: forall era x. Rep (Data era) x -> Data era
to :: forall x. Rep (Data era) x -> Data era
Generic)
  deriving newtype (Data era -> Int
Data era -> ByteString
(Data era -> ByteString)
-> (Data era -> Int)
-> (forall i. Proxy i -> Data era -> SafeHash i)
-> SafeToHash (Data era)
forall i. Proxy i -> Data era -> SafeHash i
forall era. Data era -> Int
forall era. Data era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> Data era -> SafeHash i
$coriginalBytes :: forall era. Data era -> ByteString
originalBytes :: Data era -> ByteString
$coriginalBytesSize :: forall era. Data era -> Int
originalBytesSize :: Data era -> Int
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> Data era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> Data era -> SafeHash i
SafeToHash, Typeable (Data era)
Typeable (Data era) =>
(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)
-> ToCBOR (Data era)
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
$ctoCBOR :: forall era. Typeable era => Data era -> Encoding
toCBOR :: Data era -> Encoding
$cencodedSizeExpr :: 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
$cencodedListSizeExpr :: 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
ToCBOR, Data era -> ()
(Data era -> ()) -> NFData (Data era)
forall era. Data era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. Data era -> ()
rnf :: Data era -> ()
NFData, Typeable (Data era)
Typeable (Data era) =>
(forall s. Decoder s (Data era))
-> (forall s. Proxy (Data era) -> Decoder s ())
-> (Proxy (Data era) -> Text)
-> DecCBOR (Data era)
Proxy (Data era) -> Text
forall s. Decoder s (Data era)
forall era. Typeable era => Typeable (Data era)
forall era. Typeable era => Proxy (Data era) -> Text
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall era s. Typeable era => Decoder s (Data era)
forall era s. Typeable era => Proxy (Data era) -> Decoder s ()
forall s. Proxy (Data era) -> Decoder s ()
$cdecCBOR :: forall era s. Typeable era => Decoder s (Data era)
decCBOR :: forall s. Decoder s (Data era)
$cdropCBOR :: forall era s. Typeable era => Proxy (Data era) -> Decoder s ()
dropCBOR :: forall s. Proxy (Data era) -> Decoder s ()
$clabel :: forall era. Typeable era => Proxy (Data era) -> Text
label :: Proxy (Data era) -> Text
DecCBOR)

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

instance Memoized (Data era) where
  type RawType (Data era) = PlutusData era

deriving instance Show (Data era)

type instance MemoHashIndex (PlutusData era) = EraIndependentData

instance HashAnnotated (Data era) EraIndependentData where
  hashAnnotated :: Data era -> SafeHash EraIndependentData
hashAnnotated = Data era -> SafeHash EraIndependentData
Data era -> SafeHash (MemoHashIndex (RawType (Data era)))
forall t. Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

instance Typeable era => NoThunks (Data era)

pattern Data :: forall era. Era era => PV1.Data -> Data era
pattern $mData :: forall {r} {era}.
Era era =>
Data era -> (Data -> r) -> ((# #) -> r) -> r
$bData :: forall era. Era era => Data -> Data era
Data p <- (getMemoRawType -> PlutusData p)
  where
    Data Data
p = forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (RawType (Data era) -> Data era) -> RawType (Data era) -> Data era
forall a b. (a -> b) -> a -> b
$ Data -> PlutusData era
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 Data era -> RawType (Data era)
forall t. Memoized t => t -> RawType t
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) = Data -> Data era2
forall era. Era era => Data -> Data era
Data Data
d

getPlutusData :: Data era -> PV1.Data
getPlutusData :: forall era. Data era -> Data
getPlutusData (Data era -> RawType (Data era)
forall t. Memoized t => t -> RawType t
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
(BinaryData era -> BinaryData era -> Bool)
-> (BinaryData era -> BinaryData era -> Bool)
-> Eq (BinaryData era)
forall era. BinaryData era -> BinaryData era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, Context -> BinaryData era -> IO (Maybe ThunkInfo)
Proxy (BinaryData era) -> String
(Context -> BinaryData era -> IO (Maybe ThunkInfo))
-> (Context -> BinaryData era -> IO (Maybe ThunkInfo))
-> (Proxy (BinaryData era) -> String)
-> NoThunks (BinaryData era)
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
$cnoThunks :: forall era. Context -> BinaryData era -> IO (Maybe ThunkInfo)
noThunks :: Context -> BinaryData era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> BinaryData era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BinaryData era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (BinaryData era) -> String
showTypeOf :: Proxy (BinaryData era) -> String
NoThunks, Eq (BinaryData era)
Eq (BinaryData era) =>
(BinaryData era -> BinaryData era -> Ordering)
-> (BinaryData era -> BinaryData era -> Bool)
-> (BinaryData era -> BinaryData era -> Bool)
-> (BinaryData era -> BinaryData era -> Bool)
-> (BinaryData era -> BinaryData era -> Bool)
-> (BinaryData era -> BinaryData era -> BinaryData era)
-> (BinaryData era -> BinaryData era -> BinaryData era)
-> Ord (BinaryData era)
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
$ccompare :: forall era. BinaryData era -> BinaryData era -> Ordering
compare :: BinaryData era -> BinaryData era -> Ordering
$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
>= :: BinaryData era -> BinaryData era -> Bool
$cmax :: forall era. BinaryData era -> BinaryData era -> BinaryData era
max :: BinaryData era -> BinaryData era -> BinaryData era
$cmin :: forall era. BinaryData era -> BinaryData era -> BinaryData era
min :: BinaryData era -> BinaryData era -> BinaryData era
Ord, Int -> BinaryData era -> ShowS
[BinaryData era] -> ShowS
BinaryData era -> String
(Int -> BinaryData era -> ShowS)
-> (BinaryData era -> String)
-> ([BinaryData era] -> ShowS)
-> Show (BinaryData era)
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
$cshowsPrec :: forall era. Int -> BinaryData era -> ShowS
showsPrec :: Int -> BinaryData era -> ShowS
$cshow :: forall era. BinaryData era -> String
show :: BinaryData era -> String
$cshowList :: forall era. [BinaryData era] -> ShowS
showList :: [BinaryData era] -> ShowS
Show, BinaryData era -> Int
BinaryData era -> ByteString
(BinaryData era -> ByteString)
-> (BinaryData era -> Int)
-> (forall i. Proxy i -> BinaryData era -> SafeHash i)
-> SafeToHash (BinaryData era)
forall i. Proxy i -> BinaryData era -> SafeHash i
forall era. BinaryData era -> Int
forall era. BinaryData era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> BinaryData era -> SafeHash i
$coriginalBytes :: forall era. BinaryData era -> ByteString
originalBytes :: BinaryData era -> ByteString
$coriginalBytesSize :: forall era. BinaryData era -> Int
originalBytesSize :: BinaryData era -> Int
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> BinaryData era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> BinaryData era -> SafeHash i
SafeToHash, String
String
-> (BinaryData era -> Int)
-> (forall s. BinaryData era -> Pack s ())
-> (forall b. Buffer b => Unpack b (BinaryData era))
-> MemPack (BinaryData era)
BinaryData era -> Int
forall era. String
forall a.
String
-> (a -> Int)
-> (forall s. a -> Pack s ())
-> (forall b. Buffer b => Unpack b a)
-> MemPack a
forall b. Buffer b => Unpack b (BinaryData era)
forall era. BinaryData era -> Int
forall s. BinaryData era -> Pack s ()
forall era b. Buffer b => Unpack b (BinaryData era)
forall era s. BinaryData era -> Pack s ()
$ctypeName :: forall era. String
typeName :: String
$cpackedByteCount :: forall era. BinaryData era -> Int
packedByteCount :: BinaryData era -> Int
$cpackM :: forall era s. BinaryData era -> Pack s ()
packM :: forall s. BinaryData era -> Pack s ()
$cunpackM :: forall era b. Buffer b => Unpack b (BinaryData era)
unpackM :: forall b. Buffer b => Unpack b (BinaryData era)
MemPack)
  deriving ((forall x. BinaryData era -> Rep (BinaryData era) x)
-> (forall x. Rep (BinaryData era) x -> BinaryData era)
-> Generic (BinaryData era)
forall x. Rep (BinaryData era) x -> BinaryData era
forall x. BinaryData era -> Rep (BinaryData era) x
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
$cfrom :: forall era x. BinaryData era -> Rep (BinaryData era) x
from :: forall x. BinaryData era -> Rep (BinaryData era) x
$cto :: forall era x. Rep (BinaryData era) x -> BinaryData era
to :: forall x. Rep (BinaryData era) x -> BinaryData era
Generic)

instance HashAnnotated (BinaryData era) EraIndependentData

instance Typeable era => EncCBOR (BinaryData era) where
  encCBOR :: BinaryData era -> Encoding
encCBOR (BinaryData ShortByteString
sbs) = Word -> Encoding
encodeTag Word
24 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ShortByteString -> Encoding
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 <- Decoder s ByteString
forall s. Decoder s ByteString
decodeNestedCborBytes
    (String -> Decoder s (BinaryData era))
-> (BinaryData era -> Decoder s (BinaryData era))
-> Either String (BinaryData era)
-> Decoder s (BinaryData era)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (BinaryData era)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail BinaryData era -> Decoder s (BinaryData era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (BinaryData era) -> Decoder s (BinaryData era))
-> Either String (BinaryData era) -> Decoder s (BinaryData era)
forall a b. (a -> b) -> a -> b
$! ShortByteString -> Either String (BinaryData era)
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 = ShortByteString -> BinaryData era
forall era. ShortByteString -> BinaryData era
BinaryData ShortByteString
sbs
  -- We need to verify that binary data is indeed valid Plutus Data.
  case BinaryData era -> Either DecoderError (Data era)
forall era.
Era era =>
BinaryData era -> Either DecoderError (Data era)
decodeBinaryData BinaryData era
binaryData of
    Left DecoderError
e -> String -> Either String (BinaryData era)
forall a b. a -> Either a b
Left (String -> Either String (BinaryData era))
-> String -> Either String (BinaryData era)
forall a b. (a -> b) -> a -> b
$ String
"Invalid CBOR for Data: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
    Right Data era
_d -> BinaryData era -> Either String (BinaryData era)
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
  let bs :: ByteString
bs = ShortByteString -> ByteString
fromShort ShortByteString
sbs
  PlutusData era
plutusData <- Version -> ByteString -> Either DecoderError (PlutusData era)
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull' (forall era. Era era => Version
eraProtVerLow @era) ByteString
bs
  Data era -> Either DecoderError (Data era)
forall a. a -> Either DecoderError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MemoBytes (PlutusData era) -> Data era
forall era. MemoBytes (PlutusData era) -> Data era
MkData (PlutusData era -> ByteString -> MemoBytes (PlutusData era)
forall t. t -> ByteString -> MemoBytes t
mkMemoBytesStrict PlutusData era
plutusData ByteString
bs))

-- | 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 BinaryData era -> Either DecoderError (Data era)
forall era.
Era era =>
BinaryData era -> Either DecoderError (Data era)
decodeBinaryData BinaryData era
binaryData of
    Left DecoderError
errMsg ->
      String -> Data era
forall a. HasCallStack => String -> a
error (String -> Data era) -> String -> Data era
forall a b. (a -> b) -> a -> b
$ String
"Impossible: incorrectly encoded data: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ DecoderError -> String
forall a. Show a => a -> String
show DecoderError
errMsg
    Right Data era
d -> Data era
d

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

hashBinaryData :: BinaryData era -> DataHash
hashBinaryData :: forall era. BinaryData era -> SafeHash EraIndependentData
hashBinaryData = BinaryData era -> SafeHash EraIndependentData
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated

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

hashData :: Data era -> DataHash
hashData :: forall era. Data era -> SafeHash EraIndependentData
hashData = Data era -> SafeHash EraIndependentData
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated

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

-- ============================================================================
-- 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
  | Datum !(BinaryData era)
  deriving (Datum era -> Datum era -> Bool
(Datum era -> Datum era -> Bool)
-> (Datum era -> Datum era -> Bool) -> Eq (Datum era)
forall era. Datum era -> Datum era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, (forall x. Datum era -> Rep (Datum era) x)
-> (forall x. Rep (Datum era) x -> Datum era)
-> Generic (Datum era)
forall x. Rep (Datum era) x -> Datum era
forall x. Datum era -> Rep (Datum era) x
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
$cfrom :: forall era x. Datum era -> Rep (Datum era) x
from :: forall x. Datum era -> Rep (Datum era) x
$cto :: forall era x. Rep (Datum era) x -> Datum era
to :: forall x. Rep (Datum era) x -> Datum era
Generic, Context -> Datum era -> IO (Maybe ThunkInfo)
Proxy (Datum era) -> String
(Context -> Datum era -> IO (Maybe ThunkInfo))
-> (Context -> Datum era -> IO (Maybe ThunkInfo))
-> (Proxy (Datum era) -> String)
-> NoThunks (Datum era)
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
$cnoThunks :: forall era. Context -> Datum era -> IO (Maybe ThunkInfo)
noThunks :: Context -> Datum era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> Datum era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Datum era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (Datum era) -> String
showTypeOf :: Proxy (Datum era) -> String
NoThunks, Eq (Datum era)
Eq (Datum era) =>
(Datum era -> Datum era -> Ordering)
-> (Datum era -> Datum era -> Bool)
-> (Datum era -> Datum era -> Bool)
-> (Datum era -> Datum era -> Bool)
-> (Datum era -> Datum era -> Bool)
-> (Datum era -> Datum era -> Datum era)
-> (Datum era -> Datum era -> Datum era)
-> Ord (Datum era)
Datum era -> Datum era -> Bool
Datum era -> Datum era -> Ordering
Datum era -> Datum era -> Datum era
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
$ccompare :: forall era. Datum era -> Datum era -> Ordering
compare :: Datum era -> Datum era -> Ordering
$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
>= :: Datum era -> Datum era -> Bool
$cmax :: forall era. Datum era -> Datum era -> Datum era
max :: Datum era -> Datum era -> Datum era
$cmin :: forall era. Datum era -> Datum era -> Datum era
min :: Datum era -> Datum era -> Datum era
Ord, Int -> Datum era -> ShowS
[Datum era] -> ShowS
Datum era -> String
(Int -> Datum era -> ShowS)
-> (Datum era -> String)
-> ([Datum era] -> ShowS)
-> Show (Datum era)
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
$cshowsPrec :: forall era. Int -> Datum era -> ShowS
showsPrec :: Int -> Datum era -> ShowS
$cshow :: forall era. Datum era -> String
show :: Datum era -> String
$cshowList :: forall era. [Datum era] -> ShowS
showList :: [Datum era] -> ShowS
Show)

instance Era era => MemPack (Datum era) where
  packedByteCount :: Datum era -> Int
packedByteCount = \case
    Datum era
NoDatum -> Int
packedTagByteCount
    DatumHash SafeHash EraIndependentData
dataHash -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SafeHash EraIndependentData -> Int
forall a. MemPack a => a -> Int
packedByteCount SafeHash EraIndependentData
dataHash
    Datum BinaryData era
binaryData -> Int
packedTagByteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ BinaryData era -> Int
forall a. MemPack a => a -> Int
packedByteCount BinaryData era
binaryData
  {-# INLINE packedByteCount #-}
  packM :: forall s. Datum era -> Pack s ()
packM = \case
    Datum era
NoDatum -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
0
    DatumHash SafeHash EraIndependentData
dataHash -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
1 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SafeHash EraIndependentData -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. SafeHash EraIndependentData -> Pack s ()
packM SafeHash EraIndependentData
dataHash
    Datum BinaryData era
binaryData -> Tag -> Pack s ()
forall s. Tag -> Pack s ()
packTagM Tag
2 Pack s () -> Pack s () -> Pack s ()
forall a b. Pack s a -> Pack s b -> Pack s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinaryData era -> Pack s ()
forall a s. MemPack a => a -> Pack s ()
forall s. BinaryData era -> Pack s ()
packM BinaryData era
binaryData
  {-# INLINE packM #-}
  unpackM :: forall b. Buffer b => Unpack b (Datum era)
unpackM =
    Unpack b Tag
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b Tag
unpackM Unpack b Tag
-> (Tag -> Unpack b (Datum era)) -> Unpack b (Datum era)
forall a b. Unpack b a -> (a -> Unpack b b) -> Unpack b b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Tag
0 -> Datum era -> Unpack b (Datum era)
forall a. a -> Unpack b a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Datum era
forall era. Datum era
NoDatum
      Tag
1 -> SafeHash EraIndependentData -> Datum era
forall era. SafeHash EraIndependentData -> Datum era
DatumHash (SafeHash EraIndependentData -> Datum era)
-> Unpack b (SafeHash EraIndependentData) -> Unpack b (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (SafeHash EraIndependentData)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (SafeHash EraIndependentData)
unpackM
      Tag
2 -> BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (BinaryData era -> Datum era)
-> Unpack b (BinaryData era) -> Unpack b (Datum era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unpack b (BinaryData era)
forall a b. (MemPack a, Buffer b) => Unpack b a
forall b. Buffer b => Unpack b (BinaryData era)
unpackM
      Tag
n -> forall a (m :: * -> *) b. (MemPack a, MonadFail m) => Tag -> m b
unknownTagM @(Datum era) Tag
n
  {-# INLINE unpackM #-}

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

instance Era era => DecCBOR (Datum era) where
  decCBOR :: forall s. Decoder s (Datum era)
decCBOR = Decode ('Closed 'Dense) (Datum era) -> Decoder s (Datum era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text
-> (Word -> Decode 'Open (Datum era))
-> Decode ('Closed 'Dense) (Datum era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"Datum" Word -> Decode 'Open (Datum era)
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Era era) =>
Word -> Decode 'Open (Datum era)
decodeDatum)
    where
      decodeDatum :: Word -> Decode 'Open (Datum era)
decodeDatum Word
0 = (SafeHash EraIndependentData -> Datum era)
-> Decode 'Open (SafeHash EraIndependentData -> Datum era)
forall t. t -> Decode 'Open t
SumD SafeHash EraIndependentData -> Datum era
forall era. SafeHash EraIndependentData -> Datum era
DatumHash Decode 'Open (SafeHash EraIndependentData -> Datum era)
-> Decode ('Closed Any) (SafeHash EraIndependentData)
-> Decode 'Open (Datum era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (SafeHash EraIndependentData)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      decodeDatum Word
1 = (BinaryData era -> Datum era)
-> Decode 'Open (BinaryData era -> Datum era)
forall t. t -> Decode 'Open t
SumD BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum Decode 'Open (BinaryData era -> Datum era)
-> Decode ('Closed Any) (BinaryData era)
-> Decode 'Open (Datum era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (BinaryData era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      decodeDatum Word
k = Word -> Decode 'Open (Datum era)
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 Datum era -> StrictMaybe (SafeHash EraIndependentData)
forall era. Datum era -> StrictMaybe (SafeHash EraIndependentData)
datumDataHash Datum era
d of
      StrictMaybe (SafeHash EraIndependentData)
SNothing -> Value
Null
      SJust SafeHash EraIndependentData
dh -> SafeHash EraIndependentData -> Value
forall a. ToJSON a => a -> Value
toJSON SafeHash EraIndependentData
dh
  toEncoding :: Datum era -> Encoding
toEncoding Datum era
d =
    case Datum era -> StrictMaybe (SafeHash EraIndependentData)
forall era. Datum era -> StrictMaybe (SafeHash EraIndependentData)
datumDataHash Datum era
d of
      StrictMaybe (SafeHash EraIndependentData)
SNothing -> Value -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding Value
Null
      SJust SafeHash EraIndependentData
dh -> SafeHash EraIndependentData -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding SafeHash EraIndependentData
dh

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

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