{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | An API for driving on-chain poll for SPOs.
--
-- Polls are done on-chain through transaction metadata and authenticated via
-- stake pool credentials (either VRF public key or Ed25519 cold key).
--
-- The goal is to gather opinions on governance matters such as protocol
-- parameters updates. This standard is meant to be an inclusive interim
-- solution while the work on a larger governance framework such as
-- CIP-1694 continues.
module Cardano.Api.Internal.Governance.Poll
  ( -- * Type Proxies
    AsType (..)
  , Hash (..)

    -- * Types
  , GovernancePoll (..)
  , GovernancePollAnswer (..)

    -- * Errors
  , GovernancePollError (..)
  , renderGovernancePollError

    -- * Functions
  , hashGovernancePoll
  , verifyPollAnswer
  )
where

import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Eras
import Cardano.Api.Internal.HasTypeProxy
import Cardano.Api.Internal.Hash
import Cardano.Api.Internal.Keys.Shelley
import Cardano.Api.Internal.SerialiseCBOR
import Cardano.Api.Internal.SerialiseRaw
import Cardano.Api.Internal.SerialiseTextEnvelope
import Cardano.Api.Internal.SerialiseUsing
import Cardano.Api.Internal.Tx.Body
import Cardano.Api.Internal.Tx.Sign
import Cardano.Api.Internal.TxMetadata
import Cardano.Api.Internal.Utils

import Cardano.Binary (DecoderError (..))
import Cardano.Crypto.Hash (hashFromBytes, hashToBytes, hashWith)
import Cardano.Crypto.Hash qualified as Hash
import Cardano.Ledger.Crypto (HASH, StandardCrypto)

import Control.Arrow (left)
import Control.Monad (foldM, when)
import Data.Either.Combinators (maybeToRight)
import Data.Function ((&))
import Data.Map.Strict qualified as Map
import Data.String (IsString (..))
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Lazy qualified as Text.Lazy
import Data.Text.Lazy.Builder qualified as Text.Builder
import Data.Word (Word64)
import Formatting (build, sformat)
import GHC.Exts (IsList (..))

-- | Associated metadata label as defined in CIP-0094
pollMetadataLabel :: Word64
pollMetadataLabel :: Word64
pollMetadataLabel = Word64
94

-- | Key used to identify the question in a poll metadata object
pollMetadataKeyQuestion :: TxMetadataValue
pollMetadataKeyQuestion :: TxMetadataValue
pollMetadataKeyQuestion = Integer -> TxMetadataValue
TxMetaNumber Integer
0

-- | Key used to identify the possible answers in a poll metadata object
pollMetadataKeyAnswers :: TxMetadataValue
pollMetadataKeyAnswers :: TxMetadataValue
pollMetadataKeyAnswers = Integer -> TxMetadataValue
TxMetaNumber Integer
1

-- | Key used to identify the question hash in a poll metadata object
pollMetadataKeyPoll :: TxMetadataValue
pollMetadataKeyPoll :: TxMetadataValue
pollMetadataKeyPoll = Integer -> TxMetadataValue
TxMetaNumber Integer
2

-- | Key used to identify a chosen answer in a poll metadata object
pollMetadataKeyChoice :: TxMetadataValue
pollMetadataKeyChoice :: TxMetadataValue
pollMetadataKeyChoice = Integer -> TxMetadataValue
TxMetaNumber Integer
3

-- | Key used to identify the optional nonce in a poll metadata object
pollMetadataKeyNonce :: TxMetadataValue
pollMetadataKeyNonce :: TxMetadataValue
pollMetadataKeyNonce = Text -> TxMetadataValue
TxMetaText Text
"_"

-- ----------------------------------------------------------------------------
-- Governance Poll
--

-- | A governance poll declaration meant to be created by one of the genesis
-- delegates and directed towards SPOs.
--
-- A poll is made of a question and some pre-defined answers to chose from.
-- There's an optional nonce used to make poll unique (as things down the line
-- are based on their hashes) if the same question/answers need to be asked
-- multiple times.
data GovernancePoll = GovernancePoll
  { GovernancePoll -> Text
govPollQuestion :: Text
  -- ^ A question as a human readable text; the text can be arbitrarily large.
  , GovernancePoll -> [Text]
govPollAnswers :: [Text]
  -- ^ Answers as human readable texts; their positions are used for answering.
  , GovernancePoll -> Maybe Word
govPollNonce :: Maybe Word
  -- ^ An optional nonce to make the poll unique if needs be.
  }
  deriving (Int -> GovernancePoll -> ShowS
[GovernancePoll] -> ShowS
GovernancePoll -> String
(Int -> GovernancePoll -> ShowS)
-> (GovernancePoll -> String)
-> ([GovernancePoll] -> ShowS)
-> Show GovernancePoll
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernancePoll -> ShowS
showsPrec :: Int -> GovernancePoll -> ShowS
$cshow :: GovernancePoll -> String
show :: GovernancePoll -> String
$cshowList :: [GovernancePoll] -> ShowS
showList :: [GovernancePoll] -> ShowS
Show, GovernancePoll -> GovernancePoll -> Bool
(GovernancePoll -> GovernancePoll -> Bool)
-> (GovernancePoll -> GovernancePoll -> Bool) -> Eq GovernancePoll
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovernancePoll -> GovernancePoll -> Bool
== :: GovernancePoll -> GovernancePoll -> Bool
$c/= :: GovernancePoll -> GovernancePoll -> Bool
/= :: GovernancePoll -> GovernancePoll -> Bool
Eq)

instance HasTextEnvelope GovernancePoll where
  textEnvelopeType :: AsType GovernancePoll -> TextEnvelopeType
textEnvelopeType AsType GovernancePoll
_ = TextEnvelopeType
"GovernancePoll"

instance HasTypeProxy GovernancePoll where
  data AsType GovernancePoll = AsGovernancePoll
  proxyToAsType :: Proxy GovernancePoll -> AsType GovernancePoll
proxyToAsType Proxy GovernancePoll
_ = AsType GovernancePoll
AsGovernancePoll

instance AsTxMetadata GovernancePoll where
  asTxMetadata :: GovernancePoll -> TxMetadata
asTxMetadata GovernancePoll{Text
govPollQuestion :: GovernancePoll -> Text
govPollQuestion :: Text
govPollQuestion, [Text]
govPollAnswers :: GovernancePoll -> [Text]
govPollAnswers :: [Text]
govPollAnswers, Maybe Word
govPollNonce :: GovernancePoll -> Maybe Word
govPollNonce :: Maybe Word
govPollNonce} =
    Map Word64 TxMetadataValue -> TxMetadata
makeTransactionMetadata (Map Word64 TxMetadataValue -> TxMetadata)
-> Map Word64 TxMetadataValue -> TxMetadata
forall a b. (a -> b) -> a -> b
$
      [Item (Map Word64 TxMetadataValue)] -> Map Word64 TxMetadataValue
forall l. IsList l => [Item l] -> l
fromList
        [
          ( Word64
pollMetadataLabel
          , [(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue
TxMetaMap ([(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue)
-> [(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue
forall a b. (a -> b) -> a -> b
$
              [ (TxMetadataValue
pollMetadataKeyQuestion, Text -> TxMetadataValue
metaTextChunks Text
govPollQuestion)
              , (TxMetadataValue
pollMetadataKeyAnswers, [TxMetadataValue] -> TxMetadataValue
TxMetaList (Text -> TxMetadataValue
metaTextChunks (Text -> TxMetadataValue) -> [Text] -> [TxMetadataValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
govPollAnswers))
              ]
                [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
-> [(TxMetadataValue, TxMetadataValue)]
forall a. [a] -> [a] -> [a]
++ case Maybe Word
govPollNonce of
                  Maybe Word
Nothing -> []
                  Just Word
nonce ->
                    [ (TxMetadataValue
pollMetadataKeyNonce, Integer -> TxMetadataValue
TxMetaNumber (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
nonce))
                    ]
          )
        ]

instance SerialiseAsCBOR GovernancePoll where
  serialiseToCBOR :: GovernancePoll -> ByteString
serialiseToCBOR =
    TxMetadata -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR (TxMetadata -> ByteString)
-> (GovernancePoll -> TxMetadata) -> GovernancePoll -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernancePoll -> TxMetadata
forall a. AsTxMetadata a => a -> TxMetadata
asTxMetadata

  deserialiseFromCBOR :: AsType GovernancePoll
-> ByteString -> Either DecoderError GovernancePoll
deserialiseFromCBOR AsType GovernancePoll
R:AsTypeGovernancePoll
AsGovernancePoll ByteString
bs = do
    TxMetadata
metadata <- AsType TxMetadata -> ByteString -> Either DecoderError TxMetadata
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType TxMetadata
AsTxMetadata ByteString
bs
    Text
-> Word64
-> TxMetadata
-> ([(TxMetadataValue, TxMetadataValue)]
    -> Either DecoderError GovernancePoll)
-> Either DecoderError GovernancePoll
forall a.
Text
-> Word64
-> TxMetadata
-> ([(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a)
-> Either DecoderError a
withNestedMap Text
lbl Word64
pollMetadataLabel TxMetadata
metadata (([(TxMetadataValue, TxMetadataValue)]
  -> Either DecoderError GovernancePoll)
 -> Either DecoderError GovernancePoll)
-> ([(TxMetadataValue, TxMetadataValue)]
    -> Either DecoderError GovernancePoll)
-> Either DecoderError GovernancePoll
forall a b. (a -> b) -> a -> b
$ \[(TxMetadataValue, TxMetadataValue)]
values ->
      Text -> [Text] -> Maybe Word -> GovernancePoll
GovernancePoll
        -- Question
        (Text -> [Text] -> Maybe Word -> GovernancePoll)
-> Either DecoderError Text
-> Either DecoderError ([Text] -> Maybe Word -> GovernancePoll)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( let key :: TxMetadataValue
key = TxMetadataValue
pollMetadataKeyQuestion
               in case TxMetadataValue
-> [(TxMetadataValue, TxMetadataValue)] -> Maybe TxMetadataValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TxMetadataValue
key [(TxMetadataValue, TxMetadataValue)]
values of
                    Just TxMetadataValue
x ->
                      Text -> TxMetadataValue -> Either DecoderError Text
expectTextChunks (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) TxMetadataValue
x
                    Maybe TxMetadataValue
Nothing ->
                      DecoderError -> Either DecoderError Text
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError Text)
-> DecoderError -> Either DecoderError Text
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
missingField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key)
            )
        -- Answers
        Either DecoderError ([Text] -> Maybe Word -> GovernancePoll)
-> Either DecoderError [Text]
-> Either DecoderError (Maybe Word -> GovernancePoll)
forall a b.
Either DecoderError (a -> b)
-> Either DecoderError a -> Either DecoderError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( let key :: TxMetadataValue
key = TxMetadataValue
pollMetadataKeyAnswers
               in case TxMetadataValue
-> [(TxMetadataValue, TxMetadataValue)] -> Maybe TxMetadataValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TxMetadataValue
key [(TxMetadataValue, TxMetadataValue)]
values of
                    Just (TxMetaList [TxMetadataValue]
xs) ->
                      (TxMetadataValue -> Either DecoderError Text)
-> [TxMetadataValue] -> Either DecoderError [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Text -> TxMetadataValue -> Either DecoderError Text
expectTextChunks (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key)) [TxMetadataValue]
xs
                    Just TxMetadataValue
_ ->
                      DecoderError -> Either DecoderError [Text]
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError [Text])
-> DecoderError -> Either DecoderError [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
malformedField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) Text
"List of Text (answers)"
                    Maybe TxMetadataValue
Nothing ->
                      DecoderError -> Either DecoderError [Text]
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError [Text])
-> DecoderError -> Either DecoderError [Text]
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
missingField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key)
            )
        -- Nonce (optional)
        Either DecoderError (Maybe Word -> GovernancePoll)
-> Either DecoderError (Maybe Word)
-> Either DecoderError GovernancePoll
forall a b.
Either DecoderError (a -> b)
-> Either DecoderError a -> Either DecoderError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( let key :: TxMetadataValue
key = TxMetadataValue
pollMetadataKeyNonce
               in case TxMetadataValue
-> [(TxMetadataValue, TxMetadataValue)] -> Maybe TxMetadataValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TxMetadataValue
key [(TxMetadataValue, TxMetadataValue)]
values of
                    Just (TxMetaNumber Integer
nonce) ->
                      Word -> Maybe Word
forall a. a -> Maybe a
Just (Word -> Maybe Word)
-> Either DecoderError Word -> Either DecoderError (Maybe Word)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Integer -> Either DecoderError Word
expectWord (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) Integer
nonce
                    Maybe TxMetadataValue
Nothing ->
                      Maybe Word -> Either DecoderError (Maybe Word)
forall a. a -> Either DecoderError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word
forall a. Maybe a
Nothing
                    Just TxMetadataValue
_ ->
                      DecoderError -> Either DecoderError (Maybe Word)
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError (Maybe Word))
-> DecoderError -> Either DecoderError (Maybe Word)
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
malformedField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) Text
"Number (nonce)"
            )
   where
    lbl :: Text
lbl = Text
"GovernancePoll"

--  ----------------------------------------------------------------------------
-- Governance Poll Hash
--

newtype instance Hash GovernancePoll
  = GovernancePollHash {Hash GovernancePoll -> Hash (HASH StandardCrypto) GovernancePoll
unGovernancePollHash :: Hash.Hash (HASH StandardCrypto) GovernancePoll}
  deriving stock (Hash GovernancePoll -> Hash GovernancePoll -> Bool
(Hash GovernancePoll -> Hash GovernancePoll -> Bool)
-> (Hash GovernancePoll -> Hash GovernancePoll -> Bool)
-> Eq (Hash GovernancePoll)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
== :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
$c/= :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
/= :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
Eq, Eq (Hash GovernancePoll)
Eq (Hash GovernancePoll) =>
(Hash GovernancePoll -> Hash GovernancePoll -> Ordering)
-> (Hash GovernancePoll -> Hash GovernancePoll -> Bool)
-> (Hash GovernancePoll -> Hash GovernancePoll -> Bool)
-> (Hash GovernancePoll -> Hash GovernancePoll -> Bool)
-> (Hash GovernancePoll -> Hash GovernancePoll -> Bool)
-> (Hash GovernancePoll
    -> Hash GovernancePoll -> Hash GovernancePoll)
-> (Hash GovernancePoll
    -> Hash GovernancePoll -> Hash GovernancePoll)
-> Ord (Hash GovernancePoll)
Hash GovernancePoll -> Hash GovernancePoll -> Bool
Hash GovernancePoll -> Hash GovernancePoll -> Ordering
Hash GovernancePoll -> Hash GovernancePoll -> Hash GovernancePoll
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash GovernancePoll -> Hash GovernancePoll -> Ordering
compare :: Hash GovernancePoll -> Hash GovernancePoll -> Ordering
$c< :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
< :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
$c<= :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
<= :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
$c> :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
> :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
$c>= :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
>= :: Hash GovernancePoll -> Hash GovernancePoll -> Bool
$cmax :: Hash GovernancePoll -> Hash GovernancePoll -> Hash GovernancePoll
max :: Hash GovernancePoll -> Hash GovernancePoll -> Hash GovernancePoll
$cmin :: Hash GovernancePoll -> Hash GovernancePoll -> Hash GovernancePoll
min :: Hash GovernancePoll -> Hash GovernancePoll -> Hash GovernancePoll
Ord)
  deriving (Int -> Hash GovernancePoll -> ShowS
[Hash GovernancePoll] -> ShowS
Hash GovernancePoll -> String
(Int -> Hash GovernancePoll -> ShowS)
-> (Hash GovernancePoll -> String)
-> ([Hash GovernancePoll] -> ShowS)
-> Show (Hash GovernancePoll)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash GovernancePoll -> ShowS
showsPrec :: Int -> Hash GovernancePoll -> ShowS
$cshow :: Hash GovernancePoll -> String
show :: Hash GovernancePoll -> String
$cshowList :: [Hash GovernancePoll] -> ShowS
showList :: [Hash GovernancePoll] -> ShowS
Show, String -> Hash GovernancePoll
(String -> Hash GovernancePoll) -> IsString (Hash GovernancePoll)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash GovernancePoll
fromString :: String -> Hash GovernancePoll
IsString) via UsingRawBytesHex (Hash GovernancePoll)

instance SerialiseAsRawBytes (Hash GovernancePoll) where
  serialiseToRawBytes :: Hash GovernancePoll -> ByteString
serialiseToRawBytes =
    Hash Blake2b_256 GovernancePoll -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash Blake2b_256 GovernancePoll -> ByteString)
-> (Hash GovernancePoll -> Hash Blake2b_256 GovernancePoll)
-> Hash GovernancePoll
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash GovernancePoll -> Hash Blake2b_256 GovernancePoll
Hash GovernancePoll -> Hash (HASH StandardCrypto) GovernancePoll
unGovernancePollHash

  deserialiseFromRawBytes :: AsType (Hash GovernancePoll)
-> ByteString
-> Either SerialiseAsRawBytesError (Hash GovernancePoll)
deserialiseFromRawBytes (AsHash AsType GovernancePoll
R:AsTypeGovernancePoll
AsGovernancePoll) ByteString
bs =
    SerialiseAsRawBytesError
-> Maybe (Hash GovernancePoll)
-> Either SerialiseAsRawBytesError (Hash GovernancePoll)
forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash(GovernancePoll)") (Maybe (Hash GovernancePoll)
 -> Either SerialiseAsRawBytesError (Hash GovernancePoll))
-> Maybe (Hash GovernancePoll)
-> Either SerialiseAsRawBytesError (Hash GovernancePoll)
forall a b. (a -> b) -> a -> b
$
      Hash Blake2b_256 GovernancePoll -> Hash GovernancePoll
Hash (HASH StandardCrypto) GovernancePoll -> Hash GovernancePoll
GovernancePollHash (Hash Blake2b_256 GovernancePoll -> Hash GovernancePoll)
-> Maybe (Hash Blake2b_256 GovernancePoll)
-> Maybe (Hash GovernancePoll)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_256 GovernancePoll)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
bs

hashGovernancePoll :: GovernancePoll -> Hash GovernancePoll
hashGovernancePoll :: GovernancePoll -> Hash GovernancePoll
hashGovernancePoll =
  Hash Blake2b_256 GovernancePoll -> Hash GovernancePoll
Hash (HASH StandardCrypto) GovernancePoll -> Hash GovernancePoll
GovernancePollHash (Hash Blake2b_256 GovernancePoll -> Hash GovernancePoll)
-> (GovernancePoll -> Hash Blake2b_256 GovernancePoll)
-> GovernancePoll
-> Hash GovernancePoll
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith @(HASH StandardCrypto) GovernancePoll -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR

-- ----------------------------------------------------------------------------
-- Governance Poll Answer
--

-- | An (unauthenticated) answer to a poll from an SPO referring to a poll by
-- hash digest value.
data GovernancePollAnswer = GovernancePollAnswer
  { GovernancePollAnswer -> Hash GovernancePoll
govAnsPoll :: Hash GovernancePoll
  -- ^ The target poll
  , GovernancePollAnswer -> Word
govAnsChoice :: Word
  -- ^ The (0-based) index of the chosen answer from that poll
  }
  deriving (Int -> GovernancePollAnswer -> ShowS
[GovernancePollAnswer] -> ShowS
GovernancePollAnswer -> String
(Int -> GovernancePollAnswer -> ShowS)
-> (GovernancePollAnswer -> String)
-> ([GovernancePollAnswer] -> ShowS)
-> Show GovernancePollAnswer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernancePollAnswer -> ShowS
showsPrec :: Int -> GovernancePollAnswer -> ShowS
$cshow :: GovernancePollAnswer -> String
show :: GovernancePollAnswer -> String
$cshowList :: [GovernancePollAnswer] -> ShowS
showList :: [GovernancePollAnswer] -> ShowS
Show, GovernancePollAnswer -> GovernancePollAnswer -> Bool
(GovernancePollAnswer -> GovernancePollAnswer -> Bool)
-> (GovernancePollAnswer -> GovernancePollAnswer -> Bool)
-> Eq GovernancePollAnswer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GovernancePollAnswer -> GovernancePollAnswer -> Bool
== :: GovernancePollAnswer -> GovernancePollAnswer -> Bool
$c/= :: GovernancePollAnswer -> GovernancePollAnswer -> Bool
/= :: GovernancePollAnswer -> GovernancePollAnswer -> Bool
Eq)

instance HasTypeProxy GovernancePollAnswer where
  data AsType GovernancePollAnswer = AsGovernancePollAnswer
  proxyToAsType :: Proxy GovernancePollAnswer -> AsType GovernancePollAnswer
proxyToAsType Proxy GovernancePollAnswer
_ = AsType GovernancePollAnswer
AsGovernancePollAnswer

instance AsTxMetadata GovernancePollAnswer where
  asTxMetadata :: GovernancePollAnswer -> TxMetadata
asTxMetadata GovernancePollAnswer{Hash GovernancePoll
govAnsPoll :: GovernancePollAnswer -> Hash GovernancePoll
govAnsPoll :: Hash GovernancePoll
govAnsPoll, Word
govAnsChoice :: GovernancePollAnswer -> Word
govAnsChoice :: Word
govAnsChoice} =
    Map Word64 TxMetadataValue -> TxMetadata
makeTransactionMetadata (Map Word64 TxMetadataValue -> TxMetadata)
-> Map Word64 TxMetadataValue -> TxMetadata
forall a b. (a -> b) -> a -> b
$
      [Item (Map Word64 TxMetadataValue)] -> Map Word64 TxMetadataValue
forall l. IsList l => [Item l] -> l
fromList
        [
          ( Word64
pollMetadataLabel
          , [(TxMetadataValue, TxMetadataValue)] -> TxMetadataValue
TxMetaMap
              [ (TxMetadataValue
pollMetadataKeyPoll, ByteString -> TxMetadataValue
TxMetaBytes (Hash GovernancePoll -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes Hash GovernancePoll
govAnsPoll))
              , (TxMetadataValue
pollMetadataKeyChoice, Integer -> TxMetadataValue
TxMetaNumber (Word -> Integer
forall a. Integral a => a -> Integer
toInteger Word
govAnsChoice))
              ]
          )
        ]

instance SerialiseAsCBOR GovernancePollAnswer where
  serialiseToCBOR :: GovernancePollAnswer -> ByteString
serialiseToCBOR =
    TxMetadata -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR (TxMetadata -> ByteString)
-> (GovernancePollAnswer -> TxMetadata)
-> GovernancePollAnswer
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GovernancePollAnswer -> TxMetadata
forall a. AsTxMetadata a => a -> TxMetadata
asTxMetadata

  deserialiseFromCBOR :: AsType GovernancePollAnswer
-> ByteString -> Either DecoderError GovernancePollAnswer
deserialiseFromCBOR AsType GovernancePollAnswer
R:AsTypeGovernancePollAnswer
AsGovernancePollAnswer ByteString
bs = do
    TxMetadata
metadata <- AsType TxMetadata -> ByteString -> Either DecoderError TxMetadata
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType TxMetadata
AsTxMetadata ByteString
bs
    Text
-> Word64
-> TxMetadata
-> ([(TxMetadataValue, TxMetadataValue)]
    -> Either DecoderError GovernancePollAnswer)
-> Either DecoderError GovernancePollAnswer
forall a.
Text
-> Word64
-> TxMetadata
-> ([(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a)
-> Either DecoderError a
withNestedMap Text
lbl Word64
pollMetadataLabel TxMetadata
metadata (([(TxMetadataValue, TxMetadataValue)]
  -> Either DecoderError GovernancePollAnswer)
 -> Either DecoderError GovernancePollAnswer)
-> ([(TxMetadataValue, TxMetadataValue)]
    -> Either DecoderError GovernancePollAnswer)
-> Either DecoderError GovernancePollAnswer
forall a b. (a -> b) -> a -> b
$ \[(TxMetadataValue, TxMetadataValue)]
values ->
      Hash GovernancePoll -> Word -> GovernancePollAnswer
GovernancePollAnswer
        -- Poll
        (Hash GovernancePoll -> Word -> GovernancePollAnswer)
-> Either DecoderError (Hash GovernancePoll)
-> Either DecoderError (Word -> GovernancePollAnswer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( let key :: TxMetadataValue
key = TxMetadataValue
pollMetadataKeyPoll
               in case TxMetadataValue
-> [(TxMetadataValue, TxMetadataValue)] -> Maybe TxMetadataValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TxMetadataValue
key [(TxMetadataValue, TxMetadataValue)]
values of
                    Maybe TxMetadataValue
Nothing ->
                      DecoderError -> Either DecoderError (Hash GovernancePoll)
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError (Hash GovernancePoll))
-> DecoderError -> Either DecoderError (Hash GovernancePoll)
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
missingField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key)
                    Just TxMetadataValue
x ->
                      TxMetadataValue
-> TxMetadataValue -> Either DecoderError (Hash GovernancePoll)
expectHash TxMetadataValue
key TxMetadataValue
x
            )
        -- Answer
        Either DecoderError (Word -> GovernancePollAnswer)
-> Either DecoderError Word
-> Either DecoderError GovernancePollAnswer
forall a b.
Either DecoderError (a -> b)
-> Either DecoderError a -> Either DecoderError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( let key :: TxMetadataValue
key = TxMetadataValue
pollMetadataKeyChoice
               in case TxMetadataValue
-> [(TxMetadataValue, TxMetadataValue)] -> Maybe TxMetadataValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup TxMetadataValue
key [(TxMetadataValue, TxMetadataValue)]
values of
                    Just (TxMetaNumber Integer
n) ->
                      Text -> Integer -> Either DecoderError Word
expectWord (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) Integer
n
                    Just TxMetadataValue
_ ->
                      DecoderError -> Either DecoderError Word
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError Word)
-> DecoderError -> Either DecoderError Word
forall a b. (a -> b) -> a -> b
$ Text -> Text -> DecoderError
malformedField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) Text
"Number (answer index)"
                    Maybe TxMetadataValue
Nothing ->
                      DecoderError -> Either DecoderError Word
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError Word)
-> DecoderError -> Either DecoderError Word
forall a b. (a -> b) -> a -> b
$ Text -> DecoderError
missingField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key)
            )
   where
    lbl :: Text
lbl = Text
"GovernancePollAnswer"

    expectHash :: TxMetadataValue
-> TxMetadataValue -> Either DecoderError (Hash GovernancePoll)
expectHash TxMetadataValue
key TxMetadataValue
value =
      case TxMetadataValue
value of
        TxMetaBytes ByteString
bytes ->
          (SerialiseAsRawBytesError -> DecoderError)
-> Either SerialiseAsRawBytesError (Hash GovernancePoll)
-> Either DecoderError (Hash GovernancePoll)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left
            (Text -> Text -> DecoderError
DecoderErrorCustom (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) (Text -> DecoderError)
-> (SerialiseAsRawBytesError -> Text)
-> SerialiseAsRawBytesError
-> DecoderError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text)
-> (SerialiseAsRawBytesError -> String)
-> SerialiseAsRawBytesError
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerialiseAsRawBytesError -> String
unSerialiseAsRawBytesError)
            (AsType (Hash GovernancePoll)
-> ByteString
-> Either SerialiseAsRawBytesError (Hash GovernancePoll)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes (AsType GovernancePoll -> AsType (Hash GovernancePoll)
forall a. AsType a -> AsType (Hash a)
AsHash AsType GovernancePoll
AsGovernancePoll) ByteString
bytes)
        TxMetadataValue
_ ->
          DecoderError -> Either DecoderError (Hash GovernancePoll)
forall a b. a -> Either a b
Left (Text -> Text -> DecoderError
malformedField (Text -> TxMetadataValue -> Text
fieldPath Text
lbl TxMetadataValue
key) Text
"Bytes (32 bytes hash digest)")

-- ----------------------------------------------------------------------------
-- Governance Poll Verification
--

data GovernancePollError
  = ErrGovernancePollMismatch GovernancePollMismatchError
  | ErrGovernancePollNoAnswer
  | ErrGovernancePollUnauthenticated
  | ErrGovernancePollMalformedAnswer DecoderError
  | ErrGovernancePollInvalidAnswer GovernancePollInvalidAnswerError
  deriving Int -> GovernancePollError -> ShowS
[GovernancePollError] -> ShowS
GovernancePollError -> String
(Int -> GovernancePollError -> ShowS)
-> (GovernancePollError -> String)
-> ([GovernancePollError] -> ShowS)
-> Show GovernancePollError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernancePollError -> ShowS
showsPrec :: Int -> GovernancePollError -> ShowS
$cshow :: GovernancePollError -> String
show :: GovernancePollError -> String
$cshowList :: [GovernancePollError] -> ShowS
showList :: [GovernancePollError] -> ShowS
Show

data GovernancePollInvalidAnswerError = GovernancePollInvalidAnswerError
  { GovernancePollInvalidAnswerError -> [(Word, Text)]
invalidAnswerAcceptableAnswers :: [(Word, Text)]
  , GovernancePollInvalidAnswerError -> Word
invalidAnswerReceivedAnswer :: Word
  }
  deriving Int -> GovernancePollInvalidAnswerError -> ShowS
[GovernancePollInvalidAnswerError] -> ShowS
GovernancePollInvalidAnswerError -> String
(Int -> GovernancePollInvalidAnswerError -> ShowS)
-> (GovernancePollInvalidAnswerError -> String)
-> ([GovernancePollInvalidAnswerError] -> ShowS)
-> Show GovernancePollInvalidAnswerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernancePollInvalidAnswerError -> ShowS
showsPrec :: Int -> GovernancePollInvalidAnswerError -> ShowS
$cshow :: GovernancePollInvalidAnswerError -> String
show :: GovernancePollInvalidAnswerError -> String
$cshowList :: [GovernancePollInvalidAnswerError] -> ShowS
showList :: [GovernancePollInvalidAnswerError] -> ShowS
Show

data GovernancePollMismatchError = GovernancePollMismatchError
  { GovernancePollMismatchError -> Hash GovernancePoll
specifiedHashInAnswer :: Hash GovernancePoll
  , GovernancePollMismatchError -> Hash GovernancePoll
calculatedHashFromPoll :: Hash GovernancePoll
  }
  deriving Int -> GovernancePollMismatchError -> ShowS
[GovernancePollMismatchError] -> ShowS
GovernancePollMismatchError -> String
(Int -> GovernancePollMismatchError -> ShowS)
-> (GovernancePollMismatchError -> String)
-> ([GovernancePollMismatchError] -> ShowS)
-> Show GovernancePollMismatchError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GovernancePollMismatchError -> ShowS
showsPrec :: Int -> GovernancePollMismatchError -> ShowS
$cshow :: GovernancePollMismatchError -> String
show :: GovernancePollMismatchError -> String
$cshowList :: [GovernancePollMismatchError] -> ShowS
showList :: [GovernancePollMismatchError] -> ShowS
Show

renderGovernancePollError :: GovernancePollError -> Text
renderGovernancePollError :: GovernancePollError -> Text
renderGovernancePollError GovernancePollError
err =
  case GovernancePollError
err of
    ErrGovernancePollMismatch GovernancePollMismatchError
mismatchErr ->
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Answer's poll doesn't match provided poll (hash mismatch).\n"
        , Text
"  Hash specified in answer:  " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash GovernancePoll -> Text
forall a. Show a => a -> Text
textShow (GovernancePollMismatchError -> Hash GovernancePoll
specifiedHashInAnswer GovernancePollMismatchError
mismatchErr)
        , Text
"\n"
        , Text
"  Hash calculated from poll: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Hash GovernancePoll -> Text
forall a. Show a => a -> Text
textShow (GovernancePollMismatchError -> Hash GovernancePoll
calculatedHashFromPoll GovernancePollMismatchError
mismatchErr)
        ]
    GovernancePollError
ErrGovernancePollNoAnswer ->
      Text
"No answer found in the provided transaction's metadata."
    GovernancePollError
ErrGovernancePollUnauthenticated ->
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"No (valid) signatories found for the answer. "
        , Text
"Signatories MUST be specified as extra signatories on the transaction "
        , Text
"and cannot be mere payment keys."
        ]
    ErrGovernancePollMalformedAnswer DecoderError
decoderErr ->
      Text
"Malformed metadata; couldn't deserialise answer: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Format Text (DecoderError -> Text) -> DecoderError -> Text
forall a. Format Text a -> a
sformat Format Text (DecoderError -> Text)
forall a r. Buildable a => Format r (a -> r)
build DecoderError
decoderErr
    ErrGovernancePollInvalidAnswer GovernancePollInvalidAnswerError
invalidAnswer ->
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
        [ Text
"Invalid answer ("
        , Word -> Text
forall a. Show a => a -> Text
textShow (GovernancePollInvalidAnswerError -> Word
invalidAnswerReceivedAnswer GovernancePollInvalidAnswerError
invalidAnswer)
        , Text
") not part of the poll."
        , Text
"\n"
        , Text
"Accepted answers:"
        , Text
"\n"
        , Text -> [Text] -> Text
Text.intercalate
            Text
"\n"
            [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ Word -> Text
forall a. Show a => a -> Text
textShow Word
ix
                , Text
" → "
                , Text
answer
                ]
            | (Word
ix, Text
answer) <- GovernancePollInvalidAnswerError -> [(Word, Text)]
invalidAnswerAcceptableAnswers GovernancePollInvalidAnswerError
invalidAnswer
            ]
        ]

-- | Verify a poll against a given transaction and returns the signatories
-- (verification key only) when valid.
--
-- Note: signatures aren't checked as it is assumed to have been done externally
-- (the existence of the transaction in the ledger provides this guarantee).
verifyPollAnswer
  :: GovernancePoll
  -> InAnyShelleyBasedEra Tx
  -> Either GovernancePollError [Hash PaymentKey]
verifyPollAnswer :: GovernancePoll
-> InAnyShelleyBasedEra Tx
-> Either GovernancePollError [Hash PaymentKey]
verifyPollAnswer GovernancePoll
poll (InAnyShelleyBasedEra ShelleyBasedEra era
_era Tx era
tx) = do
  GovernancePollAnswer
answer <- TxMetadataInEra era
-> Either GovernancePollError GovernancePollAnswer
forall {era}.
TxMetadataInEra era
-> Either GovernancePollError GovernancePollAnswer
extractPollAnswer (TxBodyContent ViewTx era -> TxMetadataInEra era
forall build era. TxBodyContent build era -> TxMetadataInEra era
txMetadata TxBodyContent ViewTx era
body)
  GovernancePollAnswer
answer GovernancePollAnswer
-> Hash GovernancePoll -> Either GovernancePollError ()
`hasMatchingHash` GovernancePoll -> Hash GovernancePoll
hashGovernancePoll GovernancePoll
poll
  GovernancePollAnswer
answer GovernancePollAnswer -> [Text] -> Either GovernancePollError ()
`isAmongAcceptableChoices` GovernancePoll -> [Text]
govPollAnswers GovernancePoll
poll
  TxExtraKeyWitnesses era
-> Either GovernancePollError [Hash PaymentKey]
forall {era}.
TxExtraKeyWitnesses era
-> Either GovernancePollError [Hash PaymentKey]
extraKeyWitnesses (TxBodyContent ViewTx era -> TxExtraKeyWitnesses era
forall build era.
TxBodyContent build era -> TxExtraKeyWitnesses era
txExtraKeyWits TxBodyContent ViewTx era
body)
 where
  body :: TxBodyContent ViewTx era
body = TxBody era -> TxBodyContent ViewTx era
forall era. TxBody era -> TxBodyContent ViewTx era
getTxBodyContent (TxBody era -> TxBodyContent ViewTx era)
-> TxBody era -> TxBodyContent ViewTx era
forall a b. (a -> b) -> a -> b
$ Tx era -> TxBody era
forall era. Tx era -> TxBody era
getTxBody Tx era
tx
  extractPollAnswer :: TxMetadataInEra era
-> Either GovernancePollError GovernancePollAnswer
extractPollAnswer = \case
    TxMetadataInEra era
TxMetadataNone ->
      GovernancePollError
-> Either GovernancePollError GovernancePollAnswer
forall a b. a -> Either a b
Left GovernancePollError
ErrGovernancePollNoAnswer
    TxMetadataInEra ShelleyBasedEra era
_era TxMetadata
metadata ->
      (DecoderError -> GovernancePollError)
-> Either DecoderError GovernancePollAnswer
-> Either GovernancePollError GovernancePollAnswer
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left DecoderError -> GovernancePollError
ErrGovernancePollMalformedAnswer (Either DecoderError GovernancePollAnswer
 -> Either GovernancePollError GovernancePollAnswer)
-> Either DecoderError GovernancePollAnswer
-> Either GovernancePollError GovernancePollAnswer
forall a b. (a -> b) -> a -> b
$
        AsType GovernancePollAnswer
-> ByteString -> Either DecoderError GovernancePollAnswer
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR AsType GovernancePollAnswer
AsGovernancePollAnswer (TxMetadata -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR TxMetadata
metadata)

  hasMatchingHash :: GovernancePollAnswer
-> Hash GovernancePoll -> Either GovernancePollError ()
hasMatchingHash GovernancePollAnswer
answer Hash GovernancePoll
calculatedHashFromPoll = do
    let specifiedHashInAnswer :: Hash GovernancePoll
specifiedHashInAnswer = GovernancePollAnswer -> Hash GovernancePoll
govAnsPoll GovernancePollAnswer
answer
    Bool
-> Either GovernancePollError () -> Either GovernancePollError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Hash GovernancePoll
calculatedHashFromPoll Hash GovernancePoll -> Hash GovernancePoll -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash GovernancePoll
specifiedHashInAnswer) (Either GovernancePollError () -> Either GovernancePollError ())
-> Either GovernancePollError () -> Either GovernancePollError ()
forall a b. (a -> b) -> a -> b
$
      GovernancePollError -> Either GovernancePollError ()
forall a b. a -> Either a b
Left (GovernancePollError -> Either GovernancePollError ())
-> GovernancePollError -> Either GovernancePollError ()
forall a b. (a -> b) -> a -> b
$
        GovernancePollMismatchError -> GovernancePollError
ErrGovernancePollMismatch (GovernancePollMismatchError -> GovernancePollError)
-> GovernancePollMismatchError -> GovernancePollError
forall a b. (a -> b) -> a -> b
$
          GovernancePollMismatchError
            { Hash GovernancePoll
specifiedHashInAnswer :: Hash GovernancePoll
specifiedHashInAnswer :: Hash GovernancePoll
specifiedHashInAnswer
            , Hash GovernancePoll
calculatedHashFromPoll :: Hash GovernancePoll
calculatedHashFromPoll :: Hash GovernancePoll
calculatedHashFromPoll
            }

  isAmongAcceptableChoices :: GovernancePollAnswer -> [Text] -> Either GovernancePollError ()
isAmongAcceptableChoices GovernancePollAnswer
answer [Text]
answers =
    Bool
-> Either GovernancePollError () -> Either GovernancePollError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GovernancePollAnswer -> Word
govAnsChoice GovernancePollAnswer
answer Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
answers)) (Either GovernancePollError () -> Either GovernancePollError ())
-> Either GovernancePollError () -> Either GovernancePollError ()
forall a b. (a -> b) -> a -> b
$ do
      let invalidAnswerReceivedAnswer :: Word
invalidAnswerReceivedAnswer = GovernancePollAnswer -> Word
govAnsChoice GovernancePollAnswer
answer
      let invalidAnswerAcceptableAnswers :: [(Word, Text)]
invalidAnswerAcceptableAnswers = [Word] -> [Text] -> [(Word, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
0 ..] [Text]
answers
      GovernancePollError -> Either GovernancePollError ()
forall a b. a -> Either a b
Left (GovernancePollError -> Either GovernancePollError ())
-> GovernancePollError -> Either GovernancePollError ()
forall a b. (a -> b) -> a -> b
$
        GovernancePollInvalidAnswerError -> GovernancePollError
ErrGovernancePollInvalidAnswer (GovernancePollInvalidAnswerError -> GovernancePollError)
-> GovernancePollInvalidAnswerError -> GovernancePollError
forall a b. (a -> b) -> a -> b
$
          GovernancePollInvalidAnswerError
            { Word
invalidAnswerReceivedAnswer :: Word
invalidAnswerReceivedAnswer :: Word
invalidAnswerReceivedAnswer
            , [(Word, Text)]
invalidAnswerAcceptableAnswers :: [(Word, Text)]
invalidAnswerAcceptableAnswers :: [(Word, Text)]
invalidAnswerAcceptableAnswers
            }

  extraKeyWitnesses :: TxExtraKeyWitnesses era
-> Either GovernancePollError [Hash PaymentKey]
extraKeyWitnesses = \case
    TxExtraKeyWitnesses AlonzoEraOnwards era
_era [Hash PaymentKey]
witnesses ->
      [Hash PaymentKey] -> Either GovernancePollError [Hash PaymentKey]
forall a. a -> Either GovernancePollError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Hash PaymentKey]
witnesses
    TxExtraKeyWitnesses era
TxExtraKeyWitnessesNone ->
      GovernancePollError -> Either GovernancePollError [Hash PaymentKey]
forall a b. a -> Either a b
Left GovernancePollError
ErrGovernancePollUnauthenticated

-- ----------------------------------------------------------------------------
-- Decoder Helpers
--

withNestedMap
  :: Text
  -> Word64
  -> TxMetadata
  -> ([(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a)
  -> Either DecoderError a
withNestedMap :: forall a.
Text
-> Word64
-> TxMetadata
-> ([(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a)
-> Either DecoderError a
withNestedMap Text
lbl Word64
topLevelLabel (TxMetadata Map Word64 TxMetadataValue
m) [(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a
continueWith =
  case Word64 -> Map Word64 TxMetadataValue -> Maybe TxMetadataValue
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word64
topLevelLabel Map Word64 TxMetadataValue
m of
    Just (TxMetaMap [(TxMetadataValue, TxMetadataValue)]
values) ->
      [(TxMetadataValue, TxMetadataValue)] -> Either DecoderError a
continueWith [(TxMetadataValue, TxMetadataValue)]
values
    Maybe TxMetadataValue
Nothing ->
      DecoderError -> Either DecoderError a
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError a)
-> DecoderError -> Either DecoderError a
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> DecoderError
DecoderErrorCustom
          Text
lbl
          (Text
"missing expected label: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word64 -> Text
forall a. Show a => a -> Text
textShow Word64
topLevelLabel)
    Just TxMetadataValue
_ ->
      DecoderError -> Either DecoderError a
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError a)
-> DecoderError -> Either DecoderError a
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> DecoderError
DecoderErrorCustom
          Text
lbl
          Text
"malformed data; expected a key:value map"

expectTextChunks :: Text -> TxMetadataValue -> Either DecoderError Text
expectTextChunks :: Text -> TxMetadataValue -> Either DecoderError Text
expectTextChunks Text
lbl TxMetadataValue
value =
  case TxMetadataValue
value of
    TxMetaList [TxMetadataValue]
xs ->
      (Builder -> TxMetadataValue -> Maybe Builder)
-> Builder -> [TxMetadataValue] -> Maybe Builder
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Builder -> TxMetadataValue -> Maybe Builder
expectText Builder
forall a. Monoid a => a
mempty [TxMetadataValue]
xs
        Maybe Builder
-> (Maybe Builder -> Either DecoderError Text)
-> Either DecoderError Text
forall a b. a -> (a -> b) -> b
& Either DecoderError Text
-> (Builder -> Either DecoderError Text)
-> Maybe Builder
-> Either DecoderError Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          (DecoderError -> Either DecoderError Text
forall a b. a -> Either a b
Left (Text -> Text -> DecoderError
malformedField (Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[i]") Text
"Text"))
          (Text -> Either DecoderError Text
forall a b. b -> Either a b
Right (Text -> Either DecoderError Text)
-> (Builder -> Text) -> Builder -> Either DecoderError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
Text.Lazy.toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
Text.Builder.toLazyText)
    TxMetadataValue
_ ->
      DecoderError -> Either DecoderError Text
forall a b. a -> Either a b
Left (Text -> Text -> DecoderError
malformedField Text
lbl Text
"List<Text>")
 where
  expectText :: Builder -> TxMetadataValue -> Maybe Builder
expectText Builder
acc TxMetadataValue
x =
    case TxMetadataValue
x of
      TxMetaText Text
txt -> Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.fromText Text
txt)
      TxMetadataValue
_ -> Maybe Builder
forall a. Maybe a
Nothing

expectWord :: Text -> Integer -> Either DecoderError Word
expectWord :: Text -> Integer -> Either DecoderError Word
expectWord Text
lbl Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Word -> Integer
forall a. Integral a => a -> Integer
toInteger (Word
forall a. Bounded a => a
maxBound :: Word) =
      Word -> Either DecoderError Word
forall a. a -> Either DecoderError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Word
forall a. Num a => Integer -> a
fromInteger Integer
n)
  | Bool
otherwise =
      DecoderError -> Either DecoderError Word
forall a b. a -> Either a b
Left (DecoderError -> Either DecoderError Word)
-> DecoderError -> Either DecoderError Word
forall a b. (a -> b) -> a -> b
$
        Text -> Text -> DecoderError
DecoderErrorCustom
          Text
lbl
          Text
"invalid number; must be non-negative word"

missingField :: Text -> DecoderError
missingField :: Text -> DecoderError
missingField Text
lbl =
  Text -> Text -> DecoderError
DecoderErrorCustom
    Text
lbl
    Text
"missing mandatory field"

malformedField :: Text -> Text -> DecoderError
malformedField :: Text -> Text -> DecoderError
malformedField Text
lbl Text
hint =
  Text -> Text -> DecoderError
DecoderErrorCustom
    Text
lbl
    (Text
"malformed field; must be: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hint)

fieldPath
  :: Text
  -- ^ Label
  -> TxMetadataValue
  -- ^ Field key
  -> Text
fieldPath :: Text -> TxMetadataValue -> Text
fieldPath Text
lbl (TxMetaNumber Integer
i) = Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Integer -> Text
forall a. Show a => a -> Text
textShow Integer
i
fieldPath Text
lbl (TxMetaText Text
t) = Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
fieldPath Text
lbl TxMetadataValue
_ = Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".?"