{-# 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 TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Allegra.TxAuxData (
  AllegraTxAuxData (AllegraTxAuxData),
  AllegraTxAuxDataRaw,
  metadataAllegraTxAuxDataL,
  AllegraEraTxAuxData (..),
  timelockScriptsAllegraTxAuxDataL,
)
where

import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.Scripts (Timelock)
import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (..),
  EncCBOR (..),
  ToCBOR,
  peekTokenType,
 )
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.MemoBytes (
  EqRaw,
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.TxAuxData (Metadatum, ShelleyTxAuxData (..), validMetadatum)
import Codec.CBOR.Decoding (
  TokenType (
    TypeListLen,
    TypeListLen64,
    TypeListLenIndef,
    TypeMapLen,
    TypeMapLen64,
    TypeMapLenIndef
  ),
 )
import Control.DeepSeq (NFData, deepseq)
import Data.Map.Strict (Map)
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Word (Word64)
import GHC.Generics (Generic)
import Lens.Micro (Lens')
import NoThunks.Class (NoThunks)

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

-- | Raw, un-memoised metadata type
data AllegraTxAuxDataRaw era = AllegraTxAuxDataRaw
  { forall era. AllegraTxAuxDataRaw era -> Map Word64 Metadatum
atadrMetadata :: !(Map Word64 Metadatum)
  -- ^ Structured transaction metadata
  , forall era. AllegraTxAuxDataRaw era -> StrictSeq (Timelock era)
atadrTimelock :: !(StrictSeq (Timelock era))
  -- ^ 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
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (AllegraTxAuxDataRaw era) x -> AllegraTxAuxDataRaw era
forall era x.
AllegraTxAuxDataRaw era -> Rep (AllegraTxAuxDataRaw era) x
$cto :: forall era x.
Rep (AllegraTxAuxDataRaw era) x -> AllegraTxAuxDataRaw era
$cfrom :: forall era x.
AllegraTxAuxDataRaw era -> Rep (AllegraTxAuxDataRaw era) x
Generic, AllegraTxAuxDataRaw era -> AllegraTxAuxDataRaw era -> Bool
forall era.
AllegraTxAuxDataRaw era -> AllegraTxAuxDataRaw era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllegraTxAuxDataRaw era -> AllegraTxAuxDataRaw era -> Bool
$c/= :: forall era.
AllegraTxAuxDataRaw era -> AllegraTxAuxDataRaw era -> Bool
== :: AllegraTxAuxDataRaw era -> AllegraTxAuxDataRaw era -> Bool
$c== :: forall era.
AllegraTxAuxDataRaw era -> AllegraTxAuxDataRaw era -> Bool
Eq)

class EraTxAuxData era => AllegraEraTxAuxData era where
  timelockScriptsTxAuxDataL :: Lens' (TxAuxData era) (StrictSeq (Timelock era))

instance EraTxAuxData AllegraEra where
  type TxAuxData AllegraEra = AllegraTxAuxData AllegraEra

  mkBasicTxAuxData :: TxAuxData AllegraEra
mkBasicTxAuxData = forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

  metadataTxAuxDataL :: Lens' (TxAuxData AllegraEra) (Map Word64 Metadatum)
metadataTxAuxDataL = forall era.
Era era =>
Lens' (AllegraTxAuxData era) (Map Word64 Metadatum)
metadataAllegraTxAuxDataL

  upgradeTxAuxData :: EraTxAuxData (PreviousEra AllegraEra) =>
TxAuxData (PreviousEra AllegraEra) -> TxAuxData AllegraEra
upgradeTxAuxData (ShelleyTxAuxData Map Word64 Metadatum
md) = forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData Map Word64 Metadatum
md forall a. Monoid a => a
mempty

  validateTxAuxData :: ProtVer -> TxAuxData AllegraEra -> Bool
validateTxAuxData ProtVer
_ (AllegraTxAuxData Map Word64 Metadatum
md StrictSeq (Timelock AllegraEra)
as) = StrictSeq (Timelock AllegraEra)
as forall a b. NFData a => a -> b -> b
`deepseq` forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Metadatum -> Bool
validMetadatum Map Word64 Metadatum
md

metadataAllegraTxAuxDataL :: Era era => Lens' (AllegraTxAuxData era) (Map Word64 Metadatum)
metadataAllegraTxAuxDataL :: forall era.
Era era =>
Lens' (AllegraTxAuxData era) (Map Word64 Metadatum)
metadataAllegraTxAuxDataL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AllegraTxAuxDataRaw era -> Map Word64 Metadatum
atadrMetadata forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxAuxData era
txAuxDataRaw Map Word64 Metadatum
md -> RawType AllegraTxAuxData era
txAuxDataRaw {atadrMetadata :: Map Word64 Metadatum
atadrMetadata = Map Word64 Metadatum
md}

instance AllegraEraTxAuxData AllegraEra where
  timelockScriptsTxAuxDataL :: Lens' (TxAuxData AllegraEra) (StrictSeq (Timelock AllegraEra))
timelockScriptsTxAuxDataL = forall era.
Era era =>
Lens' (AllegraTxAuxData era) (StrictSeq (Timelock era))
timelockScriptsAllegraTxAuxDataL

timelockScriptsAllegraTxAuxDataL ::
  Era era => Lens' (AllegraTxAuxData era) (StrictSeq (Timelock era))
timelockScriptsAllegraTxAuxDataL :: forall era.
Era era =>
Lens' (AllegraTxAuxData era) (StrictSeq (Timelock era))
timelockScriptsAllegraTxAuxDataL =
  forall era (t :: * -> *) a b.
(Era era, EncCBOR (RawType t era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. AllegraTxAuxDataRaw era -> StrictSeq (Timelock era)
atadrTimelock forall a b. (a -> b) -> a -> b
$ \RawType AllegraTxAuxData era
txAuxDataRaw StrictSeq (Timelock era)
ts -> RawType AllegraTxAuxData era
txAuxDataRaw {atadrTimelock :: StrictSeq (Timelock era)
atadrTimelock = StrictSeq (Timelock era)
ts}

deriving instance Show (AllegraTxAuxDataRaw era)

deriving instance Era era => NoThunks (AllegraTxAuxDataRaw era)

instance NFData (AllegraTxAuxDataRaw era)

newtype AllegraTxAuxData era = AuxiliaryDataWithBytes (MemoBytes AllegraTxAuxDataRaw era)
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AllegraTxAuxData era) x -> AllegraTxAuxData era
forall era x. AllegraTxAuxData era -> Rep (AllegraTxAuxData era) x
$cto :: forall era x. Rep (AllegraTxAuxData era) x -> AllegraTxAuxData era
$cfrom :: forall era x. AllegraTxAuxData era -> Rep (AllegraTxAuxData era) x
Generic)
  deriving newtype (AllegraTxAuxData era -> AllegraTxAuxData era -> Bool
forall era. AllegraTxAuxData era -> AllegraTxAuxData era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllegraTxAuxData era -> AllegraTxAuxData era -> Bool
$c/= :: forall era. AllegraTxAuxData era -> AllegraTxAuxData era -> Bool
== :: AllegraTxAuxData era -> AllegraTxAuxData era -> Bool
$c== :: forall era. AllegraTxAuxData era -> AllegraTxAuxData era -> Bool
Eq, AllegraTxAuxData era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AllegraTxAuxData era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AllegraTxAuxData era) -> Size
forall {era}. Typeable era => Typeable (AllegraTxAuxData era)
forall era. Typeable era => AllegraTxAuxData 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 [AllegraTxAuxData era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AllegraTxAuxData era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AllegraTxAuxData era] -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [AllegraTxAuxData era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AllegraTxAuxData era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (AllegraTxAuxData era) -> Size
toCBOR :: AllegraTxAuxData era -> Encoding
$ctoCBOR :: forall era. Typeable era => AllegraTxAuxData era -> Encoding
ToCBOR, AllegraTxAuxData era -> Int
AllegraTxAuxData era -> ByteString
forall i. Proxy i -> AllegraTxAuxData era -> SafeHash i
forall era. AllegraTxAuxData era -> Int
forall era. AllegraTxAuxData era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> AllegraTxAuxData era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> AllegraTxAuxData era -> SafeHash i
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> AllegraTxAuxData era -> SafeHash i
originalBytesSize :: AllegraTxAuxData era -> Int
$coriginalBytesSize :: forall era. AllegraTxAuxData era -> Int
originalBytes :: AllegraTxAuxData era -> ByteString
$coriginalBytes :: forall era. AllegraTxAuxData era -> ByteString
SafeToHash)

instance Memoized AllegraTxAuxData where
  type RawType AllegraTxAuxData = AllegraTxAuxDataRaw

type instance MemoHashIndex AllegraTxAuxDataRaw = EraIndependentTxAuxData

instance HashAnnotated (AllegraTxAuxData era) EraIndependentTxAuxData where
  hashAnnotated :: AllegraTxAuxData era -> SafeHash EraIndependentTxAuxData
hashAnnotated = forall (t :: * -> *) era.
Memoized t =>
t era -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

deriving newtype instance Show (AllegraTxAuxData era)

deriving newtype instance Era era => NoThunks (AllegraTxAuxData era)

deriving newtype instance NFData (AllegraTxAuxData era)

instance EqRaw (AllegraTxAuxData era)

pattern AllegraTxAuxData ::
  Era era =>
  Map Word64 Metadatum ->
  StrictSeq (Timelock era) ->
  AllegraTxAuxData era
pattern $bAllegraTxAuxData :: forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
$mAllegraTxAuxData :: forall {r} {era}.
Era era =>
AllegraTxAuxData era
-> (Map Word64 Metadatum -> StrictSeq (Timelock era) -> r)
-> ((# #) -> r)
-> r
AllegraTxAuxData blob sp <- (getMemoRawType -> AllegraTxAuxDataRaw blob sp)
  where
    AllegraTxAuxData Map Word64 Metadatum
blob StrictSeq (Timelock era)
sp = 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.
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxDataRaw era
AllegraTxAuxDataRaw Map Word64 Metadatum
blob StrictSeq (Timelock era)
sp

{-# COMPLETE AllegraTxAuxData #-}

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

instance Era era => EncCBOR (AllegraTxAuxDataRaw era) where
  encCBOR :: AllegraTxAuxDataRaw era -> Encoding
encCBOR (AllegraTxAuxDataRaw Map Word64 Metadatum
blob StrictSeq (Timelock era)
sp) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode (forall t. t -> Encode ('Closed 'Dense) t
Rec forall era.
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxDataRaw era
AllegraTxAuxDataRaw 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 Map Word64 Metadatum
blob 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 StrictSeq (Timelock era)
sp)

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

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

deriving via
  (Mem AllegraTxAuxDataRaw era)
  instance
    Era era => DecCBOR (Annotator (AllegraTxAuxData era))