{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

-- | Endorser blocks and references
module Cardano.Ledger.Dijkstra.Block.Endorser (
  EbReferences,
  mkEbReferences,
  getEbReferences,
  EbTransactions (..),
  DijkstraEndorserBlock (..),
  EraEndorserBlock (..),
) where

import Cardano.Crypto.Hash.Class (Hash)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR, Version)
import Cardano.Ledger.Core (EraTx, TopTx, Tx)
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Tx ()
import Cardano.Ledger.Hashes (
  EraIndependentEbReferences,
  EraIndependentTx,
  HASH,
  HashAnnotated,
  SafeToHash,
  hashAnnotated,
 )
import Cardano.Ledger.MemoBytes (
  EqRaw,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  decodeMemoized,
  getMemoRawType,
  getMemoSafeHash,
  mkMemoized,
 )
import Control.DeepSeq (NFData)
import Control.Monad (when)
import Data.Kind (Type)
import Data.Sequence.Strict (StrictSeq)
import Data.SimpleOMap.Strict (OMap)
import Data.Typeable (Typeable)
import Data.Word (Word32)
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks)

newtype EbReferencesRaw = EbReferencesRaw
  { EbReferencesRaw -> OMap (Hash HASH EraIndependentTx) Word32
unEbReferencesRaw :: OMap (Hash HASH EraIndependentTx) Word32
  }
  deriving newtype (EbReferencesRaw -> EbReferencesRaw -> Bool
(EbReferencesRaw -> EbReferencesRaw -> Bool)
-> (EbReferencesRaw -> EbReferencesRaw -> Bool)
-> Eq EbReferencesRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EbReferencesRaw -> EbReferencesRaw -> Bool
== :: EbReferencesRaw -> EbReferencesRaw -> Bool
$c/= :: EbReferencesRaw -> EbReferencesRaw -> Bool
/= :: EbReferencesRaw -> EbReferencesRaw -> Bool
Eq, Int -> EbReferencesRaw -> ShowS
[EbReferencesRaw] -> ShowS
EbReferencesRaw -> String
(Int -> EbReferencesRaw -> ShowS)
-> (EbReferencesRaw -> String)
-> ([EbReferencesRaw] -> ShowS)
-> Show EbReferencesRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EbReferencesRaw -> ShowS
showsPrec :: Int -> EbReferencesRaw -> ShowS
$cshow :: EbReferencesRaw -> String
show :: EbReferencesRaw -> String
$cshowList :: [EbReferencesRaw] -> ShowS
showList :: [EbReferencesRaw] -> ShowS
Show, EbReferencesRaw -> ()
(EbReferencesRaw -> ()) -> NFData EbReferencesRaw
forall a. (a -> ()) -> NFData a
$crnf :: EbReferencesRaw -> ()
rnf :: EbReferencesRaw -> ()
NFData, Context -> EbReferencesRaw -> IO (Maybe ThunkInfo)
Proxy EbReferencesRaw -> String
(Context -> EbReferencesRaw -> IO (Maybe ThunkInfo))
-> (Context -> EbReferencesRaw -> IO (Maybe ThunkInfo))
-> (Proxy EbReferencesRaw -> String)
-> NoThunks EbReferencesRaw
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> EbReferencesRaw -> IO (Maybe ThunkInfo)
noThunks :: Context -> EbReferencesRaw -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> EbReferencesRaw -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> EbReferencesRaw -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy EbReferencesRaw -> String
showTypeOf :: Proxy EbReferencesRaw -> String
NoThunks, EbReferencesRaw -> Encoding
(EbReferencesRaw -> Encoding) -> EncCBOR EbReferencesRaw
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: EbReferencesRaw -> Encoding
encCBOR :: EbReferencesRaw -> Encoding
EncCBOR)

type instance MemoHashIndex EbReferencesRaw = EraIndependentEbReferences

newtype EbReferences = MkEbReferences (MemoBytes EbReferencesRaw)
  deriving stock ((forall x. EbReferences -> Rep EbReferences x)
-> (forall x. Rep EbReferences x -> EbReferences)
-> Generic EbReferences
forall x. Rep EbReferences x -> EbReferences
forall x. EbReferences -> Rep EbReferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EbReferences -> Rep EbReferences x
from :: forall x. EbReferences -> Rep EbReferences x
$cto :: forall x. Rep EbReferences x -> EbReferences
to :: forall x. Rep EbReferences x -> EbReferences
Generic)
  deriving newtype (EbReferences -> EbReferences -> Bool
(EbReferences -> EbReferences -> Bool)
-> (EbReferences -> EbReferences -> Bool) -> Eq EbReferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EbReferences -> EbReferences -> Bool
== :: EbReferences -> EbReferences -> Bool
$c/= :: EbReferences -> EbReferences -> Bool
/= :: EbReferences -> EbReferences -> Bool
Eq, Int -> EbReferences -> ShowS
[EbReferences] -> ShowS
EbReferences -> String
(Int -> EbReferences -> ShowS)
-> (EbReferences -> String)
-> ([EbReferences] -> ShowS)
-> Show EbReferences
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EbReferences -> ShowS
showsPrec :: Int -> EbReferences -> ShowS
$cshow :: EbReferences -> String
show :: EbReferences -> String
$cshowList :: [EbReferences] -> ShowS
showList :: [EbReferences] -> ShowS
Show, EbReferences -> ()
(EbReferences -> ()) -> NFData EbReferences
forall a. (a -> ()) -> NFData a
$crnf :: EbReferences -> ()
rnf :: EbReferences -> ()
NFData, Context -> EbReferences -> IO (Maybe ThunkInfo)
Proxy EbReferences -> String
(Context -> EbReferences -> IO (Maybe ThunkInfo))
-> (Context -> EbReferences -> IO (Maybe ThunkInfo))
-> (Proxy EbReferences -> String)
-> NoThunks EbReferences
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> EbReferences -> IO (Maybe ThunkInfo)
noThunks :: Context -> EbReferences -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> EbReferences -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> EbReferences -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy EbReferences -> String
showTypeOf :: Proxy EbReferences -> String
NoThunks, EbReferences -> Encoding
(EbReferences -> Encoding) -> EncCBOR EbReferences
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: EbReferences -> Encoding
encCBOR :: EbReferences -> Encoding
EncCBOR, EbReferences -> Int
EbReferences -> ByteString
(EbReferences -> ByteString)
-> (EbReferences -> Int)
-> (forall i. Proxy i -> EbReferences -> SafeHash i)
-> SafeToHash EbReferences
forall i. Proxy i -> EbReferences -> SafeHash i
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
$coriginalBytes :: EbReferences -> ByteString
originalBytes :: EbReferences -> ByteString
$coriginalBytesSize :: EbReferences -> Int
originalBytesSize :: EbReferences -> Int
$cmakeHashWithExplicitProxys :: forall i. Proxy i -> EbReferences -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> EbReferences -> SafeHash i
SafeToHash)

instance Memoized EbReferences where
  type RawType EbReferences = EbReferencesRaw

instance DecCBOR EbReferences where
  decCBOR :: forall s. Decoder s EbReferences
decCBOR = MemoBytes EbReferencesRaw -> EbReferences
MkEbReferences (MemoBytes EbReferencesRaw -> EbReferences)
-> Decoder s (MemoBytes EbReferencesRaw) -> Decoder s EbReferences
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s EbReferencesRaw -> Decoder s (MemoBytes EbReferencesRaw)
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s EbReferencesRaw
forall {s}. Decoder s EbReferencesRaw
decodeNonEmpty
    where
      decodeNonEmpty :: Decoder s EbReferencesRaw
decodeNonEmpty = do
        refs <- Decoder s (OMap (Hash HASH EraIndependentTx) Word32)
forall s. Decoder s (OMap (Hash HASH EraIndependentTx) Word32)
forall a s. DecCBOR a => Decoder s a
decCBOR
        EbReferencesRaw refs <$ when (null refs) (fail "Empty EbReferences are not allowed")

instance HashAnnotated EbReferences EraIndependentEbReferences where
  hashAnnotated :: EbReferences -> SafeHash EraIndependentEbReferences
hashAnnotated = EbReferences -> SafeHash EraIndependentEbReferences
EbReferences -> SafeHash (MemoHashIndex (RawType EbReferences))
forall t. Memoized t => t -> SafeHash (MemoHashIndex (RawType t))
getMemoSafeHash

instance EqRaw EbReferences

mkEbReferences :: Version -> OMap (Hash HASH EraIndependentTx) Word32 -> EbReferences
mkEbReferences :: Version -> OMap (Hash HASH EraIndependentTx) Word32 -> EbReferences
mkEbReferences Version
v = Version -> RawType EbReferences -> EbReferences
forall t.
(EncCBOR (RawType t), Memoized t) =>
Version -> RawType t -> t
mkMemoized Version
v (EbReferencesRaw -> EbReferences)
-> (OMap (Hash HASH EraIndependentTx) Word32 -> EbReferencesRaw)
-> OMap (Hash HASH EraIndependentTx) Word32
-> EbReferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap (Hash HASH EraIndependentTx) Word32 -> EbReferencesRaw
EbReferencesRaw

getEbReferences :: EbReferences -> OMap (Hash HASH EraIndependentTx) Word32
getEbReferences :: EbReferences -> OMap (Hash HASH EraIndependentTx) Word32
getEbReferences = EbReferencesRaw -> OMap (Hash HASH EraIndependentTx) Word32
unEbReferencesRaw (EbReferencesRaw -> OMap (Hash HASH EraIndependentTx) Word32)
-> (EbReferences -> EbReferencesRaw)
-> EbReferences
-> OMap (Hash HASH EraIndependentTx) Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EbReferences -> RawType EbReferences
EbReferences -> EbReferencesRaw
forall t. Memoized t => t -> RawType t
getMemoRawType

newtype EbTransactions era = EbTransactions
  { forall era. EbTransactions era -> StrictSeq (Tx TopTx era)
unEbTransactions :: StrictSeq (Tx TopTx era)
  }
  deriving stock ((forall x. EbTransactions era -> Rep (EbTransactions era) x)
-> (forall x. Rep (EbTransactions era) x -> EbTransactions era)
-> Generic (EbTransactions era)
forall x. Rep (EbTransactions era) x -> EbTransactions era
forall x. EbTransactions era -> Rep (EbTransactions era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (EbTransactions era) x -> EbTransactions era
forall era x. EbTransactions era -> Rep (EbTransactions era) x
$cfrom :: forall era x. EbTransactions era -> Rep (EbTransactions era) x
from :: forall x. EbTransactions era -> Rep (EbTransactions era) x
$cto :: forall era x. Rep (EbTransactions era) x -> EbTransactions era
to :: forall x. Rep (EbTransactions era) x -> EbTransactions era
Generic)

deriving stock instance Eq (Tx TopTx era) => Eq (EbTransactions era)

deriving stock instance Show (Tx TopTx era) => Show (EbTransactions era)

deriving newtype instance NFData (Tx TopTx era) => NFData (EbTransactions era)

deriving newtype instance NoThunks (Tx TopTx era) => NoThunks (EbTransactions era)

data DijkstraEndorserBlock era = DijkstraEndorserBlock
  { forall era. DijkstraEndorserBlock era -> EbReferences
debReferences :: !EbReferences
  , forall era. DijkstraEndorserBlock era -> EbTransactions era
debTransactions :: !(EbTransactions era)
  }
  deriving stock ((forall x.
 DijkstraEndorserBlock era -> Rep (DijkstraEndorserBlock era) x)
-> (forall x.
    Rep (DijkstraEndorserBlock era) x -> DijkstraEndorserBlock era)
-> Generic (DijkstraEndorserBlock era)
forall x.
Rep (DijkstraEndorserBlock era) x -> DijkstraEndorserBlock era
forall x.
DijkstraEndorserBlock era -> Rep (DijkstraEndorserBlock era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (DijkstraEndorserBlock era) x -> DijkstraEndorserBlock era
forall era x.
DijkstraEndorserBlock era -> Rep (DijkstraEndorserBlock era) x
$cfrom :: forall era x.
DijkstraEndorserBlock era -> Rep (DijkstraEndorserBlock era) x
from :: forall x.
DijkstraEndorserBlock era -> Rep (DijkstraEndorserBlock era) x
$cto :: forall era x.
Rep (DijkstraEndorserBlock era) x -> DijkstraEndorserBlock era
to :: forall x.
Rep (DijkstraEndorserBlock era) x -> DijkstraEndorserBlock era
Generic)

deriving stock instance Eq (Tx TopTx era) => Eq (DijkstraEndorserBlock era)

deriving stock instance Show (Tx TopTx era) => Show (DijkstraEndorserBlock era)

deriving anyclass instance NFData (Tx TopTx era) => NFData (DijkstraEndorserBlock era)

deriving anyclass instance
  (Typeable era, NoThunks (Tx TopTx era)) => NoThunks (DijkstraEndorserBlock era)

class EraTx era => EraEndorserBlock era where
  type EndorserBlock era = (r :: Type) | r -> era

  referencesEndorserBlockL :: Lens' (EndorserBlock era) EbReferences
  transactionsEndorserBlockL :: Lens' (EndorserBlock era) (EbTransactions era)

instance EraEndorserBlock DijkstraEra where
  type EndorserBlock DijkstraEra = DijkstraEndorserBlock DijkstraEra
  referencesEndorserBlockL :: Lens' (EndorserBlock DijkstraEra) EbReferences
referencesEndorserBlockL = (EndorserBlock DijkstraEra -> EbReferences)
-> (EndorserBlock DijkstraEra
    -> EbReferences -> EndorserBlock DijkstraEra)
-> Lens' (EndorserBlock DijkstraEra) EbReferences
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EndorserBlock DijkstraEra -> EbReferences
DijkstraEndorserBlock DijkstraEra -> EbReferences
forall era. DijkstraEndorserBlock era -> EbReferences
debReferences ((EndorserBlock DijkstraEra
  -> EbReferences -> EndorserBlock DijkstraEra)
 -> Lens' (EndorserBlock DijkstraEra) EbReferences)
-> (EndorserBlock DijkstraEra
    -> EbReferences -> EndorserBlock DijkstraEra)
-> Lens' (EndorserBlock DijkstraEra) EbReferences
forall a b. (a -> b) -> a -> b
$ \EndorserBlock DijkstraEra
b EbReferences
r -> EndorserBlock DijkstraEra
b {debReferences = r}
  transactionsEndorserBlockL :: Lens' (EndorserBlock DijkstraEra) (EbTransactions DijkstraEra)
transactionsEndorserBlockL = (EndorserBlock DijkstraEra -> EbTransactions DijkstraEra)
-> (EndorserBlock DijkstraEra
    -> EbTransactions DijkstraEra -> EndorserBlock DijkstraEra)
-> Lens' (EndorserBlock DijkstraEra) (EbTransactions DijkstraEra)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens EndorserBlock DijkstraEra -> EbTransactions DijkstraEra
DijkstraEndorserBlock DijkstraEra -> EbTransactions DijkstraEra
forall era. DijkstraEndorserBlock era -> EbTransactions era
debTransactions ((EndorserBlock DijkstraEra
  -> EbTransactions DijkstraEra -> EndorserBlock DijkstraEra)
 -> Lens' (EndorserBlock DijkstraEra) (EbTransactions DijkstraEra))
-> (EndorserBlock DijkstraEra
    -> EbTransactions DijkstraEra -> EndorserBlock DijkstraEra)
-> Lens' (EndorserBlock DijkstraEra) (EbTransactions DijkstraEra)
forall a b. (a -> b) -> a -> b
$ \EndorserBlock DijkstraEra
b EbTransactions DijkstraEra
t -> EndorserBlock DijkstraEra
b {debTransactions = t}