{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.CLI.EraBased.Governance.Run
  ( runGovernanceCmds
  , runGovernanceMIRCertificatePayStakeAddrs
  , runGovernanceCreateMirCertificateTransferToReservesCmd
  )
where

import Cardano.Api hiding (makeMIRCertificate)
import Cardano.Api.Compatible.Certificate
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Governance.Actions.Run
import Cardano.CLI.EraBased.Governance.Command qualified as Cmd
import Cardano.CLI.EraBased.Governance.Committee.Run
import Cardano.CLI.EraBased.Governance.DRep.Run
import Cardano.CLI.EraBased.Governance.Vote.Run
import Cardano.CLI.Type.Error.GovernanceCmdError

import RIO

import GHC.Exts (IsList (..))

runGovernanceCmds
  :: Cmd.GovernanceCmds era
  -> CIO e ()
runGovernanceCmds :: forall era e. GovernanceCmds era -> CIO e ()
runGovernanceCmds = \case
  Cmd.GovernanceCommitteeCmds GovernanceCommitteeCmds era
cmds ->
    GovernanceCommitteeCmds era -> CIO e ()
forall era e. GovernanceCommitteeCmds era -> CIO e ()
runGovernanceCommitteeCmds GovernanceCommitteeCmds era
cmds
  Cmd.GovernanceActionCmds GovernanceActionCmds era
cmds ->
    GovernanceActionCmds era -> CIO e ()
forall era e. GovernanceActionCmds era -> CIO e ()
runGovernanceActionCmds GovernanceActionCmds era
cmds
  Cmd.GovernanceDRepCmds GovernanceDRepCmds era
cmds ->
    GovernanceDRepCmds era -> CIO e ()
forall era e. GovernanceDRepCmds era -> CIO e ()
runGovernanceDRepCmds GovernanceDRepCmds era
cmds
  Cmd.GovernanceVoteCmds GovernanceVoteCmds era
cmds ->
    GovernanceVoteCmds era -> CIO e ()
forall era e. GovernanceVoteCmds era -> CIO e ()
runGovernanceVoteCmds GovernanceVoteCmds era
cmds

runGovernanceMIRCertificatePayStakeAddrs
  :: ShelleyToBabbageEra era
  -> L.MIRPot
  -> [StakeAddress]
  -- ^ Stake addresses
  -> [Lovelace]
  -- ^ Corresponding reward amounts (same length)
  -> File () Out
  -> CIO e ()
runGovernanceMIRCertificatePayStakeAddrs :: forall era e.
ShelleyToBabbageEra era
-> MIRPot
-> [StakeAddress]
-> [Lovelace]
-> File () 'Out
-> CIO e ()
runGovernanceMIRCertificatePayStakeAddrs ShelleyToBabbageEra era
w MIRPot
mirPot [StakeAddress]
sAddrs [Lovelace]
rwdAmts File () 'Out
oFp = do
  Bool -> RIO e () -> RIO e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([StakeAddress] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StakeAddress]
sAddrs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Lovelace] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Lovelace]
rwdAmts) (RIO e () -> RIO e ()) -> RIO e () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    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
$
      FilePath -> Int -> Int -> GovernanceCmdError
GovernanceCmdMIRCertificateKeyRewardMistmach
        (File () 'Out -> FilePath
forall content (direction :: FileDirection).
File content direction -> FilePath
unFile File () 'Out
oFp)
        ([StakeAddress] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StakeAddress]
sAddrs)
        ([Lovelace] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Lovelace]
rwdAmts)

  let sCreds :: [StakeCredential]
sCreds = (StakeAddress -> StakeCredential)
-> [StakeAddress] -> [StakeCredential]
forall a b. (a -> b) -> [a] -> [b]
map StakeAddress -> StakeCredential
stakeAddressCredential [StakeAddress]
sAddrs
      mirTarget :: MIRTarget
mirTarget =
        Map (Credential 'Staking) DeltaCoin -> MIRTarget
L.StakeAddressesMIR (Map (Credential 'Staking) DeltaCoin -> MIRTarget)
-> Map (Credential 'Staking) DeltaCoin -> MIRTarget
forall a b. (a -> b) -> a -> b
$
          [Item (Map (Credential 'Staking) DeltaCoin)]
-> Map (Credential 'Staking) DeltaCoin
forall l. IsList l => [Item l] -> l
fromList
            [ (StakeCredential -> Credential 'Staking
toShelleyStakeCredential StakeCredential
scred, Lovelace -> DeltaCoin
L.toDeltaCoin Lovelace
rwdAmt)
            | (StakeCredential
scred, Lovelace
rwdAmt) <- [StakeCredential] -> [Lovelace] -> [(StakeCredential, Lovelace)]
forall a b. [a] -> [b] -> [(a, b)]
zip [StakeCredential]
sCreds [Lovelace]
rwdAmts
            ]
  let mirCert :: Certificate (ShelleyLedgerEra BabbageEra)
mirCert =
        MIRPot -> MIRTarget -> Certificate (ShelleyLedgerEra BabbageEra)
makeMIRCertificate MIRPot
mirPot MIRTarget
mirTarget
      sbe :: ShelleyBasedEra era
sbe = ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyToBabbageEra era
w

  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
$
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => IO (Either (FileError ()) ()))
 -> IO (Either (FileError ()) ()))
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
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
oFp (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr -> Certificate BabbageEra -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
mirCertDesc) Certificate (ShelleyLedgerEra BabbageEra)
Certificate BabbageEra
mirCert
 where
  mirCertDesc :: TextEnvelopeDescr
  mirCertDesc :: TextEnvelopeDescr
mirCertDesc = TextEnvelopeDescr
"Move Instantaneous Rewards Certificate"

runGovernanceCreateMirCertificateTransferToReservesCmd
  :: ShelleyToBabbageEra era
  -> Lovelace
  -> File () Out
  -> CIO e ()
runGovernanceCreateMirCertificateTransferToReservesCmd :: forall era e.
ShelleyToBabbageEra era -> Lovelace -> File () 'Out -> CIO e ()
runGovernanceCreateMirCertificateTransferToReservesCmd ShelleyToBabbageEra era
w Lovelace
ll File () 'Out
oFp = do
  let mirTarget :: MIRTarget
mirTarget = Lovelace -> MIRTarget
L.SendToOppositePotMIR Lovelace
ll

  let mirCert :: Certificate (ShelleyLedgerEra BabbageEra)
mirCert = MIRPot -> MIRTarget -> Certificate (ShelleyLedgerEra BabbageEra)
makeMIRCertificate MIRPot
L.TreasuryMIR MIRTarget
mirTarget
      sbe :: ShelleyBasedEra era
sbe = ShelleyToBabbageEra era -> ShelleyBasedEra era
forall era. ShelleyToBabbageEra era -> ShelleyBasedEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert ShelleyToBabbageEra era
w

  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
$
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => IO (Either (FileError ()) ()))
 -> IO (Either (FileError ()) ()))
-> (ShelleyBasedEraConstraints era =>
    IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
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
oFp (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr -> Certificate BabbageEra -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
mirCertDesc) Certificate (ShelleyLedgerEra BabbageEra)
Certificate BabbageEra
mirCert
 where
  mirCertDesc :: TextEnvelopeDescr
  mirCertDesc :: TextEnvelopeDescr
mirCertDesc = TextEnvelopeDescr
"MIR Certificate Send To Reserves"