{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Chain.Update.Payload (
  APayload (..),
  Payload,
  payload,
)
where

import Cardano.Chain.Update.Proposal (
  AProposal,
  Proposal,
  formatMaybeProposal,
 )
import Cardano.Chain.Update.Vote (
  AVote,
  Vote,
  formatVoteShort,
 )
import Cardano.Ledger.Binary (
  Annotated (..),
  ByteSpan,
  DecCBOR (..),
  Decoded (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  annotatedDecoder,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
 )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint)
import qualified Formatting.Buildable as B

-- | Update System payload
data APayload a = APayload
  { forall a. APayload a -> Maybe (AProposal a)
payloadProposal :: !(Maybe (AProposal a))
  , forall a. APayload a -> [AVote a]
payloadVotes :: ![AVote a]
  , forall a. APayload a -> a
payloadAnnotation :: a
  }
  deriving (APayload a -> APayload a -> Bool
forall a. Eq a => APayload a -> APayload a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: APayload a -> APayload a -> Bool
$c/= :: forall a. Eq a => APayload a -> APayload a -> Bool
== :: APayload a -> APayload a -> Bool
$c== :: forall a. Eq a => APayload a -> APayload a -> Bool
Eq, Int -> APayload a -> ShowS
forall a. Show a => Int -> APayload a -> ShowS
forall a. Show a => [APayload a] -> ShowS
forall a. Show a => APayload a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [APayload a] -> ShowS
$cshowList :: forall a. Show a => [APayload a] -> ShowS
show :: APayload a -> String
$cshow :: forall a. Show a => APayload a -> String
showsPrec :: Int -> APayload a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> APayload a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (APayload a) x -> APayload a
forall a x. APayload a -> Rep (APayload a) x
$cto :: forall a x. Rep (APayload a) x -> APayload a
$cfrom :: forall a x. APayload a -> Rep (APayload a) x
Generic, forall a b. a -> APayload b -> APayload a
forall a b. (a -> b) -> APayload a -> APayload 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 -> APayload b -> APayload a
$c<$ :: forall a b. a -> APayload b -> APayload a
fmap :: forall a b. (a -> b) -> APayload a -> APayload b
$cfmap :: forall a b. (a -> b) -> APayload a -> APayload b
Functor)
  deriving anyclass (forall a. NFData a => APayload a -> ()
forall a. (a -> ()) -> NFData a
rnf :: APayload a -> ()
$crnf :: forall a. NFData a => APayload a -> ()
NFData)

type Payload = APayload ()

payload :: Maybe Proposal -> [Vote] -> Payload
payload :: Maybe Proposal -> [Vote] -> Payload
payload Maybe Proposal
p [Vote]
v = forall a. Maybe (AProposal a) -> [AVote a] -> a -> APayload a
APayload Maybe Proposal
p [Vote]
v ()

instance Decoded (APayload ByteString) where
  type BaseType (APayload ByteString) = Payload
  recoverBytes :: APayload ByteString -> ByteString
recoverBytes = forall a. APayload a -> a
payloadAnnotation

instance B.Buildable Payload where
  build :: Payload -> Builder
build Payload
p
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. APayload a -> [AVote a]
payloadVotes Payload
p) =
        Maybe Proposal -> Builder
formatMaybeProposal (forall a. APayload a -> Maybe (AProposal a)
payloadProposal Payload
p) forall a. Semigroup a => a -> a -> a
<> Builder
", no votes"
    | Bool
otherwise =
        Maybe Proposal -> Builder
formatMaybeProposal (forall a. APayload a -> Maybe (AProposal a)
payloadProposal Payload
p)
          forall a. Semigroup a => a -> a -> a
<> forall a. Format Builder a -> a
bprint
            (Format ([Builder] -> Builder) ([Builder] -> Builder)
"\n    votes: " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson)
            (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Vote -> Builder
formatVoteShort (forall a. APayload a -> [AVote a]
payloadVotes Payload
p))

-- Used for debugging purposes only
instance ToJSON a => ToJSON (APayload a)

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

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

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

instance EncCBOR Payload where
  encCBOR :: Payload -> Encoding
encCBOR Payload
p =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. APayload a -> Maybe (AProposal a)
payloadProposal Payload
p) forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. APayload a -> [AVote a]
payloadVotes Payload
p)

instance DecCBOR Payload where
  decCBOR :: forall s. Decoder s Payload
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 @(APayload ByteSpan)

instance DecCBOR (APayload ByteSpan) where
  decCBOR :: forall s. Decoder s (APayload ByteSpan)
decCBOR = do
    Annotated (Maybe (AProposal ByteSpan)
proposal, [AVote ByteSpan]
votes) ByteSpan
byteSpan <- forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder forall a b. (a -> b) -> a -> b
$ do
      forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Update.Payload" Int
2
      (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Maybe (AProposal a) -> [AVote a] -> a -> APayload a
APayload Maybe (AProposal ByteSpan)
proposal [AVote ByteSpan]
votes ByteSpan
byteSpan