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

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

import Cardano.Binary
  ( ByteSpan,
    DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeWord8,
    encodeListLen,
    encodePreEncoded,
    enforceSize,
    recoverBytes,
  )
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.UTxO (ATxAux)
import qualified Cardano.Chain.Update as Update
import Cardano.Prelude

-- | 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
(AMempoolPayload a -> AMempoolPayload a -> Bool)
-> (AMempoolPayload a -> AMempoolPayload a -> Bool)
-> Eq (AMempoolPayload a)
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
[AMempoolPayload a] -> ShowS
AMempoolPayload a -> String
(Int -> AMempoolPayload a -> ShowS)
-> (AMempoolPayload a -> String)
-> ([AMempoolPayload a] -> ShowS)
-> Show (AMempoolPayload a)
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, a -> AMempoolPayload b -> AMempoolPayload a
(a -> b) -> AMempoolPayload a -> AMempoolPayload b
(forall a b. (a -> b) -> AMempoolPayload a -> AMempoolPayload b)
-> (forall a b. a -> AMempoolPayload b -> AMempoolPayload a)
-> Functor AMempoolPayload
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
<$ :: a -> AMempoolPayload b -> AMempoolPayload a
$c<$ :: forall a b. a -> AMempoolPayload b -> AMempoolPayload a
fmap :: (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 (MempoolTx ATxAux ()
tp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ATxAux () -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ATxAux ()
tp
  toCBOR (MempoolDlg ACertificate ()
dp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ACertificate () -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ACertificate ()
dp
  toCBOR (MempoolUpdateProposal AProposal ()
upp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AProposal () -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR AProposal ()
upp
  toCBOR (MempoolUpdateVote AVote ()
upv) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AVote () -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR AVote ()
upv

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

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

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