{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Validation rules for registering updates
--
--   This is an implementation of the rules defined in the Byron ledger
--   specification
module Cardano.Chain.Update.Validation.Registration
  ( Error (..),
    Environment (..),
    State (..),
    ApplicationVersion (..),
    ApplicationVersions,
    Metadata,
    ProtocolUpdateProposal (..),
    ProtocolUpdateProposals,
    SoftwareUpdateProposal (..),
    SoftwareUpdateProposals,
    registerProposal,
    TooLarge (..),
    Adopted (..),
  )
where

import Cardano.Binary
  ( Annotated (unAnnotated),
    Decoder,
    DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    decodeWord8,
    encodeListLen,
    enforceSize,
    matchSize,
  )
import Cardano.Chain.Common (KeyHash, hashKey)
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.Slotting (SlotNumber (SlotNumber))
import Cardano.Chain.Update.ApplicationName (ApplicationName)
import Cardano.Chain.Update.InstallerHash (InstallerHash)
import Cardano.Chain.Update.Proposal
  ( AProposal (..),
    ProposalBody (..),
    UpId,
    protocolParametersUpdate,
    protocolVersion,
    recoverProposalSignedBytes,
    recoverUpId,
    softwareVersion,
  )
import qualified Cardano.Chain.Update.Proposal as Proposal
import Cardano.Chain.Update.ProtocolParameters
  ( ProtocolParameters,
    ppMaxBlockSize,
    ppMaxProposalSize,
    ppMaxTxSize,
    ppScriptVersion,
  )
import qualified Cardano.Chain.Update.ProtocolParametersUpdate as PPU
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion (ProtocolVersion))
import Cardano.Chain.Update.SoftwareVersion
  ( NumSoftwareVersion,
    SoftwareVersion (SoftwareVersion),
    SoftwareVersionError,
    checkSoftwareVersion,
    svAppName,
  )
import Cardano.Chain.Update.SystemTag (SystemTag, SystemTagError, checkSystemTag)
import Cardano.Crypto
  ( ProtocolMagicId (..),
    SignTag (SignUSProposal),
    verifySignatureDecoded,
  )
import Cardano.Prelude hiding (State)
import qualified Data.ByteString as BS
import qualified Data.Map.Strict as M
import NoThunks.Class (NoThunks (..))

data Environment = Environment
  { Environment -> Annotated ProtocolMagicId ByteString
protocolMagic :: !(Annotated ProtocolMagicId ByteString),
    Environment -> SlotNumber
currentSlot :: !SlotNumber,
    Environment -> ProtocolVersion
adoptedProtocolVersion :: !ProtocolVersion,
    Environment -> ProtocolParameters
adoptedProtocolParameters :: !ProtocolParameters,
    Environment -> ApplicationVersions
appVersions :: !ApplicationVersions,
    Environment -> Map
delegationMap :: !Delegation.Map
  }

data ApplicationVersion = ApplicationVersion
  { ApplicationVersion -> NumSoftwareVersion
avNumSoftwareVersion :: !NumSoftwareVersion,
    ApplicationVersion -> SlotNumber
avSlotNumber :: !SlotNumber,
    ApplicationVersion -> Metadata
avMetadata :: !Metadata
  }
  deriving (ApplicationVersion -> ApplicationVersion -> Bool
(ApplicationVersion -> ApplicationVersion -> Bool)
-> (ApplicationVersion -> ApplicationVersion -> Bool)
-> Eq ApplicationVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationVersion -> ApplicationVersion -> Bool
$c/= :: ApplicationVersion -> ApplicationVersion -> Bool
== :: ApplicationVersion -> ApplicationVersion -> Bool
$c== :: ApplicationVersion -> ApplicationVersion -> Bool
Eq, Int -> ApplicationVersion -> ShowS
[ApplicationVersion] -> ShowS
ApplicationVersion -> String
(Int -> ApplicationVersion -> ShowS)
-> (ApplicationVersion -> String)
-> ([ApplicationVersion] -> ShowS)
-> Show ApplicationVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationVersion] -> ShowS
$cshowList :: [ApplicationVersion] -> ShowS
show :: ApplicationVersion -> String
$cshow :: ApplicationVersion -> String
showsPrec :: Int -> ApplicationVersion -> ShowS
$cshowsPrec :: Int -> ApplicationVersion -> ShowS
Show, (forall x. ApplicationVersion -> Rep ApplicationVersion x)
-> (forall x. Rep ApplicationVersion x -> ApplicationVersion)
-> Generic ApplicationVersion
forall x. Rep ApplicationVersion x -> ApplicationVersion
forall x. ApplicationVersion -> Rep ApplicationVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApplicationVersion x -> ApplicationVersion
$cfrom :: forall x. ApplicationVersion -> Rep ApplicationVersion x
Generic)
  deriving anyclass (ApplicationVersion -> ()
(ApplicationVersion -> ()) -> NFData ApplicationVersion
forall a. (a -> ()) -> NFData a
rnf :: ApplicationVersion -> ()
$crnf :: ApplicationVersion -> ()
NFData, Context -> ApplicationVersion -> IO (Maybe ThunkInfo)
Proxy ApplicationVersion -> String
(Context -> ApplicationVersion -> IO (Maybe ThunkInfo))
-> (Context -> ApplicationVersion -> IO (Maybe ThunkInfo))
-> (Proxy ApplicationVersion -> String)
-> NoThunks ApplicationVersion
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ApplicationVersion -> String
$cshowTypeOf :: Proxy ApplicationVersion -> String
wNoThunks :: Context -> ApplicationVersion -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ApplicationVersion -> IO (Maybe ThunkInfo)
noThunks :: Context -> ApplicationVersion -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ApplicationVersion -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR ApplicationVersion where
  fromCBOR :: Decoder s ApplicationVersion
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ApplicationVersion" Int
3
    NumSoftwareVersion -> SlotNumber -> Metadata -> ApplicationVersion
ApplicationVersion (NumSoftwareVersion
 -> SlotNumber -> Metadata -> ApplicationVersion)
-> Decoder s NumSoftwareVersion
-> Decoder s (SlotNumber -> Metadata -> ApplicationVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s NumSoftwareVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (SlotNumber -> Metadata -> ApplicationVersion)
-> Decoder s SlotNumber
-> Decoder s (Metadata -> ApplicationVersion)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SlotNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Metadata -> ApplicationVersion)
-> Decoder s Metadata -> Decoder s ApplicationVersion
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Metadata
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR ApplicationVersion where
  toCBOR :: ApplicationVersion -> Encoding
toCBOR ApplicationVersion
av =
    Word -> Encoding
encodeListLen Word
3
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> NumSoftwareVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ApplicationVersion -> NumSoftwareVersion
avNumSoftwareVersion ApplicationVersion
av)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ApplicationVersion -> SlotNumber
avSlotNumber ApplicationVersion
av)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Metadata -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ApplicationVersion -> Metadata
avMetadata ApplicationVersion
av)

type ApplicationVersions = Map ApplicationName ApplicationVersion

type Metadata = Map SystemTag InstallerHash

-- | State keeps track of registered protocol and software update
--   proposals
data State = State
  { State -> ProtocolUpdateProposals
rsProtocolUpdateProposals :: !ProtocolUpdateProposals,
    State -> SoftwareUpdateProposals
rsSoftwareUpdateProposals :: !SoftwareUpdateProposals
  }

data ProtocolUpdateProposal = ProtocolUpdateProposal
  { ProtocolUpdateProposal -> ProtocolVersion
pupProtocolVersion :: !ProtocolVersion,
    ProtocolUpdateProposal -> ProtocolParameters
pupProtocolParameters :: !ProtocolParameters
  }
  deriving (ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool
(ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool)
-> (ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool)
-> Eq ProtocolUpdateProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool
$c/= :: ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool
== :: ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool
$c== :: ProtocolUpdateProposal -> ProtocolUpdateProposal -> Bool
Eq, Int -> ProtocolUpdateProposal -> ShowS
[ProtocolUpdateProposal] -> ShowS
ProtocolUpdateProposal -> String
(Int -> ProtocolUpdateProposal -> ShowS)
-> (ProtocolUpdateProposal -> String)
-> ([ProtocolUpdateProposal] -> ShowS)
-> Show ProtocolUpdateProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProtocolUpdateProposal] -> ShowS
$cshowList :: [ProtocolUpdateProposal] -> ShowS
show :: ProtocolUpdateProposal -> String
$cshow :: ProtocolUpdateProposal -> String
showsPrec :: Int -> ProtocolUpdateProposal -> ShowS
$cshowsPrec :: Int -> ProtocolUpdateProposal -> ShowS
Show, (forall x. ProtocolUpdateProposal -> Rep ProtocolUpdateProposal x)
-> (forall x.
    Rep ProtocolUpdateProposal x -> ProtocolUpdateProposal)
-> Generic ProtocolUpdateProposal
forall x. Rep ProtocolUpdateProposal x -> ProtocolUpdateProposal
forall x. ProtocolUpdateProposal -> Rep ProtocolUpdateProposal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProtocolUpdateProposal x -> ProtocolUpdateProposal
$cfrom :: forall x. ProtocolUpdateProposal -> Rep ProtocolUpdateProposal x
Generic)
  deriving anyclass (ProtocolUpdateProposal -> ()
(ProtocolUpdateProposal -> ()) -> NFData ProtocolUpdateProposal
forall a. (a -> ()) -> NFData a
rnf :: ProtocolUpdateProposal -> ()
$crnf :: ProtocolUpdateProposal -> ()
NFData, Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo)
Proxy ProtocolUpdateProposal -> String
(Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo))
-> (Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo))
-> (Proxy ProtocolUpdateProposal -> String)
-> NoThunks ProtocolUpdateProposal
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ProtocolUpdateProposal -> String
$cshowTypeOf :: Proxy ProtocolUpdateProposal -> String
wNoThunks :: Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo)
noThunks :: Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ProtocolUpdateProposal -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR ProtocolUpdateProposal where
  fromCBOR :: Decoder s ProtocolUpdateProposal
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ProtocolUpdateProposal" Int
2
    ProtocolVersion -> ProtocolParameters -> ProtocolUpdateProposal
ProtocolUpdateProposal (ProtocolVersion -> ProtocolParameters -> ProtocolUpdateProposal)
-> Decoder s ProtocolVersion
-> Decoder s (ProtocolParameters -> ProtocolUpdateProposal)
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 (ProtocolParameters -> ProtocolUpdateProposal)
-> Decoder s ProtocolParameters -> Decoder s ProtocolUpdateProposal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s ProtocolParameters
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR ProtocolUpdateProposal where
  toCBOR :: ProtocolUpdateProposal -> Encoding
toCBOR ProtocolUpdateProposal
pup =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolUpdateProposal -> ProtocolVersion
pupProtocolVersion ProtocolUpdateProposal
pup)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ProtocolParameters -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ProtocolUpdateProposal -> ProtocolParameters
pupProtocolParameters ProtocolUpdateProposal
pup)

type ProtocolUpdateProposals = Map UpId ProtocolUpdateProposal

data SoftwareUpdateProposal = SoftwareUpdateProposal
  { SoftwareUpdateProposal -> SoftwareVersion
supSoftwareVersion :: !SoftwareVersion,
    SoftwareUpdateProposal -> Metadata
supSoftwareMetadata :: !Metadata
  }
  deriving (SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool
(SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool)
-> (SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool)
-> Eq SoftwareUpdateProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool
$c/= :: SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool
== :: SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool
$c== :: SoftwareUpdateProposal -> SoftwareUpdateProposal -> Bool
Eq, Int -> SoftwareUpdateProposal -> ShowS
[SoftwareUpdateProposal] -> ShowS
SoftwareUpdateProposal -> String
(Int -> SoftwareUpdateProposal -> ShowS)
-> (SoftwareUpdateProposal -> String)
-> ([SoftwareUpdateProposal] -> ShowS)
-> Show SoftwareUpdateProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SoftwareUpdateProposal] -> ShowS
$cshowList :: [SoftwareUpdateProposal] -> ShowS
show :: SoftwareUpdateProposal -> String
$cshow :: SoftwareUpdateProposal -> String
showsPrec :: Int -> SoftwareUpdateProposal -> ShowS
$cshowsPrec :: Int -> SoftwareUpdateProposal -> ShowS
Show, (forall x. SoftwareUpdateProposal -> Rep SoftwareUpdateProposal x)
-> (forall x.
    Rep SoftwareUpdateProposal x -> SoftwareUpdateProposal)
-> Generic SoftwareUpdateProposal
forall x. Rep SoftwareUpdateProposal x -> SoftwareUpdateProposal
forall x. SoftwareUpdateProposal -> Rep SoftwareUpdateProposal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SoftwareUpdateProposal x -> SoftwareUpdateProposal
$cfrom :: forall x. SoftwareUpdateProposal -> Rep SoftwareUpdateProposal x
Generic)
  deriving anyclass (SoftwareUpdateProposal -> ()
(SoftwareUpdateProposal -> ()) -> NFData SoftwareUpdateProposal
forall a. (a -> ()) -> NFData a
rnf :: SoftwareUpdateProposal -> ()
$crnf :: SoftwareUpdateProposal -> ()
NFData, Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo)
Proxy SoftwareUpdateProposal -> String
(Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo))
-> (Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo))
-> (Proxy SoftwareUpdateProposal -> String)
-> NoThunks SoftwareUpdateProposal
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy SoftwareUpdateProposal -> String
$cshowTypeOf :: Proxy SoftwareUpdateProposal -> String
wNoThunks :: Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo)
noThunks :: Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SoftwareUpdateProposal -> IO (Maybe ThunkInfo)
NoThunks)

instance FromCBOR SoftwareUpdateProposal where
  fromCBOR :: Decoder s SoftwareUpdateProposal
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"SoftwareUpdateProposal" Int
2
    SoftwareVersion -> Metadata -> SoftwareUpdateProposal
SoftwareUpdateProposal (SoftwareVersion -> Metadata -> SoftwareUpdateProposal)
-> Decoder s SoftwareVersion
-> Decoder s (Metadata -> SoftwareUpdateProposal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SoftwareVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Metadata -> SoftwareUpdateProposal)
-> Decoder s Metadata -> Decoder s SoftwareUpdateProposal
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Metadata
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR SoftwareUpdateProposal where
  toCBOR :: SoftwareUpdateProposal -> Encoding
toCBOR SoftwareUpdateProposal
sup =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SoftwareVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (SoftwareUpdateProposal -> SoftwareVersion
supSoftwareVersion SoftwareUpdateProposal
sup)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Metadata -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (SoftwareUpdateProposal -> Metadata
supSoftwareMetadata SoftwareUpdateProposal
sup)

type SoftwareUpdateProposals = Map UpId SoftwareUpdateProposal

-- | Error captures the ways in which registration could fail
data Error
  = DuplicateProtocolVersion ProtocolVersion
  | DuplicateSoftwareVersion SoftwareVersion
  | InvalidProposer KeyHash
  | InvalidProtocolVersion ProtocolVersion Adopted
  | InvalidScriptVersion Word16 Word16
  | InvalidSignature
  | InvalidSoftwareVersion ApplicationVersions SoftwareVersion
  | MaxBlockSizeTooLarge (TooLarge Natural)
  | MaxTxSizeTooLarge (TooLarge Natural)
  | ProposalAttributesUnknown
  | ProposalTooLarge (TooLarge Natural)
  | SoftwareVersionError SoftwareVersionError
  | SystemTagError SystemTagError
  | -- | The update proposal proposes neither a bump in the protocol or
    -- application versions.
    NullUpdateProposal
  deriving (Error -> Error -> Bool
(Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq, Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show)

instance ToCBOR Error where
  toCBOR :: Error -> Encoding
toCBOR Error
err = case Error
err of
    DuplicateProtocolVersion ProtocolVersion
protocolVersion ->
      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
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ProtocolVersion
protocolVersion
    DuplicateSoftwareVersion SoftwareVersion
softwareVersion ->
      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
<> SoftwareVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SoftwareVersion
softwareVersion
    InvalidProposer KeyHash
keyHash ->
      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
<> KeyHash -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR KeyHash
keyHash
    InvalidProtocolVersion ProtocolVersion
protocolVersion Adopted
adopted ->
      Word -> Encoding
encodeListLen Word
3
        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
<> ProtocolVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ProtocolVersion
protocolVersion
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Adopted -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Adopted
adopted
    InvalidScriptVersion Word16
adoptedScriptVersion Word16
newScriptVersion ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
4 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word16
adoptedScriptVersion
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word16 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Word16
newScriptVersion
    Error
InvalidSignature ->
      Word -> Encoding
encodeListLen Word
1
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
5 :: Word8)
    InvalidSoftwareVersion ApplicationVersions
applicationVersions SoftwareVersion
softwareVersion ->
      Word -> Encoding
encodeListLen Word
3
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
6 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ApplicationVersions -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ApplicationVersions
applicationVersions
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SoftwareVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SoftwareVersion
softwareVersion
    MaxBlockSizeTooLarge TooLarge Natural
tooLarge ->
      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
7 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TooLarge Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TooLarge Natural
tooLarge
    MaxTxSizeTooLarge TooLarge Natural
tooLarge ->
      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
8 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TooLarge Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TooLarge Natural
tooLarge
    Error
ProposalAttributesUnknown ->
      Word -> Encoding
encodeListLen Word
1
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
9 :: Word8)
    ProposalTooLarge TooLarge Natural
tooLarge ->
      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
10 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TooLarge Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR TooLarge Natural
tooLarge
    SoftwareVersionError SoftwareVersionError
softwareVersionError ->
      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
11 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SoftwareVersionError -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SoftwareVersionError
softwareVersionError
    SystemTagError SystemTagError
systemTagError ->
      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
12 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SystemTagError -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SystemTagError
systemTagError
    Error
NullUpdateProposal ->
      Word -> Encoding
encodeListLen Word
1
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
13 :: Word8)

instance FromCBOR Error where
  fromCBOR :: Decoder s Error
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    let checkSize :: Int -> Decoder s ()
        checkSize :: Int -> Decoder s ()
checkSize Int
size = Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"Registration.Error" Int
size Int
len
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProtocolVersion -> Error
DuplicateProtocolVersion (ProtocolVersion -> Error)
-> Decoder s ProtocolVersion -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ProtocolVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
1 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SoftwareVersion -> Error
DuplicateSoftwareVersion (SoftwareVersion -> Error)
-> Decoder s SoftwareVersion -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SoftwareVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
2 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> KeyHash -> Error
InvalidProposer (KeyHash -> Error) -> Decoder s KeyHash -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s KeyHash
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
3 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProtocolVersion -> Adopted -> Error
InvalidProtocolVersion (ProtocolVersion -> Adopted -> Error)
-> Decoder s ProtocolVersion -> Decoder s (Adopted -> Error)
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 (Adopted -> Error)
-> Decoder s Adopted -> Decoder s Error
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Adopted
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
4 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Word16 -> Error
InvalidScriptVersion (Word16 -> Word16 -> Error)
-> Decoder s Word16 -> Decoder s (Word16 -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word16
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Word16 -> Error) -> Decoder s Word16 -> Decoder s Error
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word16
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
5 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
1 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Error -> Decoder s Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
InvalidSignature
      Word8
6 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ApplicationVersions -> SoftwareVersion -> Error
InvalidSoftwareVersion (ApplicationVersions -> SoftwareVersion -> Error)
-> Decoder s ApplicationVersions
-> Decoder s (SoftwareVersion -> Error)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ApplicationVersions
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (SoftwareVersion -> Error)
-> Decoder s SoftwareVersion -> Decoder s Error
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
      Word8
7 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TooLarge Natural -> Error
MaxBlockSizeTooLarge (TooLarge Natural -> Error)
-> Decoder s (TooLarge Natural) -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TooLarge Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
8 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TooLarge Natural -> Error
MaxTxSizeTooLarge (TooLarge Natural -> Error)
-> Decoder s (TooLarge Natural) -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TooLarge Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
9 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
1 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Error -> Decoder s Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
ProposalAttributesUnknown
      Word8
10 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TooLarge Natural -> Error
ProposalTooLarge (TooLarge Natural -> Error)
-> Decoder s (TooLarge Natural) -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (TooLarge Natural)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
11 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SoftwareVersionError -> Error
SoftwareVersionError (SoftwareVersionError -> Error)
-> Decoder s SoftwareVersionError -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SoftwareVersionError
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
12 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SystemTagError -> Error
SystemTagError (SystemTagError -> Error)
-> Decoder s SystemTagError -> Decoder s Error
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SystemTagError
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
13 -> Int -> Decoder s ()
forall s. Int -> Decoder s ()
checkSize Int
1 Decoder s () -> Decoder s Error -> Decoder s Error
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Error -> Decoder s Error
forall (f :: * -> *) a. Applicative f => a -> f a
pure Error
NullUpdateProposal
      Word8
_ -> DecoderError -> Decoder s Error
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s Error)
-> DecoderError -> Decoder s Error
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"Registration.Error" Word8
tag

data TooLarge n = TooLarge
  { TooLarge n -> n
tlActual :: n,
    TooLarge n -> n
tlMaxBound :: n
  }
  deriving (TooLarge n -> TooLarge n -> Bool
(TooLarge n -> TooLarge n -> Bool)
-> (TooLarge n -> TooLarge n -> Bool) -> Eq (TooLarge n)
forall n. Eq n => TooLarge n -> TooLarge n -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TooLarge n -> TooLarge n -> Bool
$c/= :: forall n. Eq n => TooLarge n -> TooLarge n -> Bool
== :: TooLarge n -> TooLarge n -> Bool
$c== :: forall n. Eq n => TooLarge n -> TooLarge n -> Bool
Eq, Int -> TooLarge n -> ShowS
[TooLarge n] -> ShowS
TooLarge n -> String
(Int -> TooLarge n -> ShowS)
-> (TooLarge n -> String)
-> ([TooLarge n] -> ShowS)
-> Show (TooLarge n)
forall n. Show n => Int -> TooLarge n -> ShowS
forall n. Show n => [TooLarge n] -> ShowS
forall n. Show n => TooLarge n -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TooLarge n] -> ShowS
$cshowList :: forall n. Show n => [TooLarge n] -> ShowS
show :: TooLarge n -> String
$cshow :: forall n. Show n => TooLarge n -> String
showsPrec :: Int -> TooLarge n -> ShowS
$cshowsPrec :: forall n. Show n => Int -> TooLarge n -> ShowS
Show)

instance (ToCBOR n) => ToCBOR (TooLarge n) where
  toCBOR :: TooLarge n -> Encoding
toCBOR TooLarge {n
tlActual :: n
tlActual :: forall n. TooLarge n -> n
tlActual, n
tlMaxBound :: n
tlMaxBound :: forall n. TooLarge n -> n
tlMaxBound} =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> n -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR n
tlActual
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> n -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR n
tlMaxBound

instance (FromCBOR n) => FromCBOR (TooLarge n) where
  fromCBOR :: Decoder s (TooLarge n)
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TooLarge" Int
2
    n -> n -> TooLarge n
forall n. n -> n -> TooLarge n
TooLarge (n -> n -> TooLarge n)
-> Decoder s n -> Decoder s (n -> TooLarge n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s n
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (n -> TooLarge n)
-> Decoder s n -> Decoder s (TooLarge n)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s n
forall a s. FromCBOR a => Decoder s a
fromCBOR

newtype Adopted = Adopted ProtocolVersion
  deriving (Adopted -> Adopted -> Bool
(Adopted -> Adopted -> Bool)
-> (Adopted -> Adopted -> Bool) -> Eq Adopted
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Adopted -> Adopted -> Bool
$c/= :: Adopted -> Adopted -> Bool
== :: Adopted -> Adopted -> Bool
$c== :: Adopted -> Adopted -> Bool
Eq, Int -> Adopted -> ShowS
[Adopted] -> ShowS
Adopted -> String
(Int -> Adopted -> ShowS)
-> (Adopted -> String) -> ([Adopted] -> ShowS) -> Show Adopted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Adopted] -> ShowS
$cshowList :: [Adopted] -> ShowS
show :: Adopted -> String
$cshow :: Adopted -> String
showsPrec :: Int -> Adopted -> ShowS
$cshowsPrec :: Int -> Adopted -> ShowS
Show)
  deriving newtype (Typeable Adopted
Typeable Adopted
-> (Adopted -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy Adopted -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Adopted] -> Size)
-> ToCBOR Adopted
Adopted -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Adopted] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Adopted -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Adopted] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Adopted] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Adopted -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Adopted -> Size
toCBOR :: Adopted -> Encoding
$ctoCBOR :: Adopted -> Encoding
$cp1ToCBOR :: Typeable Adopted
ToCBOR, Typeable Adopted
Decoder s Adopted
Typeable Adopted
-> (forall s. Decoder s Adopted)
-> (Proxy Adopted -> Text)
-> FromCBOR Adopted
Proxy Adopted -> Text
forall s. Decoder s Adopted
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
label :: Proxy Adopted -> Text
$clabel :: Proxy Adopted -> Text
fromCBOR :: Decoder s Adopted
$cfromCBOR :: forall s. Decoder s Adopted
$cp1FromCBOR :: Typeable Adopted
FromCBOR)

-- | Register an update proposal after verifying its signature and validating
--   its contents. This corresponds to the @UPREG@ rules in the spec.
registerProposal ::
  MonadError Error m =>
  Environment ->
  State ->
  AProposal ByteString ->
  m State
registerProposal :: Environment -> State -> AProposal ByteString -> m State
registerProposal Environment
env State
rs AProposal ByteString
proposal = do
  -- Check that the proposer is delegated to by a genesis key
  KeyHash -> Map -> Bool
Delegation.memberR KeyHash
proposerId Map
delegationMap
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` KeyHash -> Error
InvalidProposer KeyHash
proposerId

  -- Verify the proposal signature
  Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> Annotated ProposalBody ByteString
-> Signature (BaseType (Annotated ProposalBody ByteString))
-> Bool
forall t.
Decoded t =>
Annotated ProtocolMagicId ByteString
-> SignTag
-> VerificationKey
-> t
-> Signature (BaseType t)
-> Bool
verifySignatureDecoded
    Annotated ProtocolMagicId ByteString
protocolMagic
    SignTag
SignUSProposal
    VerificationKey
issuer
    (Annotated ProposalBody ByteString
-> Annotated ProposalBody ByteString
recoverProposalSignedBytes Annotated ProposalBody ByteString
aBody)
    Signature (BaseType (Annotated ProposalBody ByteString))
Signature ProposalBody
signature
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Error
InvalidSignature

  -- Check that the proposal is valid
  Environment -> State -> AProposal ByteString -> m State
forall (m :: * -> *).
MonadError Error m =>
Environment -> State -> AProposal ByteString -> m State
registerProposalComponents
    Environment
env
    State
rs
    AProposal ByteString
proposal
  where
    AProposal {Annotated ProposalBody ByteString
$sel:aBody:AProposal :: forall a. AProposal a -> Annotated ProposalBody a
aBody :: Annotated ProposalBody ByteString
aBody, VerificationKey
$sel:issuer:AProposal :: forall a. AProposal a -> VerificationKey
issuer :: VerificationKey
issuer, Signature ProposalBody
$sel:signature:AProposal :: forall a. AProposal a -> Signature ProposalBody
signature :: Signature ProposalBody
signature} = AProposal ByteString
proposal

    proposerId :: KeyHash
proposerId = VerificationKey -> KeyHash
hashKey VerificationKey
issuer

    Environment
      { Annotated ProtocolMagicId ByteString
protocolMagic :: Annotated ProtocolMagicId ByteString
protocolMagic :: Environment -> Annotated ProtocolMagicId ByteString
protocolMagic,
        Map
delegationMap :: Map
delegationMap :: Environment -> Map
delegationMap
      } = Environment
env

-- | Register the individual components of an update proposal
--
--   The proposal may contain a protocol update, a software update, or both.
--   This corresponds to the `UPV` rules in the spec.
registerProposalComponents ::
  MonadError Error m =>
  Environment ->
  State ->
  AProposal ByteString ->
  m State
registerProposalComponents :: Environment -> State -> AProposal ByteString -> m State
registerProposalComponents Environment
env State
rs AProposal ByteString
proposal = do
  (Bool
protocolVersionChanged Bool -> Bool -> Bool
|| Bool
softwareVersionChanged Bool -> Bool -> Bool
|| Bool
nullUpdateExemptions)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Error
NullUpdateProposal

  -- Register protocol update if we have one
  ProtocolUpdateProposals
registeredPUPs' <-
    if Bool
protocolVersionChanged
      then ProtocolVersion
-> ProtocolParameters
-> ProtocolUpdateProposals
-> AProposal ByteString
-> m ProtocolUpdateProposals
forall (m :: * -> *).
MonadError Error m =>
ProtocolVersion
-> ProtocolParameters
-> ProtocolUpdateProposals
-> AProposal ByteString
-> m ProtocolUpdateProposals
registerProtocolUpdate ProtocolVersion
adoptedPV ProtocolParameters
adoptedPP ProtocolUpdateProposals
registeredPUPs AProposal ByteString
proposal
      else ProtocolUpdateProposals -> m ProtocolUpdateProposals
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProtocolUpdateProposals
registeredPUPs

  -- Register software update if we have one
  SoftwareUpdateProposals
registeredSUPs' <-
    if Bool
softwareVersionChanged
      then ApplicationVersions
-> SoftwareUpdateProposals
-> AProposal ByteString
-> m SoftwareUpdateProposals
forall (m :: * -> *).
MonadError Error m =>
ApplicationVersions
-> SoftwareUpdateProposals
-> AProposal ByteString
-> m SoftwareUpdateProposals
registerSoftwareUpdate ApplicationVersions
appVersions SoftwareUpdateProposals
registeredSUPs AProposal ByteString
proposal
      else SoftwareUpdateProposals -> m SoftwareUpdateProposals
forall (f :: * -> *) a. Applicative f => a -> f a
pure SoftwareUpdateProposals
registeredSUPs

  State -> m State
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State -> m State) -> State -> m State
forall a b. (a -> b) -> a -> b
$ ProtocolUpdateProposals -> SoftwareUpdateProposals -> State
State ProtocolUpdateProposals
registeredPUPs' SoftwareUpdateProposals
registeredSUPs'
  where
    ProposalBody
      { ProtocolVersion
protocolVersion :: ProtocolVersion
$sel:protocolVersion:ProposalBody :: ProposalBody -> ProtocolVersion
protocolVersion,
        $sel:protocolParametersUpdate:ProposalBody :: ProposalBody -> ProtocolParametersUpdate
protocolParametersUpdate = ProtocolParametersUpdate
ppu,
        SoftwareVersion
softwareVersion :: SoftwareVersion
$sel:softwareVersion:ProposalBody :: ProposalBody -> SoftwareVersion
softwareVersion
      } = AProposal ByteString -> ProposalBody
forall a. AProposal a -> ProposalBody
Proposal.body AProposal ByteString
proposal

    SoftwareVersion ApplicationName
appName NumSoftwareVersion
appVersion = SoftwareVersion
softwareVersion

    softwareVersionChanged :: Bool
softwareVersionChanged =
      Bool
-> (ApplicationVersion -> Bool) -> Maybe ApplicationVersion -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((NumSoftwareVersion -> NumSoftwareVersion -> Bool
forall a. Eq a => a -> a -> Bool
/= NumSoftwareVersion
appVersion) (NumSoftwareVersion -> Bool)
-> (ApplicationVersion -> NumSoftwareVersion)
-> ApplicationVersion
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ApplicationVersion -> NumSoftwareVersion
avNumSoftwareVersion) (Maybe ApplicationVersion -> Bool)
-> Maybe ApplicationVersion -> Bool
forall a b. (a -> b) -> a -> b
$
        ApplicationName -> ApplicationVersions -> Maybe ApplicationVersion
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ApplicationName
appName ApplicationVersions
appVersions

    protocolVersionChanged :: Bool
protocolVersionChanged =
      Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ProtocolVersion
protocolVersion ProtocolVersion -> ProtocolVersion -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolVersion
adoptedPV Bool -> Bool -> Bool
&& ProtocolParametersUpdate
-> ProtocolParameters -> ProtocolParameters
PPU.apply ProtocolParametersUpdate
ppu ProtocolParameters
adoptedPP ProtocolParameters -> ProtocolParameters -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolParameters
adoptedPP

    Environment
      { Annotated ProtocolMagicId ByteString
protocolMagic :: Annotated ProtocolMagicId ByteString
protocolMagic :: Environment -> Annotated ProtocolMagicId ByteString
protocolMagic,
        SlotNumber
currentSlot :: SlotNumber
currentSlot :: Environment -> SlotNumber
currentSlot,
        adoptedProtocolVersion :: Environment -> ProtocolVersion
adoptedProtocolVersion = ProtocolVersion
adoptedPV,
        adoptedProtocolParameters :: Environment -> ProtocolParameters
adoptedProtocolParameters = ProtocolParameters
adoptedPP,
        ApplicationVersions
appVersions :: ApplicationVersions
appVersions :: Environment -> ApplicationVersions
appVersions
      } = Environment
env

    State ProtocolUpdateProposals
registeredPUPs SoftwareUpdateProposals
registeredSUPs = State
rs

    -- A "null" update proposal is one that neither increase the protocol
    -- version nor the software version. Such update proposals are invalid
    -- according to the Byron specification. However in the cardano-sl code
    -- they are accepted onto the chain but without any state change.
    --
    -- We cannot follow the legacy cardano-sl interpretation of accepting null
    -- update onto the chain with no effect because it opens the door to DoS
    -- attacks by replaying null update proposals.
    --
    -- For further details see:
    --
    -- https://github.com/input-output-hk/cardano-ledger/issues/759
    -- https://github.com/input-output-hk/cardano-ledger/pull/766
    --
    -- The existing staging network (protocol magic 633343913) does have existing
    -- null update proposals however: one in epoch 44 (slot number 969188) and
    -- one in epoch 88 (slot number 1915231). We could delete the staging network
    -- blockchain and start from scratch, however it is extremely useful for
    -- testing to have a realistic chain that is as long as the mainnet chain,
    -- and indeed that has a large prefix that was created by the legacy
    -- cardano-sl codebase. Therefore we allow for these specific excemptions on
    -- this non-public testing network.
    --
    nullUpdateExemptions :: Bool
nullUpdateExemptions =
      Annotated ProtocolMagicId ByteString -> ProtocolMagicId
forall b a. Annotated b a -> b
unAnnotated Annotated ProtocolMagicId ByteString
protocolMagic ProtocolMagicId -> ProtocolMagicId -> Bool
forall a. Eq a => a -> a -> Bool
== NumSoftwareVersion -> ProtocolMagicId
ProtocolMagicId NumSoftwareVersion
633343913 -- staging
        Bool -> Bool -> Bool
&& ( SlotNumber
currentSlot SlotNumber -> SlotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> SlotNumber
SlotNumber Word64
969188 -- in epoch 44
               Bool -> Bool -> Bool
|| SlotNumber
currentSlot SlotNumber -> SlotNumber -> Bool
forall a. Eq a => a -> a -> Bool
== Word64 -> SlotNumber
SlotNumber Word64
1915231 -- in epoch 88
           )

-- | Validate a protocol update
--
--   We check that:
--
--   1) The protocol update hasn't already been registered
--   2) The protocol version is a valid next version
--   3) The new 'ProtocolParameters' represent a valid update
--
--   This corresponds to the `UPPVV` rule in the spec.
registerProtocolUpdate ::
  MonadError Error m =>
  ProtocolVersion ->
  ProtocolParameters ->
  ProtocolUpdateProposals ->
  AProposal ByteString ->
  m ProtocolUpdateProposals
registerProtocolUpdate :: ProtocolVersion
-> ProtocolParameters
-> ProtocolUpdateProposals
-> AProposal ByteString
-> m ProtocolUpdateProposals
registerProtocolUpdate ProtocolVersion
adoptedPV ProtocolParameters
adoptedPP ProtocolUpdateProposals
registeredPUPs AProposal ByteString
proposal = do
  -- Check that this protocol version isn't already registered
  ProtocolUpdateProposals -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((ProtocolUpdateProposal -> Bool)
-> ProtocolUpdateProposals -> ProtocolUpdateProposals
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((ProtocolVersion -> ProtocolVersion -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolVersion
newPV) (ProtocolVersion -> Bool)
-> (ProtocolUpdateProposal -> ProtocolVersion)
-> ProtocolUpdateProposal
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ProtocolUpdateProposal -> ProtocolVersion
pupProtocolVersion) ProtocolUpdateProposals
registeredPUPs)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` ProtocolVersion -> Error
DuplicateProtocolVersion ProtocolVersion
newPV

  -- Check that this protocol version is a valid next version
  ProtocolVersion -> ProtocolVersion -> Bool
pvCanFollow ProtocolVersion
newPV ProtocolVersion
adoptedPV
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` ProtocolVersion -> Adopted -> Error
InvalidProtocolVersion ProtocolVersion
newPV (ProtocolVersion -> Adopted
Adopted ProtocolVersion
adoptedPV)

  ProtocolParameters
-> ProtocolParameters -> AProposal ByteString -> m ()
forall (m :: * -> *).
MonadError Error m =>
ProtocolParameters
-> ProtocolParameters -> AProposal ByteString -> m ()
canUpdate ProtocolParameters
adoptedPP ProtocolParameters
newPP AProposal ByteString
proposal

  ProtocolUpdateProposals -> m ProtocolUpdateProposals
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProtocolUpdateProposals -> m ProtocolUpdateProposals)
-> ProtocolUpdateProposals -> m ProtocolUpdateProposals
forall a b. (a -> b) -> a -> b
$
    UpId
-> ProtocolUpdateProposal
-> ProtocolUpdateProposals
-> ProtocolUpdateProposals
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
      (AProposal ByteString -> UpId
recoverUpId AProposal ByteString
proposal)
      (ProtocolVersion -> ProtocolParameters -> ProtocolUpdateProposal
ProtocolUpdateProposal ProtocolVersion
newPV ProtocolParameters
newPP)
      ProtocolUpdateProposals
registeredPUPs
  where
    ProposalBody {$sel:protocolVersion:ProposalBody :: ProposalBody -> ProtocolVersion
protocolVersion = ProtocolVersion
newPV, ProtocolParametersUpdate
protocolParametersUpdate :: ProtocolParametersUpdate
$sel:protocolParametersUpdate:ProposalBody :: ProposalBody -> ProtocolParametersUpdate
protocolParametersUpdate} =
      AProposal ByteString -> ProposalBody
forall a. AProposal a -> ProposalBody
Proposal.body AProposal ByteString
proposal
    newPP :: ProtocolParameters
newPP = ProtocolParametersUpdate
-> ProtocolParameters -> ProtocolParameters
PPU.apply ProtocolParametersUpdate
protocolParametersUpdate ProtocolParameters
adoptedPP

-- | Check that the new 'ProtocolVersion' is a valid next version
pvCanFollow :: ProtocolVersion -> ProtocolVersion -> Bool
pvCanFollow :: ProtocolVersion -> ProtocolVersion -> Bool
pvCanFollow ProtocolVersion
newPV ProtocolVersion
adoptedPV = ProtocolVersion
adoptedPV ProtocolVersion -> ProtocolVersion -> Bool
forall a. Ord a => a -> a -> Bool
< ProtocolVersion
newPV Bool -> Bool -> Bool
&& Bool
isNextVersion
  where
    ProtocolVersion Word16
newMajor Word16
newMinor Word8
_ = ProtocolVersion
newPV
    ProtocolVersion Word16
adoptedMajor Word16
adoptedMinor Word8
_ = ProtocolVersion
adoptedPV
    isNextVersion :: Bool
isNextVersion = case Word16
newMajor Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
adoptedMajor of
      Word16
0 -> Word16
newMinor Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
adoptedMinor Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1
      Word16
1 -> Word16
newMinor Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
      Word16
_ -> Bool
False

-- | Check that the new 'ProtocolParameters' represent a valid update
--
--   This is where we enforce constraints on how the 'ProtocolParameters'
--   change.
canUpdate ::
  MonadError Error m =>
  ProtocolParameters ->
  ProtocolParameters ->
  AProposal ByteString ->
  m ()
canUpdate :: ProtocolParameters
-> ProtocolParameters -> AProposal ByteString -> m ()
canUpdate ProtocolParameters
adoptedPP ProtocolParameters
proposedPP AProposal ByteString
proposal = do
  -- Check that the proposal size is less than the maximum
  (Natural
proposalSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
maxProposalSize)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TooLarge Natural -> Error
ProposalTooLarge
      (Natural -> Natural -> TooLarge Natural
forall n. n -> n -> TooLarge n
TooLarge Natural
maxProposalSize Natural
proposalSize)

  -- Check that the new maximum block size is no more than twice the current one
  (Natural
newMaxBlockSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Natural
2 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
adoptedMaxBlockSize)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TooLarge Natural -> Error
MaxBlockSizeTooLarge
      (Natural -> Natural -> TooLarge Natural
forall n. n -> n -> TooLarge n
TooLarge Natural
adoptedMaxBlockSize Natural
newMaxBlockSize)

  -- Check that the new max transaction size is less than the new max block size
  (Natural
newMaxTxSize Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
newMaxBlockSize)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` TooLarge Natural -> Error
MaxTxSizeTooLarge
      (Natural -> Natural -> TooLarge Natural
forall n. n -> n -> TooLarge n
TooLarge Natural
newMaxBlockSize Natural
newMaxTxSize)

  -- Check that the new script version is either the same or incremented
  (Word16
0 Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
scriptVersionDiff Bool -> Bool -> Bool
&& Word16
scriptVersionDiff Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word16
1)
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Word16 -> Word16 -> Error
InvalidScriptVersion
      Word16
adoptedScriptVersion
      Word16
newScriptVersion
  where
    proposalSize :: Natural
    proposalSize :: Natural
proposalSize = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> (ByteString -> Int) -> ByteString -> Natural
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Int
BS.length (ByteString -> Natural) -> ByteString -> Natural
forall a b. (a -> b) -> a -> b
$ AProposal ByteString -> ByteString
forall a. AProposal a -> a
Proposal.annotation AProposal ByteString
proposal
    maxProposalSize :: Natural
maxProposalSize = ProtocolParameters -> Natural
ppMaxProposalSize ProtocolParameters
adoptedPP

    adoptedMaxBlockSize :: Natural
adoptedMaxBlockSize = ProtocolParameters -> Natural
ppMaxBlockSize ProtocolParameters
adoptedPP
    newMaxBlockSize :: Natural
newMaxBlockSize = ProtocolParameters -> Natural
ppMaxBlockSize ProtocolParameters
proposedPP

    newMaxTxSize :: Natural
newMaxTxSize = ProtocolParameters -> Natural
ppMaxTxSize ProtocolParameters
proposedPP

    adoptedScriptVersion :: Word16
adoptedScriptVersion = ProtocolParameters -> Word16
ppScriptVersion ProtocolParameters
adoptedPP
    newScriptVersion :: Word16
newScriptVersion = ProtocolParameters -> Word16
ppScriptVersion ProtocolParameters
proposedPP
    scriptVersionDiff :: Word16
scriptVersionDiff = Word16
newScriptVersion Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
adoptedScriptVersion

-- | Check that a new 'SoftwareVersion' is valid
--
--   We check that:
--
--   1) The 'SoftwareVersion' hasn't already been registered
--   2) The 'SoftwareVersion' is valid according to static checks
--   3) The new 'SoftwareVersion' is a valid next version
--
--   This corresponds to the `UPSVV` rule in the spec.
registerSoftwareUpdate ::
  MonadError Error m =>
  ApplicationVersions ->
  SoftwareUpdateProposals ->
  AProposal ByteString ->
  m SoftwareUpdateProposals
registerSoftwareUpdate :: ApplicationVersions
-> SoftwareUpdateProposals
-> AProposal ByteString
-> m SoftwareUpdateProposals
registerSoftwareUpdate ApplicationVersions
appVersions SoftwareUpdateProposals
registeredSUPs AProposal ByteString
proposal = do
  -- Check that the 'SystemTag's in the metadata are valid
  (SystemTag -> Either SystemTagError ())
-> [SystemTag] -> Either SystemTagError ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SystemTag -> Either SystemTagError ()
forall (m :: * -> *).
MonadError SystemTagError m =>
SystemTag -> m ()
checkSystemTag (Metadata -> [SystemTag]
forall k a. Map k a -> [k]
M.keys Metadata
metadata) Either SystemTagError () -> (SystemTagError -> Error) -> m ()
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` SystemTagError -> Error
SystemTagError

  -- Check that this software version isn't already registered
  SoftwareUpdateProposals -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    ( (SoftwareUpdateProposal -> Bool)
-> SoftwareUpdateProposals -> SoftwareUpdateProposals
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter
        ((ApplicationName -> ApplicationName -> Bool
forall a. Eq a => a -> a -> Bool
== SoftwareVersion -> ApplicationName
svAppName SoftwareVersion
softwareVersion) (ApplicationName -> Bool)
-> (SoftwareUpdateProposal -> ApplicationName)
-> SoftwareUpdateProposal
-> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SoftwareVersion -> ApplicationName
svAppName (SoftwareVersion -> ApplicationName)
-> (SoftwareUpdateProposal -> SoftwareVersion)
-> SoftwareUpdateProposal
-> ApplicationName
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SoftwareUpdateProposal -> SoftwareVersion
supSoftwareVersion)
        SoftwareUpdateProposals
registeredSUPs
    )
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` SoftwareVersion -> Error
DuplicateSoftwareVersion SoftwareVersion
softwareVersion

  -- Check that the software version is valid
  SoftwareVersion -> Either SoftwareVersionError ()
forall (m :: * -> *).
MonadError SoftwareVersionError m =>
SoftwareVersion -> m ()
checkSoftwareVersion SoftwareVersion
softwareVersion Either SoftwareVersionError ()
-> (SoftwareVersionError -> Error) -> m ()
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` SoftwareVersionError -> Error
SoftwareVersionError

  -- Check that this software version is a valid next version
  ApplicationVersions -> SoftwareVersion -> Bool
svCanFollow ApplicationVersions
appVersions SoftwareVersion
softwareVersion
    Bool -> Error -> m ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` ApplicationVersions -> SoftwareVersion -> Error
InvalidSoftwareVersion ApplicationVersions
appVersions SoftwareVersion
softwareVersion

  -- Add to the list of registered software update proposals
  SoftwareUpdateProposals -> m SoftwareUpdateProposals
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SoftwareUpdateProposals -> m SoftwareUpdateProposals)
-> SoftwareUpdateProposals -> m SoftwareUpdateProposals
forall a b. (a -> b) -> a -> b
$
    UpId
-> SoftwareUpdateProposal
-> SoftwareUpdateProposals
-> SoftwareUpdateProposals
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert
      (AProposal ByteString -> UpId
recoverUpId AProposal ByteString
proposal)
      (SoftwareVersion -> Metadata -> SoftwareUpdateProposal
SoftwareUpdateProposal SoftwareVersion
softwareVersion Metadata
metadata)
      SoftwareUpdateProposals
registeredSUPs
  where
    ProposalBody {SoftwareVersion
softwareVersion :: SoftwareVersion
$sel:softwareVersion:ProposalBody :: ProposalBody -> SoftwareVersion
softwareVersion, Metadata
$sel:metadata:ProposalBody :: ProposalBody -> Metadata
metadata :: Metadata
metadata} = AProposal ByteString -> ProposalBody
forall a. AProposal a -> ProposalBody
Proposal.body AProposal ByteString
proposal

-- | Check that a new 'SoftwareVersion' is a valid next version
--
--   The new version is valid for a given application if it is exactly one
--   more than the current version
svCanFollow :: ApplicationVersions -> SoftwareVersion -> Bool
svCanFollow :: ApplicationVersions -> SoftwareVersion -> Bool
svCanFollow ApplicationVersions
avs (SoftwareVersion ApplicationName
appName NumSoftwareVersion
appVersion) =
  case ApplicationName -> ApplicationVersions -> Maybe ApplicationVersion
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ApplicationName
appName ApplicationVersions
avs of
    -- For new apps, the version must start at 0 or 1.
    Maybe ApplicationVersion
Nothing -> NumSoftwareVersion
appVersion NumSoftwareVersion -> NumSoftwareVersion -> Bool
forall a. Eq a => a -> a -> Bool
== NumSoftwareVersion
0 Bool -> Bool -> Bool
|| NumSoftwareVersion
appVersion NumSoftwareVersion -> NumSoftwareVersion -> Bool
forall a. Eq a => a -> a -> Bool
== NumSoftwareVersion
1
    -- For existing apps, it must be exactly one more than the current version
    Just (ApplicationVersion NumSoftwareVersion
currentAppVersion SlotNumber
_ Metadata
_) -> NumSoftwareVersion
appVersion NumSoftwareVersion -> NumSoftwareVersion -> Bool
forall a. Eq a => a -> a -> Bool
== NumSoftwareVersion
currentAppVersion NumSoftwareVersion -> NumSoftwareVersion -> NumSoftwareVersion
forall a. Num a => a -> a -> a
+ NumSoftwareVersion
1