-
Notifications
You must be signed in to change notification settings - Fork 15
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
create-poll, answer-poll, verify-poll: move to 'babbage governance' b…
…lock
- Loading branch information
Showing
10 changed files
with
286 additions
and
191 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
37 changes: 37 additions & 0 deletions
37
cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Poll.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,37 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
|
|
||
| module Cardano.CLI.EraBased.Commands.Governance.Poll | ||
| ( GovernancePollCmds(..) , renderGovernancePollCmds) where | ||
|
|
||
| import Cardano.Api | ||
| import Cardano.Api.Shelley | ||
|
|
||
| import Data.Text (Text) | ||
|
|
||
| data GovernancePollCmds era | ||
| = GovernanceCreatePoll -- ^ Create a SPO poll | ||
| (BabbageEraOnwards era) {- TODO smelc, use BabbageEraOnly here instead -} | ||
| Text -- ^ Prompt | ||
| [Text] -- ^ Choices | ||
| (Maybe Word) -- ^ Nonce | ||
| (File GovernancePoll Out) | ||
| | GovernanceAnswerPoll -- ^ Answer a SPO poll | ||
| (BabbageEraOnwards era) {- TODO smelc, use BabbageEraOnly here instead -} | ||
| (File GovernancePoll In) -- ^ Poll file | ||
| (Maybe Word) -- ^ Answer index | ||
| (Maybe (File () Out)) -- ^ Tx file | ||
| | GovernanceVerifyPoll -- ^ Verify answer to a given SPO poll | ||
| (BabbageEraOnwards era) {- TODO smelc, use BabbageEraOnly here instead -} | ||
| (File GovernancePoll In) -- Poll file | ||
| (File (Tx ()) In) -- Tx file | ||
| (Maybe (File () Out)) -- Tx file | ||
|
|
||
|
|
||
| renderGovernancePollCmds :: () | ||
| => GovernancePollCmds era | ||
| -> Text | ||
| renderGovernancePollCmds = \case | ||
| GovernanceCreatePoll {} -> "governance create-poll" | ||
| GovernanceAnswerPoll {} -> "governance answer-poll" | ||
| GovernanceVerifyPoll {} -> "governance verify-poll" |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
64 changes: 64 additions & 0 deletions
64
cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Poll.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,64 @@ | ||
| module Cardano.CLI.EraBased.Options.Governance.Poll | ||
| ( pGovernancePollCmds, | ||
| ) | ||
| where | ||
|
|
||
| import Cardano.Api | ||
|
|
||
| import Cardano.CLI.EraBased.Commands.Governance.Poll (GovernancePollCmds (..)) | ||
| import Cardano.CLI.EraBased.Options.Common | ||
|
|
||
| import Data.Foldable | ||
| import Options.Applicative hiding (help, str) | ||
| import qualified Options.Applicative as Opt | ||
|
|
||
| pGovernancePollCmds :: | ||
| () => | ||
| CardanoEra era -> | ||
| Maybe (Parser (GovernancePollCmds era)) | ||
| pGovernancePollCmds era = | ||
| asum | ||
| [ subParser "create-poll" | ||
| <$> ( Opt.info | ||
| <$> pGovernanceCreatePoll era | ||
| <*> pure (Opt.progDesc "Create an SPO poll") | ||
| ), | ||
| subParser "answer-poll" | ||
| <$> ( Opt.info | ||
| <$> pGovernanceAnswerPoll era | ||
| <*> pure (Opt.progDesc "Answer an SPO poll") | ||
| ), | ||
| subParser "verify-poll" | ||
| <$> ( Opt.info | ||
| <$> pGovernanceVerifyPoll era | ||
| <*> pure (Opt.progDesc "Verify an answer to a given SPO poll") | ||
| ) | ||
| ] | ||
|
|
||
| pGovernanceCreatePoll :: CardanoEra era -> Maybe (Parser (GovernancePollCmds era)) | ||
| pGovernanceCreatePoll era = do | ||
| w <- maybeEonInEra era | ||
| pure $ | ||
| GovernanceCreatePoll w | ||
| <$> pPollQuestion | ||
| <*> some pPollAnswer | ||
| <*> optional pPollNonce | ||
| <*> pOutputFile | ||
|
|
||
| pGovernanceAnswerPoll :: CardanoEra era -> Maybe (Parser (GovernancePollCmds era)) | ||
| pGovernanceAnswerPoll era = do | ||
| w <- maybeEonInEra era | ||
| pure $ | ||
| GovernanceAnswerPoll w | ||
| <$> pPollFile | ||
| <*> optional pPollAnswerIndex | ||
| <*> optional pOutputFile | ||
|
|
||
| pGovernanceVerifyPoll :: CardanoEra era -> Maybe (Parser (GovernancePollCmds era)) | ||
| pGovernanceVerifyPoll era = do | ||
| w <- maybeEonInEra era | ||
| pure $ | ||
| GovernanceVerifyPoll w | ||
| <$> pPollFile | ||
| <*> pPollTxFile | ||
| <*> optional pOutputFile |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
170 changes: 170 additions & 0 deletions
170
cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Poll.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,170 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
| {-# LANGUAGE NamedFieldPuns #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
|
|
||
| module Cardano.CLI.EraBased.Run.Governance.Poll | ||
| ( runGovernancePollCmds | ||
| ) where | ||
|
|
||
| import Cardano.Api | ||
| import Cardano.Api.Shelley | ||
| import qualified Cardano.Api.Shelley as Api | ||
|
|
||
| import Cardano.CLI.EraBased.Commands.Governance.Poll | ||
| import Cardano.CLI.Read | ||
| import Cardano.CLI.Types.Errors.GovernanceCmdError | ||
|
|
||
| import Control.Monad | ||
| import Control.Monad.IO.Class | ||
| import Control.Monad.Trans.Class (lift) | ||
| import Control.Monad.Trans.Except (ExceptT) | ||
| import Control.Monad.Trans.Except.Extra | ||
| import qualified Data.ByteString.Char8 as BSC | ||
| import Data.Function ((&)) | ||
| import Data.String (fromString) | ||
| import Data.Text (Text) | ||
| import qualified Data.Text as Text | ||
| import qualified Data.Text.Encoding as Text | ||
| import qualified Data.Text.IO as Text | ||
| import qualified Data.Text.Read as Text | ||
| import qualified System.IO as IO | ||
| import System.IO (stderr, stdin, stdout) | ||
|
|
||
|
|
||
| runGovernancePollCmds :: GovernancePollCmds era -> ExceptT GovernanceCmdError IO () | ||
| runGovernancePollCmds = \case | ||
| GovernanceCreatePoll w prompt choices nonce out -> | ||
| runGovernanceCreatePoll w prompt choices nonce out | ||
| GovernanceAnswerPoll w poll ix mOutFile -> | ||
| runGovernanceAnswerPoll w poll ix mOutFile | ||
| GovernanceVerifyPoll w poll metadata mOutFile -> | ||
| runGovernanceVerifyPoll w poll metadata mOutFile | ||
|
|
||
| runGovernanceCreatePoll | ||
| :: BabbageEraOnwards era | ||
| -> Text | ||
| -> [Text] | ||
| -> Maybe Word | ||
| -> File GovernancePoll Out | ||
| -> ExceptT GovernanceCmdError IO () | ||
| runGovernanceCreatePoll _w govPollQuestion govPollAnswers govPollNonce out = do | ||
| let poll = GovernancePoll{ govPollQuestion, govPollAnswers, govPollNonce } | ||
|
|
||
| let description = fromString $ "An on-chain poll for SPOs: " <> Text.unpack govPollQuestion | ||
| firstExceptT GovernanceCmdTextEnvWriteError . newExceptT $ | ||
| writeFileTextEnvelope out (Just description) poll | ||
|
|
||
| let metadata = asTxMetadata poll | ||
| & metadataToJson TxMetadataJsonDetailedSchema | ||
|
|
||
| let outPath = unFile out & Text.encodeUtf8 . Text.pack | ||
|
|
||
| liftIO $ do | ||
| BSC.hPutStrLn stderr $ mconcat | ||
| [ "Poll created successfully.\n" | ||
| , "Please submit a transaction using the resulting metadata.\n" | ||
| ] | ||
| BSC.hPutStrLn stdout (prettyPrintJSON metadata) | ||
| BSC.hPutStrLn stderr $ mconcat | ||
| [ "\n" | ||
| , "Hint (1): Use '--json-metadata-detailed-schema' and '--metadata-json-file' " | ||
| , "from the build or build-raw commands.\n" | ||
| , "Hint (2): You can redirect the standard output of this command to a JSON " | ||
| , "file to capture metadata.\n\n" | ||
| , "Note: A serialized version of the poll suitable for sharing with " | ||
| , "participants has been generated at '" <> outPath <> "'." | ||
| ] | ||
|
|
||
| runGovernanceAnswerPoll | ||
| :: BabbageEraOnwards era | ||
| -> File GovernancePoll In | ||
| -> Maybe Word -- ^ Answer index | ||
| -> Maybe (File () Out) -- ^ Output file | ||
| -> ExceptT GovernanceCmdError IO () | ||
| runGovernanceAnswerPoll _ pollFile maybeChoice mOutFile = do | ||
| poll <- firstExceptT GovernanceCmdTextEnvReadError . newExceptT $ | ||
| readFileTextEnvelope AsGovernancePoll pollFile | ||
|
|
||
| choice <- case maybeChoice of | ||
| Nothing -> do | ||
| askInteractively poll | ||
| Just ix -> do | ||
| validateChoice poll ix | ||
| liftIO $ BSC.hPutStrLn stderr $ Text.encodeUtf8 $ Text.intercalate "\n" | ||
| [ govPollQuestion poll | ||
| , "→ " <> (govPollAnswers poll !! fromIntegral ix) | ||
| , "" | ||
| ] | ||
| pure ix | ||
|
|
||
| let pollAnswer = GovernancePollAnswer | ||
| { govAnsPoll = hashGovernancePoll poll | ||
| , govAnsChoice = choice | ||
| } | ||
| let metadata = | ||
| metadataToJson TxMetadataJsonDetailedSchema (asTxMetadata pollAnswer) | ||
|
|
||
| liftIO $ BSC.hPutStrLn stderr $ mconcat | ||
| [ "Poll answer created successfully.\n" | ||
| , "Please submit a transaction using the resulting metadata.\n" | ||
| , "To be valid, the transaction must also be signed using a valid key\n" | ||
| , "identifying your stake pool (e.g. your cold key).\n" | ||
| ] | ||
|
|
||
| lift (writeByteStringOutput mOutFile (prettyPrintJSON metadata)) | ||
| & onLeft (left . GovernanceCmdWriteFileError) | ||
|
|
||
| liftIO $ BSC.hPutStrLn stderr $ mconcat | ||
| [ "\n" | ||
| , "Hint (1): Use '--json-metadata-detailed-schema' and '--metadata-json-file' " | ||
| , "from the build or build-raw commands.\n" | ||
| , "Hint (2): You can redirect the standard output of this command to a JSON " | ||
| , "file to capture metadata." | ||
| ] | ||
| where | ||
| validateChoice :: GovernancePoll -> Word -> ExceptT GovernanceCmdError IO () | ||
| validateChoice GovernancePoll{govPollAnswers} ix = do | ||
| let maxAnswerIndex = length govPollAnswers - 1 | ||
| when (fromIntegral ix > maxAnswerIndex) $ left $ | ||
| GovernanceCmdPollOutOfBoundAnswer maxAnswerIndex | ||
|
|
||
| askInteractively :: GovernancePoll -> ExceptT GovernanceCmdError IO Word | ||
| askInteractively poll@GovernancePoll{govPollQuestion, govPollAnswers} = do | ||
| liftIO $ BSC.hPutStrLn stderr $ Text.encodeUtf8 $ Text.intercalate "\n" | ||
| ( govPollQuestion | ||
| : [ "[" <> textShow ix <> "] " <> answer | ||
| | (ix :: Int, answer) <- zip [0..] govPollAnswers | ||
| ] | ||
| ) | ||
| liftIO $ BSC.hPutStrLn stderr "" | ||
| liftIO $ BSC.hPutStr stderr "Please indicate an answer (by index): " | ||
| txt <- liftIO $ Text.hGetLine stdin | ||
| liftIO $ BSC.hPutStrLn stderr "" | ||
| case Text.decimal txt of | ||
| Right (choice, rest) | Text.null rest -> | ||
| choice <$ validateChoice poll choice | ||
| _ -> | ||
| left GovernanceCmdPollInvalidChoice | ||
|
|
||
| runGovernanceVerifyPoll | ||
| :: BabbageEraOnwards era | ||
| -> File GovernancePoll In | ||
| -> File (Api.Tx ()) In | ||
| -> Maybe (File () Out) -- ^ Output file | ||
| -> ExceptT GovernanceCmdError IO () | ||
| runGovernanceVerifyPoll _ pollFile txFile mOutFile = do | ||
| poll <- firstExceptT GovernanceCmdTextEnvReadError . newExceptT $ | ||
| readFileTextEnvelope AsGovernancePoll pollFile | ||
|
|
||
| txFileOrPipe <- liftIO $ fileOrPipe (unFile txFile) | ||
| tx <- firstExceptT GovernanceCmdCddlError . newExceptT $ | ||
| readFileTx txFileOrPipe | ||
|
|
||
| signatories <- firstExceptT GovernanceCmdVerifyPollError . newExceptT $ pure $ | ||
| verifyPollAnswer poll tx | ||
|
|
||
| liftIO $ IO.hPutStrLn stderr $ "Found valid poll answer with " <> show (length signatories) <> " signatories" | ||
|
|
||
| lift (writeByteStringOutput mOutFile (prettyPrintJSON signatories)) | ||
| & onLeft (left . GovernanceCmdWriteFileError) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.