{-# 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.Binary
  ( Annotated (..),
    ByteSpan,
    Decoded (..),
    FromCBOR (..),
    ToCBOR (..),
    annotatedDecoder,
    encodeListLen,
    enforceSize,
  )
import Cardano.Chain.Update.Proposal
  ( AProposal,
    Proposal,
    formatMaybeProposal,
  )
import Cardano.Chain.Update.Vote
  ( AVote,
    Vote,
    formatVoteShort,
  )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting (bprint)
import qualified Formatting.Buildable as B

-- | Update System payload
data APayload a = APayload
  { APayload a -> Maybe (AProposal a)
payloadProposal :: !(Maybe (AProposal a)),
    APayload a -> [AVote a]
payloadVotes :: ![AVote a],
    APayload a -> a
payloadAnnotation :: a
  }
  deriving (APayload a -> APayload a -> Bool
(APayload a -> APayload a -> Bool)
-> (APayload a -> APayload a -> Bool) -> Eq (APayload a)
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
[APayload a] -> ShowS
APayload a -> String
(Int -> APayload a -> ShowS)
-> (APayload a -> String)
-> ([APayload a] -> ShowS)
-> Show (APayload a)
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 x. APayload a -> Rep (APayload a) x)
-> (forall x. Rep (APayload a) x -> APayload a)
-> Generic (APayload a)
forall x. Rep (APayload a) x -> APayload a
forall x. APayload a -> Rep (APayload a) x
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, a -> APayload b -> APayload a
(a -> b) -> APayload a -> APayload b
(forall a b. (a -> b) -> APayload a -> APayload b)
-> (forall a b. a -> APayload b -> APayload a) -> Functor APayload
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
<$ :: a -> APayload b -> APayload a
$c<$ :: forall a b. a -> APayload b -> APayload a
fmap :: (a -> b) -> APayload a -> APayload b
$cfmap :: forall a b. (a -> b) -> APayload a -> APayload b
Functor)
  deriving anyclass (APayload a -> ()
(APayload a -> ()) -> NFData (APayload a)
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 = Maybe Proposal -> [Vote] -> () -> Payload
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 = APayload ByteString -> ByteString
forall a. APayload a -> a
payloadAnnotation

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

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

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