{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.Legacy.Run.Governance
  ( runLegacyGovernanceCmds
  )
where

import           Cardano.Api
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley

import qualified Cardano.CLI.EraBased.Commands.Governance.Poll as Cmd
import           Cardano.CLI.EraBased.Run.Governance
import           Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
                   (runGovernanceGenesisKeyDelegationCertificate)
import           Cardano.CLI.EraBased.Run.Governance.Poll
import           Cardano.CLI.Legacy.Commands.Governance
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.GovernanceCmdError

import           Control.Monad
import           Data.Aeson (eitherDecode)
import qualified Data.ByteString.Lazy as LB
import           Data.Function ((&))
import           Data.Text (Text)
import qualified Data.Text as Text

runLegacyGovernanceCmds :: LegacyGovernanceCmds -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCmds :: LegacyGovernanceCmds -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCmds = \case
  GovernanceCreateMirCertificateStakeAddressesCmd EraInEon ShelleyToBabbageEra
anyEra MIRPot
mirpot [StakeAddress]
vKeys [Coin]
rewards File () 'Out
out ->
    EraInEon ShelleyToBabbageEra
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceMIRCertificatePayStakeAddrs EraInEon ShelleyToBabbageEra
anyEra MIRPot
mirpot [StakeAddress]
vKeys [Coin]
rewards File () 'Out
out
  GovernanceCreateMirCertificateTransferToTreasuryCmd EraInEon ShelleyToBabbageEra
anyEra Coin
amt File () 'Out
out -> do
    EraInEon ShelleyToBabbageEra
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd EraInEon ShelleyToBabbageEra
anyEra Coin
amt File () 'Out
out
  GovernanceCreateMirCertificateTransferToReservesCmd EraInEon ShelleyToBabbageEra
anyEra Coin
amt File () 'Out
out -> do
    EraInEon ShelleyToBabbageEra
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreateMirCertificateTransferToReservesCmd EraInEon ShelleyToBabbageEra
anyEra Coin
amt File () 'Out
out
  GovernanceGenesisKeyDelegationCertificate (EraInEon ShelleyToBabbageEra era
sbe) VerificationKeyOrHashOrFile GenesisKey
genVk VerificationKeyOrHashOrFile GenesisDelegateKey
genDelegVk VerificationKeyOrHashOrFile VrfKey
vrfVk File () 'Out
out ->
    ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> ExceptT GovernanceCmdError IO ()
forall era.
ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
-> File () 'Out
-> ExceptT GovernanceCmdError IO ()
runGovernanceGenesisKeyDelegationCertificate ShelleyToBabbageEra era
sbe VerificationKeyOrHashOrFile GenesisKey
genVk VerificationKeyOrHashOrFile GenesisDelegateKey
genDelegVk VerificationKeyOrHashOrFile VrfKey
vrfVk File () 'Out
out
  GovernanceUpdateProposal File () 'Out
out EpochNo
eNo [VerificationKeyFile 'In]
genVKeys ProtocolParametersUpdate
ppUp Maybe FilePath
mCostModelFp ->
    File () 'Out
-> EpochNo
-> [VerificationKeyFile 'In]
-> ProtocolParametersUpdate
-> Maybe FilePath
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceUpdateProposal File () 'Out
out EpochNo
eNo [VerificationKeyFile 'In]
genVKeys ProtocolParametersUpdate
ppUp Maybe FilePath
mCostModelFp
  GovernanceCreatePoll Text
prompt [Text]
choices Maybe Word
nonce File GovernancePoll 'Out
out ->
    Text
-> [Text]
-> Maybe Word
-> File GovernancePoll 'Out
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreatePoll Text
prompt [Text]
choices Maybe Word
nonce File GovernancePoll 'Out
out
  GovernanceAnswerPoll File GovernancePoll 'In
poll Maybe Word
ix Maybe (File () 'Out)
mOutFile ->
    File GovernancePoll 'In
-> Maybe Word
-> Maybe (File () 'Out)
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceAnswerPoll File GovernancePoll 'In
poll Maybe Word
ix Maybe (File () 'Out)
mOutFile
  GovernanceVerifyPoll File GovernancePoll 'In
poll File (Tx ()) 'In
metadata Maybe (File () 'Out)
mOutFile ->
    File GovernancePoll 'In
-> File (Tx ()) 'In
-> Maybe (File () 'Out)
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceVerifyPoll File GovernancePoll 'In
poll File (Tx ()) 'In
metadata Maybe (File () 'Out)
mOutFile

runLegacyGovernanceCreatePoll
  :: ()
  => Text
  -> [Text]
  -> Maybe Word
  -> File GovernancePoll Out
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreatePoll :: Text
-> [Text]
-> Maybe Word
-> File GovernancePoll 'Out
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreatePoll Text
prompt [Text]
choices Maybe Word
nonce File GovernancePoll 'Out
outFile =
  GovernanceCreatePollCmdArgs BabbageEra
-> ExceptT GovernanceCmdError IO ()
forall era.
GovernanceCreatePollCmdArgs era -> ExceptT GovernanceCmdError IO ()
runGovernanceCreatePollCmd
    Cmd.GovernanceCreatePollCmdArgs
      { eon :: BabbageEraOnwards BabbageEra
eon = BabbageEraOnwards BabbageEra
BabbageEraOnwardsBabbage
      , Text
prompt :: Text
prompt :: Text
prompt
      , [Text]
choices :: [Text]
choices :: [Text]
choices
      , Maybe Word
nonce :: Maybe Word
nonce :: Maybe Word
nonce
      , File GovernancePoll 'Out
outFile :: File GovernancePoll 'Out
outFile :: File GovernancePoll 'Out
outFile
      }

runLegacyGovernanceAnswerPoll
  :: ()
  => File GovernancePoll In
  -> Maybe Word
  -> Maybe (File () Out)
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceAnswerPoll :: File GovernancePoll 'In
-> Maybe Word
-> Maybe (File () 'Out)
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceAnswerPoll File GovernancePoll 'In
pollFile Maybe Word
answerIndex Maybe (File () 'Out)
mOutFile =
  GovernanceAnswerPollCmdArgs BabbageEra
-> ExceptT GovernanceCmdError IO ()
forall era.
GovernanceAnswerPollCmdArgs era -> ExceptT GovernanceCmdError IO ()
runGovernanceAnswerPollCmd
    Cmd.GovernanceAnswerPollCmdArgs
      { eon :: BabbageEraOnwards BabbageEra
eon = BabbageEraOnwards BabbageEra
BabbageEraOnwardsBabbage
      , File GovernancePoll 'In
pollFile :: File GovernancePoll 'In
pollFile :: File GovernancePoll 'In
pollFile
      , Maybe Word
answerIndex :: Maybe Word
answerIndex :: Maybe Word
answerIndex
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile
      }

runLegacyGovernanceVerifyPoll
  :: ()
  => File GovernancePoll In
  -> File (Tx ()) In
  -> Maybe (File () Out)
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceVerifyPoll :: File GovernancePoll 'In
-> File (Tx ()) 'In
-> Maybe (File () 'Out)
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceVerifyPoll File GovernancePoll 'In
pollFile File (Tx ()) 'In
txFile Maybe (File () 'Out)
mOutFile =
  GovernanceVerifyPollCmdArgs BabbageEra
-> ExceptT GovernanceCmdError IO ()
forall era.
GovernanceVerifyPollCmdArgs era -> ExceptT GovernanceCmdError IO ()
runGovernanceVerifyPollCmd
    Cmd.GovernanceVerifyPollCmdArgs
      { eon :: BabbageEraOnwards BabbageEra
eon = BabbageEraOnwards BabbageEra
BabbageEraOnwardsBabbage
      , File GovernancePoll 'In
pollFile :: File GovernancePoll 'In
pollFile :: File GovernancePoll 'In
pollFile
      , File (Tx ()) 'In
txFile :: File (Tx ()) 'In
txFile :: File (Tx ()) 'In
txFile
      , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile
      }

runLegacyGovernanceMIRCertificatePayStakeAddrs
  :: EraInEon ShelleyToBabbageEra
  -> L.MIRPot
  -> [StakeAddress]
  -- ^ Stake addresses
  -> [Lovelace]
  -- ^ Corresponding reward amounts (same length)
  -> File () Out
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceMIRCertificatePayStakeAddrs :: EraInEon ShelleyToBabbageEra
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceMIRCertificatePayStakeAddrs (EraInEon ShelleyToBabbageEra era
w) =
  ShelleyToBabbageEra era
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> ExceptT GovernanceCmdError IO ()
forall era.
ShelleyToBabbageEra era
-> MIRPot
-> [StakeAddress]
-> [Coin]
-> File () 'Out
-> ExceptT GovernanceCmdError IO ()
runGovernanceMIRCertificatePayStakeAddrs ShelleyToBabbageEra era
w

runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd
  :: EraInEon ShelleyToBabbageEra
  -> Lovelace
  -> File () Out
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd :: EraInEon ShelleyToBabbageEra
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd (EraInEon ShelleyToBabbageEra era
w) =
  ShelleyToBabbageEra era
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
forall era.
ShelleyToBabbageEra era
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
runGovernanceCreateMirCertificateTransferToTreasuryCmd ShelleyToBabbageEra era
w

runLegacyGovernanceCreateMirCertificateTransferToReservesCmd
  :: EraInEon ShelleyToBabbageEra
  -> Lovelace
  -> File () Out
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreateMirCertificateTransferToReservesCmd :: EraInEon ShelleyToBabbageEra
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceCreateMirCertificateTransferToReservesCmd (EraInEon ShelleyToBabbageEra era
w) =
  ShelleyToBabbageEra era
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
forall era.
ShelleyToBabbageEra era
-> Coin -> File () 'Out -> ExceptT GovernanceCmdError IO ()
runGovernanceCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w

runLegacyGovernanceUpdateProposal
  :: File () Out
  -> EpochNo
  -> [VerificationKeyFile In]
  -- ^ Genesis verification keys
  -> ProtocolParametersUpdate
  -> Maybe FilePath
  -- ^ Cost models file path
  -> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceUpdateProposal :: File () 'Out
-> EpochNo
-> [VerificationKeyFile 'In]
-> ProtocolParametersUpdate
-> Maybe FilePath
-> ExceptT GovernanceCmdError IO ()
runLegacyGovernanceUpdateProposal File () 'Out
upFile EpochNo
eNo [VerificationKeyFile 'In]
genVerKeyFiles ProtocolParametersUpdate
upPprams Maybe FilePath
mCostModelFp = do
  ProtocolParametersUpdate
finalUpPprams <- case Maybe FilePath
mCostModelFp of
    Maybe FilePath
Nothing -> ProtocolParametersUpdate
-> ExceptT GovernanceCmdError IO ProtocolParametersUpdate
forall a. a -> ExceptT GovernanceCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProtocolParametersUpdate
upPprams
    Just FilePath
fp -> do
      ByteString
costModelsBs <- (IOException -> GovernanceCmdError)
-> IO ByteString -> ExceptT GovernanceCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> GovernanceCmdError
GovernanceCmdCostModelReadError (FileError () -> GovernanceCmdError)
-> (IOException -> FileError ())
-> IOException
-> GovernanceCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException -> FileError ()
forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fp) (IO ByteString -> ExceptT GovernanceCmdError IO ByteString)
-> IO ByteString -> ExceptT GovernanceCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LB.readFile FilePath
fp

      CostModels
cModels <-
        Either FilePath CostModels
-> ExceptT GovernanceCmdError IO (Either FilePath CostModels)
forall a. a -> ExceptT GovernanceCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either FilePath CostModels
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
costModelsBs)
          ExceptT GovernanceCmdError IO (Either FilePath CostModels)
-> (ExceptT GovernanceCmdError IO (Either FilePath CostModels)
    -> ExceptT GovernanceCmdError IO CostModels)
-> ExceptT GovernanceCmdError IO CostModels
forall a b. a -> (a -> b) -> b
& (FilePath -> ExceptT GovernanceCmdError IO CostModels)
-> ExceptT GovernanceCmdError IO (Either FilePath CostModels)
-> ExceptT GovernanceCmdError IO CostModels
forall e x (m :: * -> *) a.
Monad m =>
(e -> ExceptT x m a) -> ExceptT x m (Either e a) -> ExceptT x m a
onLeft (GovernanceCmdError -> ExceptT GovernanceCmdError IO CostModels
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (GovernanceCmdError -> ExceptT GovernanceCmdError IO CostModels)
-> (FilePath -> GovernanceCmdError)
-> FilePath
-> ExceptT GovernanceCmdError IO CostModels
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text -> GovernanceCmdError
GovernanceCmdCostModelsJsonDecodeErr FilePath
fp (Text -> GovernanceCmdError)
-> (FilePath -> Text) -> FilePath -> GovernanceCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack)

      let costModels :: Map AnyPlutusScriptVersion CostModel
costModels = CostModels -> Map AnyPlutusScriptVersion CostModel
fromAlonzoCostModels CostModels
cModels

      Bool
-> ExceptT GovernanceCmdError IO ()
-> ExceptT GovernanceCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Map AnyPlutusScriptVersion CostModel -> Bool
forall a. Map AnyPlutusScriptVersion a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map AnyPlutusScriptVersion CostModel
costModels) (ExceptT GovernanceCmdError IO ()
 -> ExceptT GovernanceCmdError IO ())
-> ExceptT GovernanceCmdError IO ()
-> ExceptT GovernanceCmdError IO ()
forall a b. (a -> b) -> a -> b
$ GovernanceCmdError -> ExceptT GovernanceCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (FilePath -> GovernanceCmdError
GovernanceCmdEmptyCostModel FilePath
fp)

      ProtocolParametersUpdate
-> ExceptT GovernanceCmdError IO ProtocolParametersUpdate
forall a. a -> ExceptT GovernanceCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProtocolParametersUpdate
 -> ExceptT GovernanceCmdError IO ProtocolParametersUpdate)
-> ProtocolParametersUpdate
-> ExceptT GovernanceCmdError IO ProtocolParametersUpdate
forall a b. (a -> b) -> a -> b
$ ProtocolParametersUpdate
upPprams{protocolUpdateCostModels = costModels}

  Bool
-> ExceptT GovernanceCmdError IO ()
-> ExceptT GovernanceCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtocolParametersUpdate
finalUpPprams ProtocolParametersUpdate -> ProtocolParametersUpdate -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolParametersUpdate
forall a. Monoid a => a
mempty) (ExceptT GovernanceCmdError IO ()
 -> ExceptT GovernanceCmdError IO ())
-> ExceptT GovernanceCmdError IO ()
-> ExceptT GovernanceCmdError IO ()
forall a b. (a -> b) -> a -> b
$ GovernanceCmdError -> ExceptT GovernanceCmdError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left GovernanceCmdError
GovernanceCmdEmptyUpdateProposalError

  [VerificationKey GenesisKey]
genVKeys <-
    [ExceptT GovernanceCmdError IO (VerificationKey GenesisKey)]
-> ExceptT GovernanceCmdError IO [VerificationKey GenesisKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [ (FileError TextEnvelopeError -> GovernanceCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
-> ExceptT GovernanceCmdError IO (VerificationKey GenesisKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GovernanceCmdError
GovernanceCmdTextEnvReadError (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
 -> ExceptT GovernanceCmdError IO (VerificationKey GenesisKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey GenesisKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT GovernanceCmdError IO (VerificationKey GenesisKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
 -> ExceptT GovernanceCmdError IO (VerificationKey GenesisKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT GovernanceCmdError IO (VerificationKey GenesisKey)
forall a b. (a -> b) -> a -> b
$
          AsType (VerificationKey GenesisKey)
-> VerificationKeyFile 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey) VerificationKeyFile 'In
vkeyFile
      | VerificationKeyFile 'In
vkeyFile <- [VerificationKeyFile 'In]
genVerKeyFiles
      ]
  let genKeyHashes :: [Hash GenesisKey]
genKeyHashes = (VerificationKey GenesisKey -> Hash GenesisKey)
-> [VerificationKey GenesisKey] -> [Hash GenesisKey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerificationKey GenesisKey -> Hash GenesisKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash [VerificationKey GenesisKey]
genVKeys
      upProp :: UpdateProposal
upProp = ProtocolParametersUpdate
-> [Hash GenesisKey] -> EpochNo -> UpdateProposal
makeShelleyUpdateProposal ProtocolParametersUpdate
finalUpPprams [Hash GenesisKey]
genKeyHashes EpochNo
eNo

  (FileError () -> GovernanceCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GovernanceCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceCmdError
GovernanceCmdTextEnvWriteError (ExceptT (FileError ()) IO () -> ExceptT GovernanceCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GovernanceCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GovernanceCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    File () 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File () 'Out
upFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
      Maybe TextEnvelopeDescr -> UpdateProposal -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing UpdateProposal
upProp