{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

import Cardano.Binary (FromCBOR (..), ToCBOR (..), peekTokenType)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Era (Era)
import Codec.CBOR.Decoding
  ( TokenType
      ( TypeListLen,
        TypeListLen64,
        TypeListLenIndef,
        TypeMapLen,
        TypeMapLen64,
        TypeMapLenIndef
      ),
  )
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
import Shelley.Spec.Ledger.Metadata
  ( Metadatum,
  )
import Shelley.Spec.Ledger.Serialization (mapFromCBOR, mapToCBOR)

-- | 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)

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)

deriving newtype instance
  (Era era, Core.ChainData (Core.Script 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)

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 #-}

--------------------------------------------------------------------------------
-- 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))