{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.ShelleyMA.AuxiliaryData
  ( AuxiliaryData (AuxiliaryData, AuxiliaryData', ..),
  )
where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), peekTokenType)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Crypto, Era)
import Cardano.Ledger.Hashes (EraIndependentAuxiliaryData)
import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash)
import Cardano.Ledger.Serialization (mapFromCBOR, mapToCBOR)
import Cardano.Ledger.Shelley.Metadata (Metadatum)
import Codec.CBOR.Decoding
  ( TokenType
      ( TypeListLen,
        TypeListLen64,
        TypeListLenIndef,
        TypeMapLen,
        TypeMapLen64,
        TypeMapLenIndef
      ),
  )
import Control.DeepSeq
import Data.Coders
import Data.Map.Strict (Map)
import Data.MemoBytes
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Typeable (Typeable)
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class

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

-- | Raw, un-memoised metadata type
data AuxiliaryDataRaw era = AuxiliaryDataRaw
  { -- | Structured transaction metadata
    AuxiliaryDataRaw era -> Map Word64 Metadatum
txMetadata :: !(Map Word64 Metadatum),
    -- | Pre-images of script hashes found within the TxBody, but which are not
    -- required as witnesses. Examples include:
    -- - Token policy IDs appearing in transaction outputs
    -- - Pool reward account registrations
    AuxiliaryDataRaw era -> StrictSeq (Script era)
auxiliaryScripts :: !(StrictSeq (Core.Script era))
  }
  deriving ((forall x. AuxiliaryDataRaw era -> Rep (AuxiliaryDataRaw era) x)
-> (forall x. Rep (AuxiliaryDataRaw era) x -> AuxiliaryDataRaw era)
-> Generic (AuxiliaryDataRaw era)
forall x. Rep (AuxiliaryDataRaw era) x -> AuxiliaryDataRaw era
forall x. AuxiliaryDataRaw era -> Rep (AuxiliaryDataRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AuxiliaryDataRaw era) x -> AuxiliaryDataRaw era
forall era x. AuxiliaryDataRaw era -> Rep (AuxiliaryDataRaw era) x
$cto :: forall era x. Rep (AuxiliaryDataRaw era) x -> AuxiliaryDataRaw era
$cfrom :: forall era x. AuxiliaryDataRaw era -> Rep (AuxiliaryDataRaw era) x
Generic)

deriving instance (Core.ChainData (Core.Script era)) => Eq (AuxiliaryDataRaw era)

deriving instance (Core.ChainData (Core.Script era)) => Show (AuxiliaryDataRaw era)

deriving instance
  (Core.ChainData (Core.Script era)) =>
  NoThunks (AuxiliaryDataRaw era)

instance NFData (Core.Script era) => NFData (AuxiliaryDataRaw era)

newtype AuxiliaryData era = AuxiliaryDataWithBytes (MemoBytes (AuxiliaryDataRaw era))
  deriving ((forall x. AuxiliaryData era -> Rep (AuxiliaryData era) x)
-> (forall x. Rep (AuxiliaryData era) x -> AuxiliaryData era)
-> Generic (AuxiliaryData era)
forall x. Rep (AuxiliaryData era) x -> AuxiliaryData era
forall x. AuxiliaryData era -> Rep (AuxiliaryData era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AuxiliaryData era) x -> AuxiliaryData era
forall era x. AuxiliaryData era -> Rep (AuxiliaryData era) x
$cto :: forall era x. Rep (AuxiliaryData era) x -> AuxiliaryData era
$cfrom :: forall era x. AuxiliaryData era -> Rep (AuxiliaryData era) x
Generic, Typeable)
  deriving newtype (Typeable (AuxiliaryData era)
Typeable (AuxiliaryData era)
-> (AuxiliaryData era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (AuxiliaryData era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [AuxiliaryData era] -> Size)
-> ToCBOR (AuxiliaryData era)
AuxiliaryData era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AuxiliaryData era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AuxiliaryData era) -> Size
forall era. Typeable era => Typeable (AuxiliaryData era)
forall era. Typeable era => AuxiliaryData 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 [AuxiliaryData era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AuxiliaryData era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AuxiliaryData era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AuxiliaryData era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AuxiliaryData era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AuxiliaryData era) -> Size
toCBOR :: AuxiliaryData era -> Encoding
$ctoCBOR :: forall era. Typeable era => AuxiliaryData era -> Encoding
$cp1ToCBOR :: forall era. Typeable era => Typeable (AuxiliaryData era)
ToCBOR, Proxy c -> Proxy index -> AuxiliaryData era -> SafeHash c index
AuxiliaryData era -> ByteString
(AuxiliaryData era -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> AuxiliaryData era -> SafeHash c index)
-> SafeToHash (AuxiliaryData era)
forall era. AuxiliaryData era -> ByteString
forall t.
(t -> ByteString)
-> (forall c index.
    HasAlgorithm c =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> AuxiliaryData era -> SafeHash c index
forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> AuxiliaryData era -> SafeHash c index
makeHashWithExplicitProxys :: Proxy c -> Proxy index -> AuxiliaryData era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HasAlgorithm c =>
Proxy c -> Proxy index -> AuxiliaryData era -> SafeHash c index
originalBytes :: AuxiliaryData era -> ByteString
$coriginalBytes :: forall era. AuxiliaryData era -> ByteString
SafeToHash)

instance (c ~ Crypto era) => HashAnnotated (AuxiliaryData era) EraIndependentAuxiliaryData c

deriving newtype instance
  (Era era) =>
  Eq (AuxiliaryData era)

deriving newtype instance
  (Era era, Core.ChainData (Core.Script era)) =>
  Show (AuxiliaryData era)

deriving newtype instance
  (Era era, Core.ChainData (Core.Script era)) =>
  NoThunks (AuxiliaryData era)

deriving newtype instance NFData (Core.Script era) => NFData (AuxiliaryData era)

pattern AuxiliaryData ::
  ( Core.AnnotatedData (Core.Script era),
    Ord (Core.Script era)
  ) =>
  Map Word64 Metadatum ->
  StrictSeq (Core.Script era) ->
  AuxiliaryData era
pattern $bAuxiliaryData :: Map Word64 Metadatum -> StrictSeq (Script era) -> AuxiliaryData era
$mAuxiliaryData :: forall r era.
(AnnotatedData (Script era), Ord (Script era)) =>
AuxiliaryData era
-> (Map Word64 Metadatum -> StrictSeq (Script era) -> r)
-> (Void# -> r)
-> r
AuxiliaryData blob sp <-
  AuxiliaryDataWithBytes (Memo (AuxiliaryDataRaw blob sp) _)
  where
    AuxiliaryData Map Word64 Metadatum
blob StrictSeq (Script era)
sp =
      MemoBytes (AuxiliaryDataRaw era) -> AuxiliaryData era
forall era. MemoBytes (AuxiliaryDataRaw era) -> AuxiliaryData era
AuxiliaryDataWithBytes (MemoBytes (AuxiliaryDataRaw era) -> AuxiliaryData era)
-> MemoBytes (AuxiliaryDataRaw era) -> AuxiliaryData era
forall a b. (a -> b) -> a -> b
$
        Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
-> MemoBytes (AuxiliaryDataRaw era)
forall (w :: Wrapped) t. Encode w t -> MemoBytes t
memoBytes
          (AuxiliaryDataRaw era
-> Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
forall era.
AnnotatedData (Script era) =>
AuxiliaryDataRaw era
-> Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
encAuxiliaryDataRaw (AuxiliaryDataRaw era
 -> Encode ('Closed 'Dense) (AuxiliaryDataRaw era))
-> AuxiliaryDataRaw era
-> Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
forall a b. (a -> b) -> a -> b
$ Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
forall era.
Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
AuxiliaryDataRaw Map Word64 Metadatum
blob StrictSeq (Script era)
sp)

{-# COMPLETE AuxiliaryData #-}

pattern AuxiliaryData' ::
  Map Word64 Metadatum ->
  StrictSeq (Core.Script era) ->
  AuxiliaryData era
pattern $mAuxiliaryData' :: forall r era.
AuxiliaryData era
-> (Map Word64 Metadatum -> StrictSeq (Script era) -> r)
-> (Void# -> r)
-> r
AuxiliaryData' blob sp <-
  AuxiliaryDataWithBytes (Memo (AuxiliaryDataRaw blob sp) _)

{-# COMPLETE AuxiliaryData' #-}

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------

-- | Encode AuxiliaryData
encAuxiliaryDataRaw ::
  (Core.AnnotatedData (Core.Script era)) =>
  AuxiliaryDataRaw era ->
  Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
encAuxiliaryDataRaw :: AuxiliaryDataRaw era
-> Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
encAuxiliaryDataRaw (AuxiliaryDataRaw Map Word64 Metadatum
blob StrictSeq (Script era)
sp) =
  (Map Word64 Metadatum
 -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Encode
     ('Closed 'Dense)
     (Map Word64 Metadatum
      -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
forall t. t -> Encode ('Closed 'Dense) t
Rec Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
forall era.
Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
AuxiliaryDataRaw
    Encode
  ('Closed 'Dense)
  (Map Word64 Metadatum
   -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Encode ('Closed 'Dense) (Map Word64 Metadatum)
-> Encode
     ('Closed 'Dense) (StrictSeq (Script era) -> AuxiliaryDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Map Word64 Metadatum -> Encoding)
-> Map Word64 Metadatum
-> Encode ('Closed 'Dense) (Map Word64 Metadatum)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E Map Word64 Metadatum -> Encoding
forall a b. (ToCBOR a, ToCBOR b) => Map a b -> Encoding
mapToCBOR Map Word64 Metadatum
blob
    Encode
  ('Closed 'Dense) (StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Encode ('Closed 'Dense) (StrictSeq (Script era))
-> Encode ('Closed 'Dense) (AuxiliaryDataRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (StrictSeq (Script era) -> Encoding)
-> StrictSeq (Script era)
-> Encode ('Closed 'Dense) (StrictSeq (Script era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E StrictSeq (Script era) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable StrictSeq (Script era)
sp

instance
  (Era era, Core.AnnotatedData (Core.Script era)) =>
  FromCBOR (Annotator (AuxiliaryDataRaw era))
  where
  fromCBOR :: Decoder s (Annotator (AuxiliaryDataRaw era))
fromCBOR =
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (Annotator (AuxiliaryDataRaw era)))
-> Decoder s (Annotator (AuxiliaryDataRaw era))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      TokenType
TypeMapLen -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall s era. Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromMap
      TokenType
TypeMapLen64 -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall s era. Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromMap
      TokenType
TypeMapLenIndef -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall s era. Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromMap
      TokenType
TypeListLen -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall s. Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromList
      TokenType
TypeListLen64 -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall s. Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromList
      TokenType
TypeListLenIndef -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall s. Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromList
      TokenType
_ -> String -> Decoder s (Annotator (AuxiliaryDataRaw era))
forall a. HasCallStack => String -> a
error String
"Failed to decode AuxiliaryData"
    where
      decodeFromMap :: Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromMap =
        Decode Any (Annotator (AuxiliaryDataRaw era))
-> Decoder s (Annotator (AuxiliaryDataRaw era))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
          ( Decode
  Any
  (Map Word64 Metadatum
   -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Decode
     Any
     (Annotator
        (Map Word64 Metadatum
         -> StrictSeq (Script era) -> AuxiliaryDataRaw era))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((Map Word64 Metadatum
 -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Decode
     Any
     (Map Word64 Metadatum
      -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
forall t (w :: Wrapped). t -> Decode w t
Emit Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
forall era.
Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
AuxiliaryDataRaw)
              Decode
  Any
  (Annotator
     (Map Word64 Metadatum
      -> StrictSeq (Script era) -> AuxiliaryDataRaw era))
-> Decode ('Closed 'Dense) (Annotator (Map Word64 Metadatum))
-> Decode
     Any (Annotator (StrictSeq (Script era) -> AuxiliaryDataRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed 'Dense) (Map Word64 Metadatum)
-> Decode ('Closed 'Dense) (Annotator (Map Word64 Metadatum))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((forall s. Decoder s (Map Word64 Metadatum))
-> Decode ('Closed 'Dense) (Map Word64 Metadatum)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (Map Word64 Metadatum)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR)
              Decode
  Any (Annotator (StrictSeq (Script era) -> AuxiliaryDataRaw era))
-> Decode ('Closed Any) (Annotator (StrictSeq (Script era)))
-> Decode Any (Annotator (AuxiliaryDataRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (StrictSeq (Script era))
-> Decode ('Closed Any) (Annotator (StrictSeq (Script era)))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann (StrictSeq (Script era)
-> Decode ('Closed Any) (StrictSeq (Script era))
forall t (w :: Wrapped). t -> Decode w t
Emit StrictSeq (Script era)
forall a. StrictSeq a
StrictSeq.empty)
          )
      decodeFromList :: Decoder s (Annotator (AuxiliaryDataRaw era))
decodeFromList =
        Decode ('Closed 'Dense) (Annotator (AuxiliaryDataRaw era))
-> Decoder s (Annotator (AuxiliaryDataRaw era))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
          ( Decode
  ('Closed 'Dense)
  (Map Word64 Metadatum
   -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Decode
     ('Closed 'Dense)
     (Annotator
        (Map Word64 Metadatum
         -> StrictSeq (Script era) -> AuxiliaryDataRaw era))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((Map Word64 Metadatum
 -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
-> Decode
     ('Closed 'Dense)
     (Map Word64 Metadatum
      -> StrictSeq (Script era) -> AuxiliaryDataRaw era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
forall era.
Map Word64 Metadatum
-> StrictSeq (Script era) -> AuxiliaryDataRaw era
AuxiliaryDataRaw)
              Decode
  ('Closed 'Dense)
  (Annotator
     (Map Word64 Metadatum
      -> StrictSeq (Script era) -> AuxiliaryDataRaw era))
-> Decode ('Closed 'Dense) (Annotator (Map Word64 Metadatum))
-> Decode
     ('Closed 'Dense)
     (Annotator (StrictSeq (Script era) -> AuxiliaryDataRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed 'Dense) (Map Word64 Metadatum)
-> Decode ('Closed 'Dense) (Annotator (Map Word64 Metadatum))
forall (w :: Wrapped) t1. Decode w t1 -> Decode w (Annotator t1)
Ann ((forall s. Decoder s (Map Word64 Metadatum))
-> Decode ('Closed 'Dense) (Map Word64 Metadatum)
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s (Map Word64 Metadatum)
forall a b s.
(Ord a, FromCBOR a, FromCBOR b) =>
Decoder s (Map a b)
mapFromCBOR)
              Decode
  ('Closed 'Dense)
  (Annotator (StrictSeq (Script era) -> AuxiliaryDataRaw era))
-> Decode ('Closed 'Dense) (Annotator (StrictSeq (Script era)))
-> Decode ('Closed 'Dense) (Annotator (AuxiliaryDataRaw era))
forall (w1 :: Wrapped) a t (d :: Density).
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictSeq (Script era))))
-> Decode ('Closed 'Dense) (Annotator (StrictSeq (Script era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D (StrictSeq (Annotator (Script era))
-> Annotator (StrictSeq (Script era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (StrictSeq (Annotator (Script era))
 -> Annotator (StrictSeq (Script era)))
-> Decoder s (StrictSeq (Annotator (Script era)))
-> Decoder s (Annotator (StrictSeq (Script era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Script era))
-> Decoder s (StrictSeq (Annotator (Script era)))
forall s a. Decoder s a -> Decoder s (StrictSeq a)
decodeStrictSeq Decoder s (Annotator (Script era))
forall a s. FromCBOR a => Decoder s a
fromCBOR)
          )

deriving via
  (Mem (AuxiliaryDataRaw era))
  instance
    ( Era era,
      Core.AnnotatedData (Core.Script era)
    ) =>
    FromCBOR (Annotator (AuxiliaryData era))