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

module Cardano.Chain.Update.Proposal
  ( -- * Proposal
    AProposal (..),
    Proposal,
    UpId,

    -- * Proposal Constructors
    unsafeProposal,
    signProposal,
    signatureForProposal,

    -- * Proposal Accessors
    body,
    recoverUpId,

    -- * Proposal Formatting
    formatMaybeProposal,

    -- * ProposalBody
    ProposalBody (..),

    -- * ProposalBody Binary Serialization
    recoverProposalSignedBytes,
  )
where

import Cardano.Binary
  ( Annotated (..),
    ByteSpan,
    Decoded (..),
    FromCBOR (..),
    ToCBOR (..),
    annotatedDecoder,
    encodeListLen,
    enforceSize,
  )
import Cardano.Chain.Common.Attributes (dropEmptyAttributes)
import Cardano.Chain.Update.InstallerHash (InstallerHash)
import Cardano.Chain.Update.ProtocolParametersUpdate (ProtocolParametersUpdate)
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.SoftwareVersion (SoftwareVersion)
import Cardano.Chain.Update.SystemTag (SystemTag)
import Cardano.Crypto
  ( Hash,
    ProtocolMagicId,
    SafeSigner,
    SignTag (SignUSProposal),
    Signature,
    VerificationKey,
    hashDecoded,
    safeSign,
    safeToVerification,
    serializeCborHash,
  )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import qualified Data.Map.Strict as M
import Data.Text.Lazy.Builder (Builder)
import Formatting (bprint, build)
import qualified Formatting.Buildable as B

--------------------------------------------------------------------------------
-- Proposal
--------------------------------------------------------------------------------

-- | ID of software update proposal
type UpId = Hash Proposal

-- | Proposal for software update
data AProposal a = AProposal
  { AProposal a -> Annotated ProposalBody a
aBody :: !(Annotated ProposalBody a),
    -- | Who proposed this UP.
    AProposal a -> VerificationKey
issuer :: !VerificationKey,
    AProposal a -> Signature ProposalBody
signature :: !(Signature ProposalBody),
    AProposal a -> a
annotation :: !a
  }
  deriving (AProposal a -> AProposal a -> Bool
(AProposal a -> AProposal a -> Bool)
-> (AProposal a -> AProposal a -> Bool) -> Eq (AProposal a)
forall a. Eq a => AProposal a -> AProposal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AProposal a -> AProposal a -> Bool
$c/= :: forall a. Eq a => AProposal a -> AProposal a -> Bool
== :: AProposal a -> AProposal a -> Bool
$c== :: forall a. Eq a => AProposal a -> AProposal a -> Bool
Eq, Int -> AProposal a -> ShowS
[AProposal a] -> ShowS
AProposal a -> String
(Int -> AProposal a -> ShowS)
-> (AProposal a -> String)
-> ([AProposal a] -> ShowS)
-> Show (AProposal a)
forall a. Show a => Int -> AProposal a -> ShowS
forall a. Show a => [AProposal a] -> ShowS
forall a. Show a => AProposal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AProposal a] -> ShowS
$cshowList :: forall a. Show a => [AProposal a] -> ShowS
show :: AProposal a -> String
$cshow :: forall a. Show a => AProposal a -> String
showsPrec :: Int -> AProposal a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AProposal a -> ShowS
Show, (forall x. AProposal a -> Rep (AProposal a) x)
-> (forall x. Rep (AProposal a) x -> AProposal a)
-> Generic (AProposal a)
forall x. Rep (AProposal a) x -> AProposal a
forall x. AProposal a -> Rep (AProposal a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AProposal a) x -> AProposal a
forall a x. AProposal a -> Rep (AProposal a) x
$cto :: forall a x. Rep (AProposal a) x -> AProposal a
$cfrom :: forall a x. AProposal a -> Rep (AProposal a) x
Generic, a -> AProposal b -> AProposal a
(a -> b) -> AProposal a -> AProposal b
(forall a b. (a -> b) -> AProposal a -> AProposal b)
-> (forall a b. a -> AProposal b -> AProposal a)
-> Functor AProposal
forall a b. a -> AProposal b -> AProposal a
forall a b. (a -> b) -> AProposal a -> AProposal b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AProposal b -> AProposal a
$c<$ :: forall a b. a -> AProposal b -> AProposal a
fmap :: (a -> b) -> AProposal a -> AProposal b
$cfmap :: forall a b. (a -> b) -> AProposal a -> AProposal b
Functor)
  deriving anyclass (AProposal a -> ()
(AProposal a -> ()) -> NFData (AProposal a)
forall a. NFData a => AProposal a -> ()
forall a. (a -> ()) -> NFData a
rnf :: AProposal a -> ()
$crnf :: forall a. NFData a => AProposal a -> ()
NFData)

type Proposal = AProposal ()

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

--------------------------------------------------------------------------------
-- Proposal Constructors
--------------------------------------------------------------------------------

-- | Create an update 'Proposal', signing it with the provided safe signer.
signProposal :: ProtocolMagicId -> ProposalBody -> SafeSigner -> Proposal
signProposal :: ProtocolMagicId -> ProposalBody -> SafeSigner -> Proposal
signProposal ProtocolMagicId
protocolMagicId ProposalBody
proposalBody SafeSigner
safeSigner =
  ProposalBody
-> VerificationKey -> Signature ProposalBody -> Proposal
unsafeProposal
    ProposalBody
proposalBody
    (SafeSigner -> VerificationKey
safeToVerification SafeSigner
safeSigner)
    (ProtocolMagicId
-> ProposalBody -> SafeSigner -> Signature ProposalBody
signatureForProposal ProtocolMagicId
protocolMagicId ProposalBody
proposalBody SafeSigner
safeSigner)

signatureForProposal ::
  ProtocolMagicId ->
  ProposalBody ->
  SafeSigner ->
  Signature ProposalBody
signatureForProposal :: ProtocolMagicId
-> ProposalBody -> SafeSigner -> Signature ProposalBody
signatureForProposal ProtocolMagicId
protocolMagicId ProposalBody
proposalBody SafeSigner
safeSigner =
  ProtocolMagicId
-> SignTag -> SafeSigner -> ProposalBody -> Signature ProposalBody
forall a.
ToCBOR a =>
ProtocolMagicId -> SignTag -> SafeSigner -> a -> Signature a
safeSign ProtocolMagicId
protocolMagicId SignTag
SignUSProposal SafeSigner
safeSigner ProposalBody
proposalBody

-- | Create an update 'Proposal' using the provided signature.
unsafeProposal :: ProposalBody -> VerificationKey -> Signature ProposalBody -> Proposal
unsafeProposal :: ProposalBody
-> VerificationKey -> Signature ProposalBody -> Proposal
unsafeProposal ProposalBody
b VerificationKey
k Signature ProposalBody
s = Annotated ProposalBody ()
-> VerificationKey -> Signature ProposalBody -> () -> Proposal
forall a.
Annotated ProposalBody a
-> VerificationKey -> Signature ProposalBody -> a -> AProposal a
AProposal (ProposalBody -> () -> Annotated ProposalBody ()
forall b a. b -> a -> Annotated b a
Annotated ProposalBody
b ()) VerificationKey
k Signature ProposalBody
s ()

--------------------------------------------------------------------------------
-- Proposal Accessors
--------------------------------------------------------------------------------

body :: AProposal a -> ProposalBody
body :: AProposal a -> ProposalBody
body = Annotated ProposalBody a -> ProposalBody
forall b a. Annotated b a -> b
unAnnotated (Annotated ProposalBody a -> ProposalBody)
-> (AProposal a -> Annotated ProposalBody a)
-> AProposal a
-> ProposalBody
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AProposal a -> Annotated ProposalBody a
forall a. AProposal a -> Annotated ProposalBody a
aBody

recoverUpId :: AProposal ByteString -> UpId
recoverUpId :: AProposal ByteString -> UpId
recoverUpId = AProposal ByteString -> UpId
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded

--------------------------------------------------------------------------------
-- Proposal Binary Serialization
--------------------------------------------------------------------------------

instance ToCBOR Proposal where
  toCBOR :: Proposal -> Encoding
toCBOR Proposal
proposal =
    Word -> Encoding
encodeListLen Word
7
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> ProtocolVersion
protocolVersion ProposalBody
body')
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolParametersUpdate -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> ProtocolParametersUpdate
protocolParametersUpdate ProposalBody
body')
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SoftwareVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> SoftwareVersion
softwareVersion ProposalBody
body')
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map SystemTag InstallerHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> Map SystemTag InstallerHash
metadata ProposalBody
body')
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Word8 LByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Map Word8 LByteString
forall a. Monoid a => a
mempty :: Map Word8 LByteString)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VerificationKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Proposal -> VerificationKey
forall a. AProposal a -> VerificationKey
issuer Proposal
proposal)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Signature ProposalBody -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Proposal -> Signature ProposalBody
forall a. AProposal a -> Signature ProposalBody
signature Proposal
proposal)
    where
      body' :: ProposalBody
body' = Proposal -> ProposalBody
forall a. AProposal a -> ProposalBody
body Proposal
proposal

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

instance FromCBOR (AProposal ByteSpan) where
  fromCBOR :: Decoder s (AProposal ByteSpan)
fromCBOR = do
    Annotated (Annotated ProposalBody ByteSpan
pb, VerificationKey
vk, Signature ProposalBody
sig) ByteSpan
byteSpan <- Decoder
  s
  (Annotated ProposalBody ByteSpan, VerificationKey,
   Signature ProposalBody)
-> Decoder
     s
     (Annotated
        (Annotated ProposalBody ByteSpan, VerificationKey,
         Signature ProposalBody)
        ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder (Decoder
   s
   (Annotated ProposalBody ByteSpan, VerificationKey,
    Signature ProposalBody)
 -> Decoder
      s
      (Annotated
         (Annotated ProposalBody ByteSpan, VerificationKey,
          Signature ProposalBody)
         ByteSpan))
-> Decoder
     s
     (Annotated ProposalBody ByteSpan, VerificationKey,
      Signature ProposalBody)
-> Decoder
     s
     (Annotated
        (Annotated ProposalBody ByteSpan, VerificationKey,
         Signature ProposalBody)
        ByteSpan)
forall a b. (a -> b) -> a -> b
$ do
      Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Proposal" Int
7
      Annotated ProposalBody ByteSpan
pb <-
        Decoder s ProposalBody
-> Decoder s (Annotated ProposalBody ByteSpan)
forall s a. Decoder s a -> Decoder s (Annotated a ByteSpan)
annotatedDecoder
          ( ProtocolVersion
-> ProtocolParametersUpdate
-> SoftwareVersion
-> Map SystemTag InstallerHash
-> ProposalBody
ProposalBody
              (ProtocolVersion
 -> ProtocolParametersUpdate
 -> SoftwareVersion
 -> Map SystemTag InstallerHash
 -> ProposalBody)
-> Decoder s ProtocolVersion
-> Decoder
     s
     (ProtocolParametersUpdate
      -> SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ProtocolVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
              Decoder
  s
  (ProtocolParametersUpdate
   -> SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
-> Decoder s ProtocolParametersUpdate
-> Decoder
     s (SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ProtocolParametersUpdate
forall a s. FromCBOR a => Decoder s a
fromCBOR
              Decoder
  s (SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
-> Decoder s SoftwareVersion
-> Decoder s (Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SoftwareVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
              Decoder s (Map SystemTag InstallerHash -> ProposalBody)
-> Decoder s (Map SystemTag InstallerHash)
-> Decoder s ProposalBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Map SystemTag InstallerHash)
forall a s. FromCBOR a => Decoder s a
fromCBOR
              Decoder s ProposalBody -> Decoder s () -> Decoder s ProposalBody
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder s ()
forall s. Dropper s
dropEmptyAttributes
          )
      VerificationKey
vk <- Decoder s VerificationKey
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Signature ProposalBody
sig <- Decoder s (Signature ProposalBody)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Annotated ProposalBody ByteSpan, VerificationKey,
 Signature ProposalBody)
-> Decoder
     s
     (Annotated ProposalBody ByteSpan, VerificationKey,
      Signature ProposalBody)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotated ProposalBody ByteSpan
pb, VerificationKey
vk, Signature ProposalBody
sig)
    AProposal ByteSpan -> Decoder s (AProposal ByteSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AProposal ByteSpan -> Decoder s (AProposal ByteSpan))
-> AProposal ByteSpan -> Decoder s (AProposal ByteSpan)
forall a b. (a -> b) -> a -> b
$ Annotated ProposalBody ByteSpan
-> VerificationKey
-> Signature ProposalBody
-> ByteSpan
-> AProposal ByteSpan
forall a.
Annotated ProposalBody a
-> VerificationKey -> Signature ProposalBody -> a -> AProposal a
AProposal Annotated ProposalBody ByteSpan
pb VerificationKey
vk Signature ProposalBody
sig ByteSpan
byteSpan

instance Decoded (AProposal ByteString) where
  type BaseType (AProposal ByteString) = Proposal
  recoverBytes :: AProposal ByteString -> ByteString
recoverBytes = AProposal ByteString -> ByteString
forall a. AProposal a -> a
annotation

--------------------------------------------------------------------------------
-- Proposal Formatting
--------------------------------------------------------------------------------

instance B.Buildable (AProposal ()) where
  build :: Proposal -> Builder
build Proposal
proposal =
    Format
  Builder
  (SoftwareVersion
   -> ProtocolVersion
   -> UpId
   -> ProtocolParametersUpdate
   -> [SystemTag]
   -> Builder)
-> SoftwareVersion
-> ProtocolVersion
-> UpId
-> ProtocolParametersUpdate
-> [SystemTag]
-> Builder
forall a. Format Builder a -> a
bprint
      ( Format
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (SoftwareVersion
   -> ProtocolVersion
   -> UpId
   -> ProtocolParametersUpdate
   -> [SystemTag]
   -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (SoftwareVersion
   -> ProtocolVersion
   -> UpId
   -> ProtocolParametersUpdate
   -> [SystemTag]
   -> Builder)
-> Format
     Builder
     (ProtocolVersion
      -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (SoftwareVersion
      -> ProtocolVersion
      -> UpId
      -> ProtocolParametersUpdate
      -> [SystemTag]
      -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
" { block v"
          Format
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (ProtocolVersion
      -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (ProtocolVersion
      -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (ProtocolVersion
   -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (ProtocolVersion
      -> UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
", UpId: "
          Format
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder (ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder
     (UpId -> ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
", "
          Format
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder (ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format
     Builder (ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format
  ([SystemTag] -> Builder)
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
          Format
  ([SystemTag] -> Builder)
  (ProtocolParametersUpdate -> [SystemTag] -> Builder)
-> Format Builder ([SystemTag] -> Builder)
-> Format
     Builder (ProtocolParametersUpdate -> [SystemTag] -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format ([SystemTag] -> Builder) ([SystemTag] -> Builder)
", tags: "
          Format ([SystemTag] -> Builder) ([SystemTag] -> Builder)
-> Format Builder ([SystemTag] -> Builder)
-> Format Builder ([SystemTag] -> 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 ([SystemTag] -> Builder)
forall (t :: * -> *) a r.
(Foldable t, Buildable a) =>
Format r (t a -> r)
listJson
          Format Builder ([SystemTag] -> Builder)
-> Format Builder Builder
-> Format Builder ([SystemTag] -> 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
" }"
      )
      (ProposalBody -> SoftwareVersion
softwareVersion ProposalBody
body')
      (ProposalBody -> ProtocolVersion
protocolVersion ProposalBody
body')
      (Proposal -> UpId
forall a. ToCBOR a => a -> Hash a
serializeCborHash Proposal
proposal)
      (ProposalBody -> ProtocolParametersUpdate
protocolParametersUpdate ProposalBody
body')
      (Map SystemTag InstallerHash -> [SystemTag]
forall k a. Map k a -> [k]
M.keys (Map SystemTag InstallerHash -> [SystemTag])
-> Map SystemTag InstallerHash -> [SystemTag]
forall a b. (a -> b) -> a -> b
$ ProposalBody -> Map SystemTag InstallerHash
metadata ProposalBody
body')
    where
      body' :: ProposalBody
body' = Proposal -> ProposalBody
forall a. AProposal a -> ProposalBody
body Proposal
proposal

formatMaybeProposal :: Maybe Proposal -> Builder
formatMaybeProposal :: Maybe Proposal -> Builder
formatMaybeProposal = Builder -> (Proposal -> Builder) -> Maybe Proposal -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Builder
"no proposal" Proposal -> Builder
forall p. Buildable p => p -> Builder
B.build

--------------------------------------------------------------------------------
-- ProposalBody
--------------------------------------------------------------------------------

data ProposalBody = ProposalBody
  { ProposalBody -> ProtocolVersion
protocolVersion :: !ProtocolVersion,
    ProposalBody -> ProtocolParametersUpdate
protocolParametersUpdate :: !ProtocolParametersUpdate,
    ProposalBody -> SoftwareVersion
softwareVersion :: !SoftwareVersion,
    -- | InstallerHash for each system which this update affects
    ProposalBody -> Map SystemTag InstallerHash
metadata :: !(Map SystemTag InstallerHash)
  }
  deriving (ProposalBody -> ProposalBody -> Bool
(ProposalBody -> ProposalBody -> Bool)
-> (ProposalBody -> ProposalBody -> Bool) -> Eq ProposalBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProposalBody -> ProposalBody -> Bool
$c/= :: ProposalBody -> ProposalBody -> Bool
== :: ProposalBody -> ProposalBody -> Bool
$c== :: ProposalBody -> ProposalBody -> Bool
Eq, Int -> ProposalBody -> ShowS
[ProposalBody] -> ShowS
ProposalBody -> String
(Int -> ProposalBody -> ShowS)
-> (ProposalBody -> String)
-> ([ProposalBody] -> ShowS)
-> Show ProposalBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProposalBody] -> ShowS
$cshowList :: [ProposalBody] -> ShowS
show :: ProposalBody -> String
$cshow :: ProposalBody -> String
showsPrec :: Int -> ProposalBody -> ShowS
$cshowsPrec :: Int -> ProposalBody -> ShowS
Show, (forall x. ProposalBody -> Rep ProposalBody x)
-> (forall x. Rep ProposalBody x -> ProposalBody)
-> Generic ProposalBody
forall x. Rep ProposalBody x -> ProposalBody
forall x. ProposalBody -> Rep ProposalBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProposalBody x -> ProposalBody
$cfrom :: forall x. ProposalBody -> Rep ProposalBody x
Generic)
  deriving anyclass (ProposalBody -> ()
(ProposalBody -> ()) -> NFData ProposalBody
forall a. (a -> ()) -> NFData a
rnf :: ProposalBody -> ()
$crnf :: ProposalBody -> ()
NFData)

-- Used for debugging purposes only
instance ToJSON ProposalBody

--------------------------------------------------------------------------------
-- ProposalBody Binary Serialization
--------------------------------------------------------------------------------

instance ToCBOR ProposalBody where
  toCBOR :: ProposalBody -> Encoding
toCBOR ProposalBody
pb =
    Word -> Encoding
encodeListLen Word
5
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> ProtocolVersion
protocolVersion ProposalBody
pb)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolParametersUpdate -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> ProtocolParametersUpdate
protocolParametersUpdate ProposalBody
pb)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SoftwareVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> SoftwareVersion
softwareVersion ProposalBody
pb)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map SystemTag InstallerHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProposalBody -> Map SystemTag InstallerHash
metadata ProposalBody
pb)
      -- Encode empty Attributes
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Word8 LByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Map Word8 LByteString
forall a. Monoid a => a
mempty :: Map Word8 LByteString)

instance FromCBOR ProposalBody where
  fromCBOR :: Decoder s ProposalBody
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ProposalBody" Int
5
    ProtocolVersion
-> ProtocolParametersUpdate
-> SoftwareVersion
-> Map SystemTag InstallerHash
-> ProposalBody
ProposalBody
      (ProtocolVersion
 -> ProtocolParametersUpdate
 -> SoftwareVersion
 -> Map SystemTag InstallerHash
 -> ProposalBody)
-> Decoder s ProtocolVersion
-> Decoder
     s
     (ProtocolParametersUpdate
      -> SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ProtocolVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (ProtocolParametersUpdate
   -> SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
-> Decoder s ProtocolParametersUpdate
-> Decoder
     s (SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ProtocolParametersUpdate
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s (SoftwareVersion -> Map SystemTag InstallerHash -> ProposalBody)
-> Decoder s SoftwareVersion
-> Decoder s (Map SystemTag InstallerHash -> ProposalBody)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SoftwareVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Map SystemTag InstallerHash -> ProposalBody)
-> Decoder s (Map SystemTag InstallerHash)
-> Decoder s ProposalBody
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Map SystemTag InstallerHash)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s ProposalBody -> Decoder s () -> Decoder s ProposalBody
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Decoder s ()
forall s. Dropper s
dropEmptyAttributes

-- | Prepend byte corresponding to `encodeListLen 5`, which was used during
--   signing
recoverProposalSignedBytes ::
  Annotated ProposalBody ByteString -> Annotated ProposalBody ByteString
recoverProposalSignedBytes :: Annotated ProposalBody ByteString
-> Annotated ProposalBody ByteString
recoverProposalSignedBytes = (ByteString -> ByteString)
-> Annotated ProposalBody ByteString
-> Annotated ProposalBody ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString
"\133" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>)