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

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

import Cardano.Ledger.Binary (Annotator, DecCBOR (..), EncCBOR, ToCBOR, Version)
import Cardano.Ledger.Core (Era, EraTx, TopTx, Tx, eraProtVerLow)
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Tx ()
import Cardano.Ledger.Hashes (
  EraIndependentEbReferences,
  EraIndependentTx,
  HashAnnotated,
  SafeHash,
  SafeToHash,
  hashAnnotated,
 )
import Cardano.Ledger.MemoBytes (
  EqRaw,
  Mem,
  MemoBytes,
  MemoHashIndex,
  Memoized (..),
  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 (SafeHash EraIndependentTx) Word32
unEbReferencesRaw :: OMap (SafeHash 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)

instance DecCBOR EbReferencesRaw where
  decCBOR :: forall s. Decoder s EbReferencesRaw
decCBOR = do
    refs <- Decoder s (OMap (SafeHash EraIndependentTx) Word32)
forall s. Decoder s (OMap (SafeHash EraIndependentTx) Word32)
forall a s. DecCBOR a => Decoder s a
decCBOR
    EbReferencesRaw refs <$ when (null refs) (fail "Empty EbReferences are not allowed")

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

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, Typeable EbReferences
Typeable EbReferences =>
(EbReferences -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy EbReferences -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [EbReferences] -> Size)
-> ToCBOR EbReferences
EbReferences -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [EbReferences] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy EbReferences -> Size
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
$ctoCBOR :: EbReferences -> Encoding
toCBOR :: EbReferences -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy EbReferences -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy EbReferences -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [EbReferences] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [EbReferences] -> Size
ToCBOR, 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

deriving via Mem EbReferencesRaw instance DecCBOR (Annotator EbReferences)

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 (SafeHash EraIndependentTx) Word32 -> EbReferences
mkEbReferences :: Version -> OMap (SafeHash 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 (SafeHash EraIndependentTx) Word32 -> EbReferencesRaw)
-> OMap (SafeHash EraIndependentTx) Word32
-> EbReferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap (SafeHash EraIndependentTx) Word32 -> EbReferencesRaw
EbReferencesRaw

getEbReferences :: EbReferences -> OMap (SafeHash EraIndependentTx) Word32
getEbReferences :: EbReferences -> OMap (SafeHash EraIndependentTx) Word32
getEbReferences = EbReferencesRaw -> OMap (SafeHash EraIndependentTx) Word32
unEbReferencesRaw (EbReferencesRaw -> OMap (SafeHash EraIndependentTx) Word32)
-> (EbReferences -> EbReferencesRaw)
-> EbReferences
-> OMap (SafeHash 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

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

mkBasicEndorserBlockDijkstra :: forall era. Era era => DijkstraEndorserBlock era
mkBasicEndorserBlockDijkstra :: forall era. Era era => DijkstraEndorserBlock era
mkBasicEndorserBlockDijkstra =
  EbReferences -> EbTransactions era -> DijkstraEndorserBlock era
forall era.
EbReferences -> EbTransactions era -> DijkstraEndorserBlock era
DijkstraEndorserBlock (Version -> OMap (SafeHash EraIndependentTx) Word32 -> EbReferences
mkEbReferences (forall era. Era era => Version
eraProtVerLow @era) OMap (SafeHash EraIndependentTx) Word32
forall a. Monoid a => a
mempty) (EbTransactions era -> DijkstraEndorserBlock era)
-> EbTransactions era -> DijkstraEndorserBlock era
forall a b. (a -> b) -> a -> b
$ StrictSeq (Tx TopTx era) -> EbTransactions era
forall era. StrictSeq (Tx TopTx era) -> EbTransactions era
EbTransactions StrictSeq (Tx TopTx era)
forall a. Monoid a => a
mempty

instance EraEndorserBlock DijkstraEra where
  type EndorserBlock DijkstraEra = DijkstraEndorserBlock DijkstraEra
  mkBasicEndorserBlock :: EndorserBlock DijkstraEra
mkBasicEndorserBlock = EndorserBlock DijkstraEra
DijkstraEndorserBlock DijkstraEra
forall era. Era era => DijkstraEndorserBlock era
mkBasicEndorserBlockDijkstra
  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}