{-# 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
(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
$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
/= :: 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
$cshowsPrec :: forall a. Show a => Int -> AMempoolPayload a -> ShowS
showsPrec :: Int -> AMempoolPayload a -> ShowS
$cshow :: forall a. Show a => AMempoolPayload a -> String
show :: AMempoolPayload a -> String
$cshowList :: forall a. Show a => [AMempoolPayload a] -> ShowS
showList :: [AMempoolPayload a] -> ShowS
Show, (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
$cfmap :: forall a b. (a -> b) -> AMempoolPayload a -> AMempoolPayload b
fmap :: forall a b. (a -> b) -> AMempoolPayload a -> AMempoolPayload b
$c<$ :: forall a b. a -> AMempoolPayload b -> AMempoolPayload a
<$ :: forall a b. a -> AMempoolPayload b -> AMempoolPayload a
Functor)

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

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

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

instance FromCBOR (AMempoolPayload ByteSpan) where
  fromCBOR :: forall s. Decoder s (AMempoolPayload ByteSpan)
fromCBOR = Decoder s (AMempoolPayload ByteSpan)
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ATxAux () -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ATxAux ()
tp
  encCBOR (MempoolDlg ACertificate ()
dp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ACertificate () -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ACertificate ()
dp
  encCBOR (MempoolUpdateProposal AProposal ()
upp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
2 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AProposal () -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR AProposal ()
upp
  encCBOR (MempoolUpdateVote AVote ()
upv) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AVote () -> Encoding
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 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (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)
  encCBOR (MempoolDlg ACertificate ByteString
dp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (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)
  encCBOR (MempoolUpdateProposal AProposal ByteString
upp) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (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)
  encCBOR (MempoolUpdateVote AVote ByteString
upv) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (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 DecCBOR MempoolPayload where
  decCBOR :: forall s. Decoder s MempoolPayload
decCBOR = 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 a s. DecCBOR a => Decoder s a
decCBOR @(AMempoolPayload ByteSpan)

instance DecCBOR (AMempoolPayload ByteSpan) where
  decCBOR :: forall s. Decoder s (AMempoolPayload ByteSpan)
decCBOR = 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 a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
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 s. Decoder s (ATxAux ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      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 s. Decoder s (ACertificate ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      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 s. Decoder s (AProposal ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      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 s. Decoder s (AVote ByteSpan)
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
tag -> DecoderError -> Decoder s (AMempoolPayload ByteSpan)
forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m 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