{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraBased.Governance.DRep.Run
  ( runGovernanceDRepCmds
  , runGovernanceDRepKeyGenCmd
  )
where

import Cardano.Api
import Cardano.Api.Experimental qualified as Exp
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Governance.DRep.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Hash.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Hash.Internal.Common
  ( allSchemes
  , carryHashChecks
  , getByteStringFromURL
  )
import Cardano.CLI.EraIndependent.Key.Run qualified as Key
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.GovernanceCmdError
import Cardano.CLI.Type.Key

import Control.Monad (void)
import Data.Function
import Data.Text.Encoding qualified as Text
import Vary qualified

runGovernanceDRepCmds
  :: ()
  => Cmd.GovernanceDRepCmds era
  -> CIO e ()
runGovernanceDRepCmds :: forall era e. GovernanceDRepCmds era -> CIO e ()
runGovernanceDRepCmds = \case
  Cmd.GovernanceDRepKeyGenCmd GovernanceDRepKeyGenCmdArgs era
args ->
    RIO e (VerificationKey DRepKey, SigningKey DRepKey) -> RIO e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO e (VerificationKey DRepKey, SigningKey DRepKey) -> RIO e ())
-> RIO e (VerificationKey DRepKey, SigningKey DRepKey) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      GovernanceDRepKeyGenCmdArgs era
-> CIO e (VerificationKey DRepKey, SigningKey DRepKey)
forall era e.
GovernanceDRepKeyGenCmdArgs era
-> CIO e (VerificationKey DRepKey, SigningKey DRepKey)
runGovernanceDRepKeyGenCmd GovernanceDRepKeyGenCmdArgs era
args
  Cmd.GovernanceDRepIdCmd GovernanceDRepIdCmdArgs era
args ->
    GovernanceDRepIdCmdArgs era -> CIO e ()
forall era e. GovernanceDRepIdCmdArgs era -> CIO e ()
runGovernanceDRepIdCmd GovernanceDRepIdCmdArgs era
args
  Cmd.GovernanceDRepRegistrationCertificateCmd GovernanceDRepRegistrationCertificateCmdArgs era
args ->
    GovernanceDRepRegistrationCertificateCmdArgs era -> CIO e ()
forall era e.
GovernanceDRepRegistrationCertificateCmdArgs era -> CIO e ()
runGovernanceDRepRegistrationCertificateCmd GovernanceDRepRegistrationCertificateCmdArgs era
args
  Cmd.GovernanceDRepRetirementCertificateCmd GovernanceDRepRetirementCertificateCmdArgs era
args ->
    GovernanceDRepRetirementCertificateCmdArgs era -> CIO e ()
forall era e.
GovernanceDRepRetirementCertificateCmdArgs era -> CIO e ()
runGovernanceDRepRetirementCertificateCmd GovernanceDRepRetirementCertificateCmdArgs era
args
  Cmd.GovernanceDRepUpdateCertificateCmd GovernanceDRepUpdateCertificateCmdArgs era
args ->
    GovernanceDRepUpdateCertificateCmdArgs era -> CIO e ()
forall era e.
GovernanceDRepUpdateCertificateCmdArgs era -> CIO e ()
runGovernanceDRepUpdateCertificateCmd GovernanceDRepUpdateCertificateCmdArgs era
args
  Cmd.GovernanceDRepMetadataHashCmd GovernanceDRepMetadataHashCmdArgs era
args ->
    GovernanceDRepMetadataHashCmdArgs era -> CIO e ()
forall era e. GovernanceDRepMetadataHashCmdArgs era -> CIO e ()
runGovernanceDRepMetadataHashCmd GovernanceDRepMetadataHashCmdArgs era
args

runGovernanceDRepKeyGenCmd
  :: ()
  => Cmd.GovernanceDRepKeyGenCmdArgs era
  -> CIO e (VerificationKey DRepKey, SigningKey DRepKey)
runGovernanceDRepKeyGenCmd :: forall era e.
GovernanceDRepKeyGenCmdArgs era
-> CIO e (VerificationKey DRepKey, SigningKey DRepKey)
runGovernanceDRepKeyGenCmd
  Cmd.GovernanceDRepKeyGenCmdArgs
    { File (VerificationKey ()) 'Out
vkeyFile :: File (VerificationKey ()) 'Out
vkeyFile :: forall era.
GovernanceDRepKeyGenCmdArgs era -> File (VerificationKey ()) 'Out
vkeyFile
    , File (SigningKey ()) 'Out
skeyFile :: File (SigningKey ()) 'Out
skeyFile :: forall era.
GovernanceDRepKeyGenCmdArgs era -> File (SigningKey ()) 'Out
skeyFile
    } = do
    (VerificationKey DRepKey
vkey, SigningKey DRepKey
skey) <- AsType DRepKey
-> RIO e (VerificationKey DRepKey, SigningKey DRepKey)
forall keyrole (m :: * -> *).
(MonadIO m, Key keyrole, HasTypeProxy keyrole) =>
AsType keyrole -> m (VerificationKey keyrole, SigningKey keyrole)
generateKeyPair AsType DRepKey
AsDRepKey
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      File (SigningKey ()) 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File (SigningKey ()) 'Out
skeyFile (Maybe TextEnvelopeDescr -> SigningKey DRepKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.drepSkeyDesc) SigningKey DRepKey
skey)

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      File (VerificationKey ()) 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile File (VerificationKey ()) 'Out
vkeyFile (Maybe TextEnvelopeDescr -> VerificationKey DRepKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.drepVkeyDesc) VerificationKey DRepKey
vkey)

    (VerificationKey DRepKey, SigningKey DRepKey)
-> RIO e (VerificationKey DRepKey, SigningKey DRepKey)
forall a. a -> RIO e a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey DRepKey
vkey, SigningKey DRepKey
skey)

runGovernanceDRepIdCmd
  :: ()
  => Cmd.GovernanceDRepIdCmdArgs era
  -> CIO e ()
runGovernanceDRepIdCmd :: forall era e. GovernanceDRepIdCmdArgs era -> CIO e ()
runGovernanceDRepIdCmd
  Cmd.GovernanceDRepIdCmdArgs
    { VerificationKeyOrHashOrFile DRepKey
vkeySource :: VerificationKeyOrHashOrFile DRepKey
vkeySource :: forall era.
GovernanceDRepIdCmdArgs era -> VerificationKeyOrHashOrFile DRepKey
vkeySource
    , Vary '[FormatBech32, FormatHex, FormatCip129]
idOutputFormat :: Vary '[FormatBech32, FormatHex, FormatCip129]
idOutputFormat :: forall era.
GovernanceDRepIdCmdArgs era
-> Vary '[FormatBech32, FormatHex, FormatCip129]
idOutputFormat
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: forall era. GovernanceDRepIdCmdArgs era -> Maybe (File () 'Out)
mOutFile
    } = do
    Hash DRepKey
drepVerKeyHash <-
      VerificationKeyOrHashOrFile DRepKey -> CIO e (Hash DRepKey)
forall keyrole e.
Key keyrole =>
VerificationKeyOrHashOrFile keyrole -> CIO e (Hash keyrole)
readVerificationKeyOrHashOrTextEnvFile VerificationKeyOrHashOrFile DRepKey
vkeySource

    ByteString
content <-
      ByteString -> RIO e ByteString
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> RIO e ByteString) -> ByteString -> RIO e ByteString
forall a b. (a -> b) -> a -> b
$
        Vary '[FormatBech32, FormatHex, FormatCip129]
idOutputFormat
          Vary '[FormatBech32, FormatHex, FormatCip129]
-> (Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
-> ByteString
forall a b. a -> (a -> b) -> b
& ( (Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
-> Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString
forall a. a -> a
id
                ((Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
 -> Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatBech32, FormatHex, FormatCip129]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatBech32 -> ByteString)
-> (Vary '[FormatHex, FormatCip129] -> ByteString)
-> Vary '[FormatBech32, FormatHex, FormatCip129]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
                  ( \FormatBech32
FormatBech32 ->
                      Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash DRepKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 Hash DRepKey
drepVerKeyHash
                  )
                ((Vary '[FormatHex, FormatCip129] -> ByteString)
 -> Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
-> ((Vary '[] -> ByteString)
    -> Vary '[FormatHex, FormatCip129] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatBech32, FormatHex, FormatCip129]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatHex -> ByteString)
-> (Vary '[FormatCip129] -> ByteString)
-> Vary '[FormatHex, FormatCip129]
-> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
                  ( \FormatHex
FormatHex ->
                      Hash DRepKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex Hash DRepKey
drepVerKeyHash
                  )
                ((Vary '[FormatCip129] -> ByteString)
 -> Vary '[FormatHex, FormatCip129] -> ByteString)
-> ((Vary '[] -> ByteString) -> Vary '[FormatCip129] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatHex, FormatCip129]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FormatCip129 -> ByteString)
-> (Vary '[] -> ByteString) -> Vary '[FormatCip129] -> ByteString
forall a b (l :: [*]).
(a -> b) -> (Vary l -> b) -> Vary (a : l) -> b
Vary.on
                  ( \FormatCip129
FormatCip129 ->
                      let DRepKeyHash KeyHash 'DRepRole
kh = Hash DRepKey
drepVerKeyHash
                          keyCredential :: Credential 'DRepRole
keyCredential = KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj KeyHash 'DRepRole
kh
                       in Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> Text
forall a. Cip129 a => a -> Text
serialiseToBech32Cip129 Credential 'DRepRole
keyCredential
                  )
                ((Vary '[] -> ByteString)
 -> Vary '[FormatBech32, FormatHex, FormatCip129] -> ByteString)
-> (Vary '[] -> ByteString)
-> Vary '[FormatBech32, FormatHex, FormatCip129]
-> ByteString
forall a b. (a -> b) -> a -> b
$ Vary '[] -> ByteString
forall anything. Vary '[] -> anything
Vary.exhaustiveCase
            )

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeByteStringOutput Maybe (File () 'Out)
mOutFile ByteString
content

--------------------------------------------------------------------------------

-- Registration Certificate related

runGovernanceDRepRegistrationCertificateCmd
  :: ()
  => Cmd.GovernanceDRepRegistrationCertificateCmdArgs era
  -> CIO e ()
runGovernanceDRepRegistrationCertificateCmd :: forall era e.
GovernanceDRepRegistrationCertificateCmdArgs era -> CIO e ()
runGovernanceDRepRegistrationCertificateCmd
  Cmd.GovernanceDRepRegistrationCertificateCmdArgs
    { era :: forall era.
GovernanceDRepRegistrationCertificateCmdArgs era -> Era era
era = Era era
w
    , DRepHashSource
drepHashSource :: DRepHashSource
drepHashSource :: forall era.
GovernanceDRepRegistrationCertificateCmdArgs era -> DRepHashSource
drepHashSource
    , Lovelace
deposit :: Lovelace
deposit :: forall era.
GovernanceDRepRegistrationCertificateCmdArgs era -> Lovelace
deposit
    , Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor :: Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor :: forall era.
GovernanceDRepRegistrationCertificateCmdArgs era
-> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceDRepRegistrationCertificateCmdArgs era -> File () 'Out
outFile
    } = Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
w ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    Credential 'DRepRole
drepCred <- DRepHashSource -> CIO e (Credential 'DRepRole)
forall e. DRepHashSource -> CIO e (Credential 'DRepRole)
readDRepCredential DRepHashSource
drepHashSource

    (PotentiallyCheckedAnchor DRepMetadataUrl Anchor -> RIO e ())
-> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (ExceptT HashCheckError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT HashCheckError IO () -> RIO e ())
-> (PotentiallyCheckedAnchor DRepMetadataUrl Anchor
    -> ExceptT HashCheckError IO ())
-> PotentiallyCheckedAnchor DRepMetadataUrl Anchor
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PotentiallyCheckedAnchor DRepMetadataUrl Anchor
-> ExceptT HashCheckError IO ()
forall anchorType.
PotentiallyCheckedAnchor anchorType Anchor
-> ExceptT HashCheckError IO ()
carryHashChecks)
      Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor

    let req :: DRepRegistrationRequirements era
req = ConwayEraOnwards era
-> Credential 'DRepRole
-> Lovelace
-> DRepRegistrationRequirements era
forall era.
ConwayEraOnwards era
-> Credential 'DRepRole
-> Lovelace
-> DRepRegistrationRequirements era
DRepRegistrationRequirements (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
w) Credential 'DRepRole
drepCred Lovelace
deposit
        registrationCert :: Certificate era
registrationCert =
          DRepRegistrationRequirements era -> Maybe Anchor -> Certificate era
forall era.
Typeable era =>
DRepRegistrationRequirements era -> Maybe Anchor -> Certificate era
makeDrepRegistrationCertificate
            DRepRegistrationRequirements era
req
            (PotentiallyCheckedAnchor DRepMetadataUrl Anchor -> Anchor
forall anchorType anchor.
PotentiallyCheckedAnchor anchorType anchor -> anchor
pcaAnchor (PotentiallyCheckedAnchor DRepMetadataUrl Anchor -> Anchor)
-> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
-> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor)
        description :: Maybe TextEnvelopeDescr
description = TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (TextEnvelopeDescr -> Maybe TextEnvelopeDescr)
-> TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ DRepHashSource -> TextEnvelopeDescr -> TextEnvelopeDescr
hashSourceToDescription DRepHashSource
drepHashSource TextEnvelopeDescr
"Registration Certificate"

    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
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
outFile (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr -> Certificate era -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
description Certificate era
registrationCert

runGovernanceDRepRetirementCertificateCmd
  :: ()
  => Cmd.GovernanceDRepRetirementCertificateCmdArgs era
  -> CIO e ()
runGovernanceDRepRetirementCertificateCmd :: forall era e.
GovernanceDRepRetirementCertificateCmdArgs era -> CIO e ()
runGovernanceDRepRetirementCertificateCmd
  Cmd.GovernanceDRepRetirementCertificateCmdArgs
    { era :: forall era.
GovernanceDRepRetirementCertificateCmdArgs era -> Era era
era = Era era
w
    , DRepHashSource
drepHashSource :: DRepHashSource
drepHashSource :: forall era.
GovernanceDRepRetirementCertificateCmdArgs era -> DRepHashSource
drepHashSource
    , Lovelace
deposit :: Lovelace
deposit :: forall era.
GovernanceDRepRetirementCertificateCmdArgs era -> Lovelace
deposit
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceDRepRetirementCertificateCmdArgs era -> File () 'Out
outFile
    } = Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
w ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    Credential 'DRepRole
drepCredential <- DRepHashSource -> CIO e (Credential 'DRepRole)
forall e. DRepHashSource -> CIO e (Credential 'DRepRole)
readDRepCredential DRepHashSource
drepHashSource
    DRepUnregistrationRequirements era -> Certificate era
forall era.
Typeable era =>
DRepUnregistrationRequirements era -> Certificate era
makeDrepUnregistrationCertificate
      (ConwayEraOnwards era
-> Credential 'DRepRole
-> Lovelace
-> DRepUnregistrationRequirements era
forall era.
ConwayEraOnwards era
-> Credential 'DRepRole
-> Lovelace
-> DRepUnregistrationRequirements era
DRepUnregistrationRequirements (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
w) Credential 'DRepRole
drepCredential Lovelace
deposit)
      Certificate era
-> (Certificate era -> IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall a b. a -> (a -> b) -> b
& File () 'Out
-> Maybe TextEnvelopeDescr
-> Certificate era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope
        File () 'Out
outFile
        (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (TextEnvelopeDescr -> Maybe TextEnvelopeDescr)
-> TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ DRepHashSource -> TextEnvelopeDescr -> TextEnvelopeDescr
hashSourceToDescription DRepHashSource
drepHashSource TextEnvelopeDescr
"Retirement Certificate")
      IO (Either (FileError ()) ())
-> (IO (Either (FileError ()) ()) -> RIO e ()) -> RIO e ()
forall a b. a -> (a -> b) -> b
& ExceptT (FileError ()) IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT (FileError ()) IO () -> RIO e ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> RIO e ()
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

runGovernanceDRepUpdateCertificateCmd
  :: ()
  => Cmd.GovernanceDRepUpdateCertificateCmdArgs era
  -> CIO e ()
runGovernanceDRepUpdateCertificateCmd :: forall era e.
GovernanceDRepUpdateCertificateCmdArgs era -> CIO e ()
runGovernanceDRepUpdateCertificateCmd
  Cmd.GovernanceDRepUpdateCertificateCmdArgs
    { era :: forall era. GovernanceDRepUpdateCertificateCmdArgs era -> Era era
era = Era era
w
    , DRepHashSource
drepHashSource :: DRepHashSource
drepHashSource :: forall era.
GovernanceDRepUpdateCertificateCmdArgs era -> DRepHashSource
drepHashSource
    , Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor :: Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor :: forall era.
GovernanceDRepUpdateCertificateCmdArgs era
-> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor
    , File () 'Out
outFile :: File () 'Out
outFile :: forall era.
GovernanceDRepUpdateCertificateCmdArgs era -> File () 'Out
outFile
    } = Era era -> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall era a. Era era -> (EraCommonConstraints era => a) -> a
Exp.obtainCommonConstraints Era era
w ((EraCommonConstraints era => RIO e ()) -> RIO e ())
-> (EraCommonConstraints era => RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
    (PotentiallyCheckedAnchor DRepMetadataUrl Anchor -> RIO e ())
-> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
-> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_
      (ExceptT HashCheckError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT HashCheckError IO () -> RIO e ())
-> (PotentiallyCheckedAnchor DRepMetadataUrl Anchor
    -> ExceptT HashCheckError IO ())
-> PotentiallyCheckedAnchor DRepMetadataUrl Anchor
-> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PotentiallyCheckedAnchor DRepMetadataUrl Anchor
-> ExceptT HashCheckError IO ()
forall anchorType.
PotentiallyCheckedAnchor anchorType Anchor
-> ExceptT HashCheckError IO ()
carryHashChecks)
      Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor
    Credential 'DRepRole
drepCredential <- DRepHashSource -> CIO e (Credential 'DRepRole)
forall e. DRepHashSource -> CIO e (Credential 'DRepRole)
readDRepCredential DRepHashSource
drepHashSource
    let updateCertificate :: Certificate era
updateCertificate =
          DRepUpdateRequirements era -> Maybe Anchor -> Certificate era
forall era.
Typeable era =>
DRepUpdateRequirements era -> Maybe Anchor -> Certificate era
makeDrepUpdateCertificate
            (ConwayEraOnwards era
-> Credential 'DRepRole -> DRepUpdateRequirements era
forall era.
ConwayEraOnwards era
-> Credential 'DRepRole -> DRepUpdateRequirements era
DRepUpdateRequirements (Era era -> ConwayEraOnwards era
forall era. Era era -> ConwayEraOnwards era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
w) Credential 'DRepRole
drepCredential)
            (PotentiallyCheckedAnchor DRepMetadataUrl Anchor -> Anchor
forall anchorType anchor.
PotentiallyCheckedAnchor anchorType anchor -> anchor
pcaAnchor (PotentiallyCheckedAnchor DRepMetadataUrl Anchor -> Anchor)
-> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
-> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (PotentiallyCheckedAnchor DRepMetadataUrl Anchor)
mAnchor)
    ExceptT (FileError ()) IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT (FileError ()) IO () -> RIO e ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> RIO e ()
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 ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      File () 'Out
-> Maybe TextEnvelopeDescr
-> Certificate era
-> IO (Either (FileError ()) ())
forall a content.
HasTextEnvelope a =>
File content 'Out
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope
        File () 'Out
outFile
        (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just (TextEnvelopeDescr -> Maybe TextEnvelopeDescr)
-> TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a b. (a -> b) -> a -> b
$ DRepHashSource -> TextEnvelopeDescr -> TextEnvelopeDescr
hashSourceToDescription DRepHashSource
drepHashSource TextEnvelopeDescr
"Update Certificate")
        Certificate era
updateCertificate

runGovernanceDRepMetadataHashCmd
  :: ()
  => Cmd.GovernanceDRepMetadataHashCmdArgs era
  -> CIO e ()
runGovernanceDRepMetadataHashCmd :: forall era e. GovernanceDRepMetadataHashCmdArgs era -> CIO e ()
runGovernanceDRepMetadataHashCmd
  Cmd.GovernanceDRepMetadataHashCmdArgs
    { DRepMetadataSource
drepMetadataSource :: DRepMetadataSource
drepMetadataSource :: forall era.
GovernanceDRepMetadataHashCmdArgs era -> DRepMetadataSource
drepMetadataSource
    , HashGoal (Hash DRepMetadata)
hashGoal :: HashGoal (Hash DRepMetadata)
hashGoal :: forall era.
GovernanceDRepMetadataHashCmdArgs era
-> HashGoal (Hash DRepMetadata)
hashGoal
    } = do
    ByteString
metadataBytes <- case DRepMetadataSource
drepMetadataSource of
      Cmd.DrepMetadataFileIn DRepMetadataFile 'In
metadataFile ->
        forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ByteString) -> RIO e ByteString)
-> IO (Either (FileError ()) ByteString) -> RIO e ByteString
forall a b. (a -> b) -> a -> b
$ DRepMetadataFile 'In -> IO (Either (FileError ()) ByteString)
forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) ByteString)
readByteStringFile DRepMetadataFile 'In
metadataFile
      Cmd.DrepMetadataURL Url
urlText ->
        ExceptT FetchURLError IO ByteString -> RIO e ByteString
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT FetchURLError IO ByteString -> RIO e ByteString)
-> ExceptT FetchURLError IO ByteString -> RIO e ByteString
forall a b. (a -> b) -> a -> b
$
          SupportedSchemes -> Text -> ExceptT FetchURLError IO ByteString
getByteStringFromURL SupportedSchemes
allSchemes (Text -> ExceptT FetchURLError IO ByteString)
-> Text -> ExceptT FetchURLError IO ByteString
forall a b. (a -> b) -> a -> b
$
            Url -> Text
L.urlToText Url
urlText
    let (DRepMetadata
_metadata, Hash DRepMetadata
metadataHash) = ByteString -> (DRepMetadata, Hash DRepMetadata)
hashDRepMetadata ByteString
metadataBytes
    case HashGoal (Hash DRepMetadata)
hashGoal of
      Cmd.CheckHash Hash DRepMetadata
expectedHash
        | Hash DRepMetadata
metadataHash Hash DRepMetadata -> Hash DRepMetadata -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash DRepMetadata
expectedHash ->
            GovernanceCmdError -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (GovernanceCmdError -> RIO e ()) -> GovernanceCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Hash DRepMetadata -> Hash DRepMetadata -> GovernanceCmdError
GovernanceCmdHashMismatchError Hash DRepMetadata
expectedHash Hash DRepMetadata
metadataHash
        | Bool
otherwise -> IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"Hashes match!"
      Cmd.HashToFile File () 'Out
outFile -> ExceptT GovernanceCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceCmdError IO () -> RIO e ())
-> ExceptT GovernanceCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out)
-> Hash DRepMetadata -> ExceptT GovernanceCmdError IO ()
forall (m :: * -> *) content.
MonadIO m =>
Maybe (File content 'Out)
-> Hash DRepMetadata -> ExceptT GovernanceCmdError m ()
writeOutput (File () 'Out -> Maybe (File () 'Out)
forall a. a -> Maybe a
Just File () 'Out
outFile) Hash DRepMetadata
metadataHash
      HashGoal (Hash DRepMetadata)
Cmd.HashToStdout -> ExceptT GovernanceCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GovernanceCmdError IO () -> RIO e ())
-> ExceptT GovernanceCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Maybe (File Any 'Out)
-> Hash DRepMetadata -> ExceptT GovernanceCmdError IO ()
forall (m :: * -> *) content.
MonadIO m =>
Maybe (File content 'Out)
-> Hash DRepMetadata -> ExceptT GovernanceCmdError m ()
writeOutput Maybe (File Any 'Out)
forall a. Maybe a
Nothing Hash DRepMetadata
metadataHash
   where
    writeOutput
      :: MonadIO m
      => Maybe (File content Out)
      -> Hash DRepMetadata
      -> ExceptT GovernanceCmdError m ()
    writeOutput :: forall (m :: * -> *) content.
MonadIO m =>
Maybe (File content 'Out)
-> Hash DRepMetadata -> ExceptT GovernanceCmdError m ()
writeOutput Maybe (File content 'Out)
mOutFile =
      (FileError () -> GovernanceCmdError)
-> ExceptT (FileError ()) m () -> ExceptT GovernanceCmdError m ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GovernanceCmdError
WriteFileError
        (ExceptT (FileError ()) m () -> ExceptT GovernanceCmdError m ())
-> (Hash DRepMetadata -> ExceptT (FileError ()) m ())
-> Hash DRepMetadata
-> ExceptT GovernanceCmdError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (FileError ()) ()) -> ExceptT (FileError ()) m ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
        (m (Either (FileError ()) ()) -> ExceptT (FileError ()) m ())
-> (Hash DRepMetadata -> m (Either (FileError ()) ()))
-> Hash DRepMetadata
-> ExceptT (FileError ()) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (File content 'Out)
-> ByteString -> m (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
Maybe (File content 'Out)
-> ByteString -> m (Either (FileError e) ())
writeByteStringOutput Maybe (File content 'Out)
mOutFile
        (ByteString -> m (Either (FileError ()) ()))
-> (Hash DRepMetadata -> ByteString)
-> Hash DRepMetadata
-> m (Either (FileError ()) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash DRepMetadata -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex

hashSourceToDescription :: DRepHashSource -> TextEnvelopeDescr -> TextEnvelopeDescr
hashSourceToDescription :: DRepHashSource -> TextEnvelopeDescr -> TextEnvelopeDescr
hashSourceToDescription DRepHashSource
source TextEnvelopeDescr
what =
  ( case DRepHashSource
source of
      DRepHashSourceScript ScriptHash
_ -> TextEnvelopeDescr
"DRep Script"
      DRepHashSourceVerificationKey VerificationKeyOrHashOrFile DRepKey
_ -> TextEnvelopeDescr
"DRep Key"
  )
    TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a. Semigroup a => a -> a -> a
<> TextEnvelopeDescr
" "
    TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a. Semigroup a => a -> a -> a
<> TextEnvelopeDescr
what