Add two cli commands to enable the creation of MIR transfer certificates

Make adjustments to allow the node to be started without a socket file
Amend `MIRTarget` with clearer names

cardano-api/src/Cardano/Api/Certificate.hs

@@ -37,33 +37,32 @@ module Cardano.Api.Certificate (
 
 import           Prelude
 
-import           Data.Maybe
 import           Data.ByteString (ByteString)
-import           Data.Text (Text)
-import qualified Data.Text.Encoding as Text
+import qualified Data.Foldable as Foldable
 import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
+import           Data.Maybe
 import qualified Data.Sequence.Strict as Seq
-import qualified Data.Foldable as Foldable
+import qualified Data.Set as Set
+import           Data.Text (Text)
+import qualified Data.Text.Encoding as Text
 
 import           Data.IP (IPv4, IPv6)
 import           Network.Socket (PortNumber)
 
-import           Cardano.Slotting.Slot (EpochNo (..))
 import qualified Cardano.Crypto.Hash.Class as Crypto
+import           Cardano.Slotting.Slot (EpochNo (..))
 
 import           Ouroboros.Consensus.Shelley.Protocol.Crypto (StandardCrypto)
 
-import           Shelley.Spec.Ledger.BaseTypes
-                   (maybeToStrictMaybe, strictMaybeToMaybe)
+import           Shelley.Spec.Ledger.BaseTypes (maybeToStrictMaybe, strictMaybeToMaybe)
 import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 import qualified Shelley.Spec.Ledger.Coin as Shelley (toDeltaCoin)
-import qualified Shelley.Spec.Ledger.TxBody as Shelley
 import           Shelley.Spec.Ledger.TxBody (MIRPot (..))
+import qualified Shelley.Spec.Ledger.TxBody as Shelley
 
 import           Cardano.Api.Address
-import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.Hash
 import           Cardano.Api.KeysByron
 import           Cardano.Api.KeysPraos
 import           Cardano.Api.KeysShelley
@@ -127,13 +126,13 @@ data MIRTarget =
      -- a mapping of stake credentials to lovelace.
      StakeAddressesMIR [(StakeCredential, Lovelace)]
 
-     -- | Use 'SendToOppositePotMIR' to make the target of a 'MIRCertificate'
-     -- the opposite pot. Specifically, if the 'MIRPot' in a 'MIRCertificate'
-     -- is 'ReservesMIR', then using 'SendToOppositePotMIR' will transfer
-     -- lovelace from the reserves to the treasury. Otherwise, if it is
-     -- 'TreasuryMIR', then using 'SendToOppositePotMIR' will transfer
-     -- lovelace from the treasury to the reserves.
-   | SendToOppositePotMIR Lovelace
+     -- | Use 'SendToReservesMIR' to make the target of a 'MIRCertificate'
+     -- the reserves pot.
+   | SendToReservesMIR Lovelace
+
+     -- | Use 'SendToTreasuryMIR' to make the target of a 'MIRCertificate'
+     -- the treasury pot.
+   | SendToTreasuryMIR Lovelace
   deriving stock (Eq, Show)
 
 -- ----------------------------------------------------------------------------
@@ -262,11 +261,25 @@ toShelleyCertificate (MIRCertificate mirpot (StakeAddressesMIR amounts)) =
            [ (toShelleyStakeCredential sc, Shelley.toDeltaCoin . toShelleyLovelace $ v)
            | (sc, v) <- amounts ])
 
-toShelleyCertificate (MIRCertificate mirpot (SendToOppositePotMIR amount)) =
-    Shelley.DCertMir $
-      Shelley.MIRCert
-        mirpot
-        (Shelley.SendToOppositePotMIR $ toShelleyLovelace amount)
+toShelleyCertificate (MIRCertificate mirPot (SendToReservesMIR amount)) =
+    case mirPot of
+      TreasuryMIR ->
+        Shelley.DCertMir $
+          Shelley.MIRCert
+            TreasuryMIR
+            (Shelley.SendToOppositePotMIR $ toShelleyLovelace amount)
+      ReservesMIR ->
+        error "toShelleyCertificate: Incorrect MIRPot specified. Expected TreasuryMIR but got ReservesMIR"
+
+toShelleyCertificate (MIRCertificate mirPot (SendToTreasuryMIR amount)) =
+    case mirPot of
+      ReservesMIR ->
+        Shelley.DCertMir $
+          Shelley.MIRCert
+            ReservesMIR
+            (Shelley.SendToOppositePotMIR $ toShelleyLovelace amount)
+      TreasuryMIR ->
+        error "toShelleyCertificate: Incorrect MIRPot specified. Expected ReservesMIR but got TreasuryMIR"
 
 
 fromShelleyCertificate :: Shelley.DCert StandardCrypto -> Certificate
@@ -308,13 +321,15 @@ fromShelleyCertificate (Shelley.DCertMir
         [ (fromShelleyStakeCredential sc, fromShelleyDeltaLovelace v)
         | (sc, v) <- Map.toList amounts ]
       )
-
 fromShelleyCertificate (Shelley.DCertMir
-                         (Shelley.MIRCert mirpot (Shelley.SendToOppositePotMIR amount))) =
-    MIRCertificate
-      mirpot
-      (SendToOppositePotMIR $ fromShelleyLovelace amount)
+                         (Shelley.MIRCert ReservesMIR (Shelley.SendToOppositePotMIR amount))) =
+    MIRCertificate ReservesMIR
+      (SendToTreasuryMIR $ fromShelleyLovelace amount)
 
+fromShelleyCertificate (Shelley.DCertMir
+                         (Shelley.MIRCert TreasuryMIR (Shelley.SendToOppositePotMIR amount))) =
+    MIRCertificate TreasuryMIR
+      (SendToReservesMIR $ fromShelleyLovelace amount)
 
 toShelleyPoolParams :: StakePoolParameters -> Shelley.PoolParams StandardCrypto
 toShelleyPoolParams StakePoolParameters {

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -307,7 +307,12 @@ renderQueryCmd cmd =
     QueryProtocolState' {} -> "query protocol-state"
 
 data GovernanceCmd
-  = GovernanceMIRCertificate MIRPot [StakeAddress] [Lovelace] OutputFile
+  = GovernanceMIRPayStakeAddressesCertificate
+      MIRPot
+      [StakeAddress]
+      [Lovelace]
+      OutputFile
+  | GovernanceMIRTransfer Lovelace OutputFile TransferDirection
   | GovernanceGenesisKeyDelegationCertificate
       (VerificationKeyOrHashOrFile GenesisKey)
       (VerificationKeyOrHashOrFile GenesisDelegateKey)
@@ -322,7 +327,9 @@ renderGovernanceCmd :: GovernanceCmd -> Text
 renderGovernanceCmd cmd =
   case cmd of
     GovernanceGenesisKeyDelegationCertificate {} -> "governance create-genesis-key-delegation-certificate"
-    GovernanceMIRCertificate {} -> "governance create-mir-certificate"
+    GovernanceMIRPayStakeAddressesCertificate {} -> "governance create-mir-certificate stake-addresses"
+    GovernanceMIRTransfer _ _ TransferToTreasury -> "governance create-mir-certificate transfer-to-treasury"
+    GovernanceMIRTransfer _ _ TransferToReserves -> "governance create-mir-certificate transfer-to-reserves"
     GovernanceUpdateProposal {} -> "governance create-update-proposal"
 
 data TextViewCmd

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -722,7 +722,7 @@ pGovernanceCmd :: Parser GovernanceCmd
 pGovernanceCmd =
  asum
    [ subParser "create-mir-certificate"
-       (Opt.info pMIRCertificate $
+       (Opt.info (pMIRPayStakeAddresses <|> mirCertParsers) $
          Opt.progDesc "Create an MIR (Move Instantaneous Rewards) certificate")
    , subParser "create-genesis-key-delegation-certificate"
        (Opt.info pGovernanceGenesisKeyDelegationCertificate $
@@ -732,12 +732,36 @@ pGovernanceCmd =
          Opt.progDesc "Create an update proposal")
    ]
   where
-    pMIRCertificate :: Parser GovernanceCmd
-    pMIRCertificate = GovernanceMIRCertificate
-                        <$> pMIRPot
-                        <*> some pStakeAddress
-                        <*> some pRewardAmt
-                        <*> pOutputFile
+    mirCertParsers :: Parser GovernanceCmd
+    mirCertParsers = asum
+      [ subParser "stake-addresses" (Opt.info pMIRPayStakeAddresses $
+          Opt.progDesc "Create an MIR certificate to pay stake addresses")
+      , subParser "transfer-to-treasury" (Opt.info pMIRTransferToTreasury $
+          Opt.progDesc "Create an MIR certificate to transfer from the reserves pot\
+                       \ to the treasury pot")
+      , subParser "transfer-to-rewards" (Opt.info pMIRTransferToReserves $
+          Opt.progDesc "Create an MIR certificate to transfer from the treasury pot\
+                       \ to the reserves pot")
+      ]
+
+    pMIRPayStakeAddresses :: Parser GovernanceCmd
+    pMIRPayStakeAddresses = GovernanceMIRPayStakeAddressesCertificate
+                              <$> pMIRPot
+                              <*> some pStakeAddress
+                              <*> some pRewardAmt
+                              <*> pOutputFile
+
+    pMIRTransferToTreasury :: Parser GovernanceCmd
+    pMIRTransferToTreasury = GovernanceMIRTransfer
+                               <$> pTransferAmt
+                               <*> pOutputFile
+                               <*> pure TransferToTreasury
+
+    pMIRTransferToReserves :: Parser GovernanceCmd
+    pMIRTransferToReserves = GovernanceMIRTransfer
+                               <$> pTransferAmt
+                               <*> pOutputFile
+                               <*> pure TransferToReserves
 
     pGovernanceGenesisKeyDelegationCertificate :: Parser GovernanceCmd
     pGovernanceGenesisKeyDelegationCertificate =
@@ -765,6 +789,14 @@ pGovernanceCmd =
                         <*> some pGenesisVerificationKeyFile
                         <*> pShelleyProtocolParametersUpdate
 
+pTransferAmt :: Parser Lovelace
+pTransferAmt =
+    Opt.option (readerFromAttoParser parseLovelace)
+      (  Opt.long "transfer"
+      <> Opt.metavar "LOVELACE"
+      <> Opt.help "The amount to transfer."
+      )
+
 pRewardAmt :: Parser Lovelace
 pRewardAmt =
     Opt.option (readerFromAttoParser parseLovelace)

cardano-cli/src/Cardano/CLI/Shelley/Run/Governance.hs

@@ -14,7 +14,7 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Shelley.Key (InputDecodeError, VerificationKeyOrHashOrFile,
-                     readVerificationKeyOrHashOrFile, readVerificationKeyOrHashOrTextEnvFile)
+                   readVerificationKeyOrHashOrFile, readVerificationKeyOrHashOrTextEnvFile)
 import           Cardano.CLI.Shelley.Parsers
 import           Cardano.CLI.Types
 
@@ -53,20 +53,22 @@ renderShelleyGovernanceError err =
 
 
 runGovernanceCmd :: GovernanceCmd -> ExceptT ShelleyGovernanceCmdError IO ()
-runGovernanceCmd (GovernanceMIRCertificate mirpot vKeys rewards out) =
-  runGovernanceMIRCertificate mirpot vKeys rewards out
+runGovernanceCmd (GovernanceMIRPayStakeAddressesCertificate mirpot vKeys rewards out) =
+  runGovernanceMIRCertificatePayStakeAddrs mirpot vKeys rewards out
+runGovernanceCmd (GovernanceMIRTransfer amt out direction) =
+  runGovernanceMIRCertificateTransfer amt out direction
 runGovernanceCmd (GovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out) =
   runGovernanceGenesisKeyDelegationCertificate genVk genDelegVk vrfVk out
 runGovernanceCmd (GovernanceUpdateProposal out eNo genVKeys ppUp) =
   runGovernanceUpdateProposal out eNo genVKeys ppUp
 
-runGovernanceMIRCertificate
+runGovernanceMIRCertificatePayStakeAddrs
   :: Shelley.MIRPot
   -> [StakeAddress] -- ^ Stake addresses
   -> [Lovelace]     -- ^ Corresponding reward amounts (same length)
   -> OutputFile
   -> ExceptT ShelleyGovernanceCmdError IO ()
-runGovernanceMIRCertificate mirPot sAddrs rwdAmts (OutputFile oFp) = do
+runGovernanceMIRCertificatePayStakeAddrs mirPot sAddrs rwdAmts (OutputFile oFp) = do
 
     unless (length sAddrs == length rwdAmts) $
       left $ ShelleyGovernanceCmdMIRCertificateKeyRewardMistmach
@@ -87,8 +89,26 @@ runGovernanceMIRCertificate mirPot sAddrs rwdAmts (OutputFile oFp) = do
     stakeAddrToStakeCredential (StakeAddress _ scred) =
       fromShelleyStakeCredential scred
 
--- TODO runGovernanceMIRCertificate does not cover the case where a MIR certificate
--- transfers lovelace from one pot to the opposite pot.
+runGovernanceMIRCertificateTransfer
+  :: Lovelace
+  -> OutputFile
+  -> TransferDirection
+  -> ExceptT ShelleyGovernanceCmdError IO ()
+runGovernanceMIRCertificateTransfer ll (OutputFile oFp) direction = do
+  mirCert <- case direction of
+                 TransferToReserves ->
+                   return . makeMIRCertificate Shelley.TreasuryMIR $ SendToReservesMIR ll
+                 TransferToTreasury ->
+                   return . makeMIRCertificate Shelley.ReservesMIR $ SendToTreasuryMIR ll
+
+  firstExceptT ShelleyGovernanceCmdTextEnvWriteError
+    . newExceptT
+    $ writeFileTextEnvelope oFp (Just $ mirCertDesc direction) mirCert
+ where
+  mirCertDesc :: TransferDirection -> TextEnvelopeDescr
+  mirCertDesc TransferToTreasury = "MIR Certificate Send To Treasury"
+  mirCertDesc TransferToReserves = "MIR Certificate Send To Reserves"
+
 
 runGovernanceGenesisKeyDelegationCertificate
   :: VerificationKeyOrHashOrFile GenesisKey

cardano-cli/src/Cardano/CLI/Types.hs

@@ -12,6 +12,7 @@ module Cardano.CLI.Types
   , SigningKeyOrScriptFile (..)
   , SocketPath (..)
   , ScriptFile (..)
+  , TransferDirection(..)
   , TxOutAnyEra (..)
   , UpdateProposalFile (..)
   , VerificationKeyFile (..)
@@ -83,6 +84,10 @@ data SigningKeyOrScriptFile = ScriptFileForWitness FilePath
                             | SigningKeyFileForWitness FilePath
                             deriving (Eq, Show)
 
+-- | Determines the direction in which the MIR certificate will transfer ADA.
+data TransferDirection = TransferToReserves | TransferToTreasury
+                         deriving Show
+
 -- | A TxOut value that is the superset of possibilities for any era: any
 -- address type and allowing multi-asset values. This is used as the type for
 -- values passed on the command line. It can be converted into the

cardano-node/src/Cardano/Node/Configuration/Socket.hs

@@ -16,8 +16,8 @@ import           Prelude (String)
 import qualified Prelude
 
 import           Control.Monad.Trans.Except.Extra (handleIOExceptT)
-import           Network.Socket (Family (AF_INET, AF_INET6), AddrInfo (..),
-                     AddrInfoFlag (..), Socket, SocketType (..))
+import           Network.Socket (AddrInfo (..), AddrInfoFlag (..), Family (AF_INET, AF_INET6),
+                   Socket, SocketType (..))
 import qualified Network.Socket as Socket
 
 import           Cardano.Node.Configuration.POM (NodeConfiguration (..))
@@ -113,7 +113,7 @@ gatherConfiguredSockets :: NodeConfiguration
                         -> ExceptT SocketConfigError IO
                                    (Maybe (SocketOrSocketInfo Socket AddrInfo),
                                     Maybe (SocketOrSocketInfo Socket AddrInfo),
-                                           SocketOrSocketInfo Socket SocketPath)
+                                    Maybe (SocketOrSocketInfo Socket SocketPath))
 gatherConfiguredSockets NodeConfiguration { ncNodeIPv4Addr,
                                             ncNodeIPv6Addr,
                                             ncNodePortNumber,
@@ -160,7 +160,7 @@ gatherConfiguredSockets NodeConfiguration { ncNodeIPv4Addr,
     (ipv4', ipv6')
       <- case (ipv4, ipv6) of
             (Nothing, Nothing) -> do
-      
+
               info <- nodeAddressInfo Nothing ncNodePortNumber
               let ipv4' = SocketInfo <$> find ((== AF_INET)  . addrFamily) info
                   ipv6' = SocketInfo <$> find ((== AF_INET6) . addrFamily) info
@@ -180,10 +180,10 @@ gatherConfiguredSockets NodeConfiguration { ncNodeIPv4Addr,
     -- only when 'ncSocketpath' is specified or a unix socket is passed through
     -- socket activation
     local <- case (ncSocketPath, firstUnixSocket) of
-      (Nothing, Nothing)    -> throwError NoLocalSocketGiven
+      (Nothing, Nothing)    -> return Nothing
       (Just _, Just _)      -> throwError ClashingLocalSocketGiven
-      (Nothing, Just sock)  -> return (ActualSocket sock)
-      (Just path, Nothing)  -> removeStaleLocalSocket path $> SocketInfo path
+      (Nothing, Just sock)  -> return . Just $ ActualSocket sock
+      (Just path, Nothing)  -> removeStaleLocalSocket path $> Just (SocketInfo path)
 
     return (ipv4', ipv6', local)