{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# 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 UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.TxAuxData (
  ShelleyTxAuxData (ShelleyTxAuxData),
  ShelleyTxAuxDataRaw,
  hashShelleyTxAuxData,

  -- * Re-exports
  Metadatum (..),
  validMetadatum,
)
where

import Cardano.Crypto.Hash.Class (HashAlgorithm)
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
import Cardano.Ledger.Binary (Annotator (..), DecCBOR (..), EncCBOR (..))
import qualified Cardano.Ledger.Binary.Plain as Plain (ToCBOR)
import Cardano.Ledger.Core (Era (..), EraTxAuxData (..))
import Cardano.Ledger.Crypto (Crypto (HASH))
import Cardano.Ledger.Hashes (EraIndependentTxAuxData)
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (RawType),
  getMemoRawType,
  getMemoSafeHash,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.Metadata (Metadatum (..), validMetadatum)
import Cardano.Ledger.SafeHash (
  HashAnnotated,
  SafeHash,
  SafeToHash (..),
  hashAnnotated,
 )
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Control.DeepSeq (NFData)
import Data.Map.Strict (Map)
import Data.Typeable (Proxy (..))
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))

newtype ShelleyTxAuxDataRaw era = ShelleyTxAuxDataRaw
  { forall era. ShelleyTxAuxDataRaw era -> Map Word64 Metadatum
stadrMetadata :: Map Word64 Metadatum
  }
  deriving (ShelleyTxAuxDataRaw era -> ShelleyTxAuxDataRaw era -> Bool
forall era.
ShelleyTxAuxDataRaw era -> ShelleyTxAuxDataRaw era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyTxAuxDataRaw era -> ShelleyTxAuxDataRaw era -> Bool
$c/= :: forall era.
ShelleyTxAuxDataRaw era -> ShelleyTxAuxDataRaw era -> Bool
== :: ShelleyTxAuxDataRaw era -> ShelleyTxAuxDataRaw era -> Bool
$c== :: forall era.
ShelleyTxAuxDataRaw era -> ShelleyTxAuxDataRaw era -> Bool
Eq, Int -> ShelleyTxAuxDataRaw era -> ShowS
forall era. Int -> ShelleyTxAuxDataRaw era -> ShowS
forall era. [ShelleyTxAuxDataRaw era] -> ShowS
forall era. ShelleyTxAuxDataRaw era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyTxAuxDataRaw era] -> ShowS
$cshowList :: forall era. [ShelleyTxAuxDataRaw era] -> ShowS
show :: ShelleyTxAuxDataRaw era -> String
$cshow :: forall era. ShelleyTxAuxDataRaw era -> String
showsPrec :: Int -> ShelleyTxAuxDataRaw era -> ShowS
$cshowsPrec :: forall era. Int -> ShelleyTxAuxDataRaw era -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyTxAuxDataRaw era) x -> ShelleyTxAuxDataRaw era
forall era x.
ShelleyTxAuxDataRaw era -> Rep (ShelleyTxAuxDataRaw era) x
$cto :: forall era x.
Rep (ShelleyTxAuxDataRaw era) x -> ShelleyTxAuxDataRaw era
$cfrom :: forall era x.
ShelleyTxAuxDataRaw era -> Rep (ShelleyTxAuxDataRaw era) x
Generic)
  deriving newtype (ShelleyTxAuxDataRaw era -> ()
forall era. ShelleyTxAuxDataRaw era -> ()
forall a. (a -> ()) -> NFData a
rnf :: ShelleyTxAuxDataRaw era -> ()
$crnf :: forall era. ShelleyTxAuxDataRaw era -> ()
NFData)

deriving via
  InspectHeapNamed "ShelleyTxAuxDataRaw" (ShelleyTxAuxDataRaw era)
  instance
    NoThunks (ShelleyTxAuxDataRaw era)

deriving newtype instance Era era => EncCBOR (ShelleyTxAuxDataRaw era)

deriving newtype instance Era era => DecCBOR (ShelleyTxAuxDataRaw era)

instance Era era => DecCBOR (Annotator (ShelleyTxAuxDataRaw era)) where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxAuxDataRaw era))
decCBOR = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR

deriving via
  InspectHeapNamed "ShelleyTxAuxDataRaw" (ShelleyTxAuxData era)
  instance
    NoThunks (ShelleyTxAuxData era)

deriving via
  (Mem ShelleyTxAuxDataRaw era)
  instance
    Era era => DecCBOR (Annotator (ShelleyTxAuxData era))

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

instance Memoized ShelleyTxAuxData where
  type RawType ShelleyTxAuxData = ShelleyTxAuxDataRaw

instance Crypto c => EraTxAuxData (ShelleyEra c) where
  type TxAuxData (ShelleyEra c) = ShelleyTxAuxData (ShelleyEra c)

  mkBasicTxAuxData :: TxAuxData (ShelleyEra c)
mkBasicTxAuxData = forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData forall a. Monoid a => a
mempty

  metadataTxAuxDataL :: Lens' (TxAuxData (ShelleyEra c)) (Map Word64 Metadatum)
metadataTxAuxDataL =
    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. ShelleyTxAuxDataRaw era -> Map Word64 Metadatum
stadrMetadata forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxAuxData (ShelleyEra c)
txAuxDataRaw Map Word64 Metadatum
md -> RawType ShelleyTxAuxData (ShelleyEra c)
txAuxDataRaw {stadrMetadata :: Map Word64 Metadatum
stadrMetadata = Map Word64 Metadatum
md}

  -- Calling this partial function will result in compilation error, since ByronEra has
  -- no instance for EraTxOut type class.
  upgradeTxAuxData :: EraTxAuxData (PreviousEra (ShelleyEra c)) =>
TxAuxData (PreviousEra (ShelleyEra c)) -> TxAuxData (ShelleyEra c)
upgradeTxAuxData = forall a. HasCallStack => String -> a
error String
"It is not possible to translate Byron TxOut with 'upgradeTxOut'"

  validateTxAuxData :: ProtVer -> TxAuxData (ShelleyEra c) -> Bool
validateTxAuxData ProtVer
_ (ShelleyTxAuxData Map Word64 Metadatum
m) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Metadatum -> Bool
validMetadatum Map Word64 Metadatum
m

  hashTxAuxData :: TxAuxData (ShelleyEra c)
-> AuxiliaryDataHash (EraCrypto (ShelleyEra c))
hashTxAuxData TxAuxData (ShelleyEra c)
metadata =
    forall c. SafeHash c EraIndependentTxAuxData -> AuxiliaryDataHash c
AuxiliaryDataHash (forall t c index.
(SafeToHash t, HashAlgorithm (HASH c)) =>
Proxy c -> Proxy index -> t -> SafeHash c index
makeHashWithExplicitProxys (forall {k} (t :: k). Proxy t
Proxy @c) Proxy EraIndependentTxAuxData
index TxAuxData (ShelleyEra c)
metadata)
    where
      index :: Proxy EraIndependentTxAuxData
index = forall {k} (t :: k). Proxy t
Proxy @EraIndependentTxAuxData

instance EqRaw (ShelleyTxAuxData era)

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

hashShelleyTxAuxData ::
  Era era =>
  ShelleyTxAuxData era ->
  SafeHash (EraCrypto era) EraIndependentTxAuxData
hashShelleyTxAuxData :: forall era.
Era era =>
ShelleyTxAuxData era
-> SafeHash (EraCrypto era) EraIndependentTxAuxData
hashShelleyTxAuxData = forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated

pattern ShelleyTxAuxData :: forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
pattern $bShelleyTxAuxData :: forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
$mShelleyTxAuxData :: forall {r} {era}.
Era era =>
ShelleyTxAuxData era
-> (Map Word64 Metadatum -> r) -> ((# #) -> r) -> r
ShelleyTxAuxData m <-
  (getMemoRawType -> ShelleyTxAuxDataRaw m)
  where
    ShelleyTxAuxData Map Word64 Metadatum
m = 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 -> ShelleyTxAuxDataRaw era
ShelleyTxAuxDataRaw Map Word64 Metadatum
m

{-# COMPLETE ShelleyTxAuxData #-}

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

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

type instance MemoHashIndex ShelleyTxAuxDataRaw = EraIndependentTxAuxData