Merge pull request #5108 from input-output-hk/newhoggy/cip-1694-make-…

…space-for-drep-certificates

CIP-1694 make space for DRep certificates

cardano-api/src/Cardano/Api.hs

@@ -364,7 +364,7 @@ module Cardano.Api (
     -- choice for a stake address.
     makeStakeAddressRegistrationCertificate,
     makeStakeAddressDeregistrationCertificate,
-    makeStakeAddressDelegationCertificate,
+    makeStakeAddressPoolDelegationCertificate,
 
     -- ** Registering stake pools
     -- | Certificates that are embedded in transactions for registering and

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

@@ -12,7 +12,7 @@ module Cardano.Api.Certificate (
     -- * Registering stake address and delegating
     makeStakeAddressRegistrationCertificate,
     makeStakeAddressDeregistrationCertificate,
-    makeStakeAddressDelegationCertificate,
+    makeStakeAddressPoolDelegationCertificate,
     PoolId,
 
     -- * Registering stake pools
@@ -83,7 +83,7 @@ data Certificate =
      -- Stake address certificates
      StakeAddressRegistrationCertificate   StakeCredential
    | StakeAddressDeregistrationCertificate StakeCredential
-   | StakeAddressDelegationCertificate     StakeCredential PoolId
+   | StakeAddressPoolDelegationCertificate StakeCredential PoolId
 
      -- Stake pool certificates
    | StakePoolRegistrationCertificate StakePoolParameters
@@ -113,7 +113,7 @@ instance HasTextEnvelope Certificate where
     textEnvelopeDefaultDescr cert = case cert of
       StakeAddressRegistrationCertificate{}   -> "Stake address registration"
       StakeAddressDeregistrationCertificate{} -> "Stake address de-registration"
-      StakeAddressDelegationCertificate{}     -> "Stake address delegation"
+      StakeAddressPoolDelegationCertificate{} -> "Stake address stake pool delegation"
       StakePoolRegistrationCertificate{}      -> "Pool registration"
       StakePoolRetirementCertificate{}        -> "Pool retirement"
       GenesisKeyDelegationCertificate{}       -> "Genesis key delegation"
@@ -191,8 +191,8 @@ makeStakeAddressRegistrationCertificate = StakeAddressRegistrationCertificate
 makeStakeAddressDeregistrationCertificate :: StakeCredential -> Certificate
 makeStakeAddressDeregistrationCertificate = StakeAddressDeregistrationCertificate
 
-makeStakeAddressDelegationCertificate :: StakeCredential -> PoolId -> Certificate
-makeStakeAddressDelegationCertificate = StakeAddressDelegationCertificate
+makeStakeAddressPoolDelegationCertificate :: StakeCredential -> PoolId -> Certificate
+makeStakeAddressPoolDelegationCertificate = StakeAddressPoolDelegationCertificate
 
 makeStakePoolRegistrationCertificate :: StakePoolParameters -> Certificate
 makeStakePoolRegistrationCertificate = StakePoolRegistrationCertificate
@@ -225,7 +225,7 @@ toShelleyCertificate (StakeAddressDeregistrationCertificate stakecred) =
       Shelley.DeRegKey
         (toShelleyStakeCredential stakecred)
 
-toShelleyCertificate (StakeAddressDelegationCertificate
+toShelleyCertificate (StakeAddressPoolDelegationCertificate
                         stakecred (StakePoolKeyHash poolid)) =
     Shelley.DCertDeleg $
     Shelley.Delegate $
@@ -295,7 +295,7 @@ fromShelleyCertificate (Shelley.DCertDeleg (Shelley.DeRegKey stakecred)) =
 
 fromShelleyCertificate (Shelley.DCertDeleg
                          (Shelley.Delegate (Shelley.Delegation stakecred poolid))) =
-    StakeAddressDelegationCertificate
+    StakeAddressPoolDelegationCertificate
       (fromShelleyStakeCredential stakecred)
       (StakePoolKeyHash poolid)
 

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

@@ -1293,7 +1293,7 @@ mapTxScriptWitnesses f txbodycontent@TxBodyContent {
     selectStakeCredential cert =
       case cert of
         StakeAddressDeregistrationCertificate stakecred   -> Just stakecred
-        StakeAddressDelegationCertificate     stakecred _ -> Just stakecred
+        StakeAddressPoolDelegationCertificate stakecred _ -> Just stakecred
         _                                                 -> Nothing
 
     mapScriptWitnessesMinting

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

@@ -4208,7 +4208,7 @@ collectTxBodyScriptWitnesses TxBodyContent {
     selectStakeCredential cert =
       case cert of
         StakeAddressDeregistrationCertificate stakecred   -> Just stakecred
-        StakeAddressDelegationCertificate     stakecred _ -> Just stakecred
+        StakeAddressPoolDelegationCertificate stakecred _ -> Just stakecred
         _                                                 -> Nothing
 
     scriptWitnessesMinting

cardano-cli/src/Cardano/CLI/Run/Friendly.hs

@@ -315,7 +315,7 @@ friendlyCertificate =
       StakeAddressDeregistrationCertificate credential ->
         "stake address deregistration"
           .= object [friendlyStakeCredential credential]
-      StakeAddressDelegationCertificate credential poolId ->
+      StakeAddressPoolDelegationCertificate credential poolId ->
         "stake address delegation"
           .= object [friendlyStakeCredential credential, "pool" .= poolId]
 

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

@@ -50,8 +50,9 @@ import           Cardano.Api.Shelley
 
 import           Data.Text (Text)
 
-import           Cardano.CLI.Shelley.Key (PaymentVerifier, StakeIdentifier, StakeVerifier,
-                   VerificationKeyOrFile, VerificationKeyOrHashOrFile, VerificationKeyTextOrFile)
+import           Cardano.CLI.Shelley.Key (DelegationTarget, PaymentVerifier, StakeIdentifier,
+                   StakeVerifier, VerificationKeyOrFile, VerificationKeyOrHashOrFile,
+                   VerificationKeyTextOrFile)
 import           Cardano.CLI.Types
 
 import           Cardano.Chain.Common (BlockCount)
@@ -115,7 +116,7 @@ data StakeAddressCmd
   | StakeRegistrationCert StakeIdentifier OutputFile
   | StakeCredentialDelegationCert
       StakeIdentifier
-      (VerificationKeyOrHashOrFile StakePoolKey)
+      DelegationTarget
       OutputFile
   | StakeCredentialDeRegistrationCert StakeIdentifier OutputFile
   deriving Show

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

@@ -24,6 +24,8 @@ module Cardano.CLI.Shelley.Key
   , StakeVerifier(..)
 
   , generateKeyPair
+
+  , DelegationTarget(..)
   ) where
 
 import           Cardano.Api
@@ -36,6 +38,7 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 
+import           Cardano.Api.Shelley (StakePoolKey)
 import           Cardano.CLI.Types
 
 
@@ -110,6 +113,12 @@ data StakeIdentifier
   | StakeIdentifierAddress StakeAddress
   deriving (Eq, Show)
 
+-- | A resource that identifies the delegation target.  At the moment a delegation
+-- target can only be a stake pool.
+newtype DelegationTarget
+  = StakePoolDelegationTarget (VerificationKeyOrHashOrFile StakePoolKey)
+  deriving Show
+
 -- | Either an unvalidated text representation of a verification key or a path
 -- to a verification key file.
 data VerificationKeyTextOrFile

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

@@ -60,9 +60,9 @@ import           Cardano.Chain.Common (BlockCount (BlockCount))
 
 import           Cardano.CLI.Common.Parsers (pConsensusModeParams, pNetworkId)
 import           Cardano.CLI.Shelley.Commands
-import           Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeIdentifier (..),
-                   StakeVerifier (..), VerificationKeyOrFile (..), VerificationKeyOrHashOrFile (..),
-                   VerificationKeyTextOrFile (..))
+import           Cardano.CLI.Shelley.Key (DelegationTarget (..), PaymentVerifier (..),
+                   StakeIdentifier (..), StakeVerifier (..), VerificationKeyOrFile (..),
+                   VerificationKeyOrHashOrFile (..), VerificationKeyTextOrFile (..))
 import           Cardano.CLI.Types
 
 {- HLINT ignore "Use <$>" -}
@@ -379,7 +379,7 @@ pStakeAddressCmd =
       , subParser "deregistration-certificate"
           (Opt.info pStakeAddressDeregistrationCert $ Opt.progDesc "Create a stake address deregistration certificate")
       , subParser "delegation-certificate"
-          (Opt.info pStakeAddressDelegationCert $ Opt.progDesc "Create a stake address delegation certificate")
+          (Opt.info pStakeAddressPoolDelegationCert $ Opt.progDesc "Create a stake address pool delegation certificate")
       ]
   where
     pStakeAddressKeyGen :: Parser StakeAddressCmd
@@ -409,11 +409,11 @@ pStakeAddressCmd =
         <$> pStakeIdentifier
         <*> pOutputFile
 
-    pStakeAddressDelegationCert :: Parser StakeAddressCmd
-    pStakeAddressDelegationCert =
+    pStakeAddressPoolDelegationCert :: Parser StakeAddressCmd
+    pStakeAddressPoolDelegationCert =
       StakeCredentialDelegationCert
         <$> pStakeIdentifier
-        <*> pStakePoolVerificationKeyOrHashOrFile
+        <*> pDelegationTarget
         <*> pOutputFile
 
 pKeyCmd :: Parser KeyCmd
@@ -2737,6 +2737,10 @@ pStakePoolVerificationKeyOrFile =
   VerificationKeyValue <$> pStakePoolVerificationKey
     <|> VerificationKeyFilePath <$> pStakePoolVerificationKeyFile
 
+pDelegationTarget
+  :: Parser DelegationTarget
+pDelegationTarget = StakePoolDelegationTarget <$> pStakePoolVerificationKeyOrHashOrFile
+
 pStakePoolVerificationKeyOrHashOrFile
   :: Parser (VerificationKeyOrHashOrFile StakePoolKey)
 pStakePoolVerificationKeyOrHashOrFile =

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.CLI.Shelley.Run.StakeAddress
   ( ShelleyStakeAddressCmdError(ShelleyStakeAddressCmdReadKeyFileError)
@@ -9,7 +10,7 @@ module Cardano.CLI.Shelley.Run.StakeAddress
 
 import           Control.Monad.IO.Class (MonadIO (..))
 import           Control.Monad.Trans.Except (ExceptT)
-import           Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT)
+import           Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT, onLeft)
 import qualified Data.ByteString.Char8 as BS
 import           Data.Text (Text)
 import qualified Data.Text as Text
@@ -18,12 +19,14 @@ import qualified Data.Text.IO as Text
 import           Cardano.Api
 import           Cardano.Api.Shelley
 
-import           Cardano.CLI.Shelley.Key (StakeIdentifier (..), StakeVerifier (..),
-                   VerificationKeyOrFile, VerificationKeyOrHashOrFile, readVerificationKeyOrFile,
+import           Cardano.CLI.Shelley.Key (DelegationTarget (..), StakeIdentifier (..),
+                   StakeVerifier (..), VerificationKeyOrFile, readVerificationKeyOrFile,
                    readVerificationKeyOrHashOrFile)
 import           Cardano.CLI.Shelley.Parsers
 import           Cardano.CLI.Shelley.Run.Read
 import           Cardano.CLI.Types
+import           Control.Monad.Trans (lift)
+import           Data.Function ((&))
 
 data ShelleyStakeAddressCmdError
   = ShelleyStakeAddressCmdReadKeyFileError !(FileError InputDecodeError)
@@ -126,34 +129,22 @@ runStakeCredentialRegistrationCert stakeIdentifier (OutputFile oFp) = do
 runStakeCredentialDelegationCert
   :: StakeIdentifier
   -- ^ Delegator stake verification key, verification key file or script file.
-  -> VerificationKeyOrHashOrFile StakePoolKey
+  -> DelegationTarget
   -- ^ Delegatee stake pool verification key or verification key file or
   -- verification key hash.
   -> OutputFile
   -> ExceptT ShelleyStakeAddressCmdError IO ()
-runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile outFp) = do
-  poolStakeVKeyHash <-
-    firstExceptT
-      ShelleyStakeAddressCmdReadKeyFileError
-      (newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
-  stakeCred <- getStakeCredentialFromIdentifier stakeVerifier
-  writeDelegationCert stakeCred poolStakeVKeyHash
-
-  where
-    writeDelegationCert
-      :: StakeCredential
-      -> Hash StakePoolKey
-      -> ExceptT ShelleyStakeAddressCmdError IO ()
-    writeDelegationCert sCred poolStakeVKeyHash = do
-      let delegCert = makeStakeAddressDelegationCertificate sCred poolStakeVKeyHash
+runStakeCredentialDelegationCert stakeVerifier delegationTarget (OutputFile outFp) =
+  case delegationTarget of
+    StakePoolDelegationTarget poolVKeyOrHashOrFile -> do
+      poolStakeVKeyHash <- lift (readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
+        & onLeft (left . ShelleyStakeAddressCmdReadKeyFileError)
+      stakeCred <- getStakeCredentialFromIdentifier stakeVerifier
+      let delegCert = makeStakeAddressPoolDelegationCertificate stakeCred poolStakeVKeyHash
       firstExceptT ShelleyStakeAddressCmdWriteFileError
         . newExceptT
         $ writeLazyByteStringFile outFp
-        $ textEnvelopeToJSON (Just delegCertDesc) delegCert
-
-    delegCertDesc :: TextEnvelopeDescr
-    delegCertDesc = "Stake Address Delegation Certificate"
-
+        $ textEnvelopeToJSON (Just @TextEnvelopeDescr "Stake Address Delegation Certificate") delegCert
 
 runStakeCredentialDeRegistrationCert
   :: StakeIdentifier

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

@@ -283,7 +283,7 @@ validateTxCertificates era certsAndScriptWitnesses =
    deriveStakeCredentialWitness cert = do
      case cert of
        StakeAddressDeregistrationCertificate sCred -> Just sCred
-       StakeAddressDelegationCertificate sCred _ -> Just sCred
+       StakeAddressPoolDelegationCertificate sCred _ -> Just sCred
        _ -> Nothing
 
    convert

cardano-client-demo/StakeCredentialHistory.hs

@@ -346,7 +346,7 @@ main = do
       if t == cred then Just (StakeRegistrationEvent epochNo slotNo) else Nothing
     targetedCert t epochNo slotNo (StakeAddressDeregistrationCertificate cred) =
       if t == cred then Just (StakeDeRegistrationEvent epochNo slotNo) else Nothing
-    targetedCert t _epochNo slotNo (StakeAddressDelegationCertificate cred pool) =
+    targetedCert t _epochNo slotNo (StakeAddressPoolDelegationCertificate cred pool) =
       if t == cred then Just (DelegationEvent slotNo pool) else Nothing
     targetedCert t _epochNo slotNo (StakePoolRegistrationCertificate pool)      =
       inPoolCert t slotNo pool