{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.MempoolPayload (
  MempoolPayload,
  AMempoolPayload (..),
)
where

import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.UTxO (ATxAux)
import qualified Cardano.Chain.Update as Update
import Cardano.Ledger.Binary (
  ByteSpan,
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeWord8,
  encodeListLen,
  encodePreEncoded,
  enforceSize,
  fromByronCBOR,
  recoverBytes,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)

-- | A payload which can be submitted into or between mempools via the
-- transaction submission protocol.
type MempoolPayload = AMempoolPayload ()

-- | A payload which can be submitted into or between mempools via the
-- transaction submission protocol.
data AMempoolPayload a
  = -- | A transaction payload (transaction and witness).
    MempoolTx !(ATxAux a)
  | -- | A delegation certificate payload.
    MempoolDlg !(Delegation.ACertificate a)
  | -- | An update proposal payload.
    MempoolUpdateProposal !(Update.AProposal a)
  | -- | An update vote payload.
    MempoolUpdateVote !(Update.AVote a)
  deriving (AMempoolPayload a -> AMempoolPayload a -> Bool
forall a. Eq a => AMempoolPayload a -> AMempoolPayload a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AMempoolPayload a -> AMempoolPayload a -> Bool
$c/= :: forall a. Eq a => AMempoolPayload a -> AMempoolPayload a -> Bool
== :: AMempoolPayload a -> AMempoolPayload a -> Bool
$c== :: forall a. Eq a => AMempoolPayload a -> AMempoolPayload a -> Bool
Eq, Int -> AMempoolPayload a -> ShowS
forall a. Show a => Int -> AMempoolPayload a -> ShowS
forall a. Show a => [AMempoolPayload a] -> ShowS
forall a. Show a => AMempoolPayload a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AMempoolPayload a] -> ShowS
$cshowList :: forall a. Show a => [AMempoolPayload a] -> ShowS
show :: AMempoolPayload a -> String
$cshow :: forall a. Show a => AMempoolPayload a -> String
showsPrec :: Int -> AMempoolPayload a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AMempoolPayload a -> ShowS
Show, forall a b. a -> AMempoolPayload b -> AMempoolPayload a
forall a b. (a -> b) -> AMempoolPayload a -> AMempoolPayload b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AMempoolPayload b -> AMempoolPayload a
$c<$ :: forall a b. a -> AMempoolPayload b -> AMempoolPayload a
fmap :: forall a b. (a -> b) -> AMempoolPayload a -> AMempoolPayload b
$cfmap :: forall a b. (a -> b) -> AMempoolPayload a -> AMempoolPayload b
Functor)

instance ToCBOR MempoolPayload where
  toCBOR :: MempoolPayload -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR MempoolPayload where
  fromCBOR :: forall s. Decoder s MempoolPayload
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance ToCBOR (AMempoolPayload ByteString) where
  toCBOR :: AMempoolPayload ByteString -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR (AMempoolPayload ByteSpan) where
  fromCBOR :: forall s. Decoder s (AMempoolPayload ByteSpan)
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR MempoolPayload where
  encCBOR :: MempoolPayload -> Encoding
encCBOR (MempoolTx ATxAux ()
tp) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ATxAux ()
tp
  encCBOR (MempoolDlg ACertificate ()
dp) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR ACertificate ()
dp
  encCBOR (MempoolUpdateProposal AProposal ()
upp) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR AProposal ()
upp
  encCBOR (MempoolUpdateVote AVote ()
upv) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR AVote ()
upv

instance EncCBOR (AMempoolPayload ByteString) where
  encCBOR :: AMempoolPayload ByteString -> Encoding
encCBOR (MempoolTx ATxAux ByteString
tp) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8) forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (forall t. Decoded t => t -> ByteString
recoverBytes ATxAux ByteString
tp)
  encCBOR (MempoolDlg ACertificate ByteString
dp) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8) forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (forall t. Decoded t => t -> ByteString
recoverBytes ACertificate ByteString
dp)
  encCBOR (MempoolUpdateProposal AProposal ByteString
upp) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8) forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (forall t. Decoded t => t -> ByteString
recoverBytes AProposal ByteString
upp)
  encCBOR (MempoolUpdateVote AVote ByteString
upv) =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded (forall t. Decoded t => t -> ByteString
recoverBytes AVote ByteString
upv)

instance DecCBOR MempoolPayload where
  decCBOR :: forall s. Decoder s MempoolPayload
decCBOR = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @(AMempoolPayload ByteSpan)

instance DecCBOR (AMempoolPayload ByteSpan) where
  decCBOR :: forall s. Decoder s (AMempoolPayload ByteSpan)
decCBOR = do
    forall s. Text -> Int -> Decoder s ()
enforceSize Text
"MempoolPayload" Int
2
    forall s. Decoder s Word8
decodeWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Word8
0 -> forall a. ATxAux a -> AMempoolPayload a
MempoolTx forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
1 -> forall a. ACertificate a -> AMempoolPayload a
MempoolDlg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
2 -> forall a. AProposal a -> AMempoolPayload a
MempoolUpdateProposal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
3 -> forall a. AVote a -> AMempoolPayload a
MempoolUpdateVote forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
tag -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"MempoolPayload" Word8
tag