Implement creation of registration and retirement stake pool certific…

…ates

Integrate delegation and stake pool certificates in `buildShelleyTransaction`

cardano-api/cardano-api.cabal

@@ -34,7 +34,6 @@ library
                       , base16-bytestring
                       , bytestring
                       , cardano-binary
-                      , cardano-node
                       , cardano-config
                       , cardano-crypto-class
                       , cardano-crypto-wrapper

cardano-api/src/Cardano/Api.hs

@@ -49,10 +49,22 @@ module Cardano.Api
   , queryFilteredUTxOFromLocalState
   , queryPParamsFromLocalState
 
-  -- Delegation Certificate Related
+  , ShelleyCredential
+  , ShelleyRewardAccount
+  , ShelleyStakePoolMetaData
+  , ShelleyStakePoolOwners
+  , ShelleyStakePoolRelay
+  , ShelleyVerificationKeyHash
+  , ShelleyVRFVerificationKeyHash
+  , mkShelleyCredential
+
+  -- * Shelley Delegation Certificate Related
+  , Certificate(..)
   , shelleyDeregisterStakingKey
   , shelleyDelegateStake
   , shelleyRegisterStakingKey
+  , shelleyRegisterStakePool
+  , shelleyRetireStakePool
   ) where
 
 import           Cardano.Prelude
@@ -86,12 +98,12 @@ import qualified Cardano.Chain.Common  as Byron
 import qualified Cardano.Chain.Genesis as Byron
 import qualified Cardano.Chain.UTxO    as Byron
 
-import qualified Shelley.Spec.Ledger.Address      as Shelley
-import qualified Shelley.Spec.Ledger.Keys         as Shelley
-import qualified Shelley.Spec.Ledger.TxData       as Shelley
-import qualified Shelley.Spec.Ledger.Tx           as Shelley
-import qualified Shelley.Spec.Ledger.BaseTypes    as Shelley
-
+import qualified Shelley.Spec.Ledger.Address   as Shelley
+import qualified Shelley.Spec.Ledger.Keys      as Shelley
+import qualified Shelley.Spec.Ledger.Slot      as Shelley
+import qualified Shelley.Spec.Ledger.TxData    as Shelley
+import qualified Shelley.Spec.Ledger.Tx        as Shelley
+import qualified Shelley.Spec.Ledger.BaseTypes as Shelley
 
 byronGenSigningKey :: IO SigningKey
 byronGenSigningKey =
@@ -101,21 +113,73 @@ shelleyGenSigningKey :: IO SigningKey
 shelleyGenSigningKey =
     SigningKeyShelley . Shelley.SKey <$> runSecureRandom genKeyDSIGN
 
+-- | Register a shelley staking pool.
+shelleyRegisterStakePool
+  :: ShelleyVerificationKeyHash
+  -- ^ Pool public key.
+  -> ShelleyVRFVerificationKeyHash
+  -- ^ VRF verification key hash.
+  -> ShelleyCoin
+  -- ^ Pool pledge.
+  -> ShelleyCoin
+  -- ^ Pool cost.
+  -> ShelleyStakePoolMargin
+  -- ^ Pool margin.
+  -> ShelleyRewardAccount
+  -- ^ Pool reward account.
+  -> ShelleyStakePoolOwners
+  -- ^ Pool owners.
+  -> Seq.StrictSeq Shelley.StakePoolRelay
+  -- ^ Pool relays.
+  -> Shelley.StrictMaybe Shelley.PoolMetaData
+  -> Certificate
+shelleyRegisterStakePool poolVkeyHash vrfVkeyHash pldg cst
+                          mrgn rwdact ownrs relays md = do
+  let poolPubKeyHash = poolVkeyHash
+      poolVRFkeyHash = vrfVkeyHash
+      poolPledge = pldg
+      poolCost = cst
+      poolMargin = mrgn
+      poolRewardAcnt = rwdact
+      poolOwners = ownrs
+      poolRelays = relays
+      poolMetaData = md
+
+  let poolParams = Shelley.PoolParams
+                     { Shelley._poolPubKey = poolPubKeyHash
+                     , Shelley._poolVrf = poolVRFkeyHash
+                     , Shelley._poolPledge = poolPledge
+                     , Shelley._poolCost = poolCost
+                     , Shelley._poolMargin = poolMargin
+                     , Shelley._poolRAcnt = poolRewardAcnt
+                     , Shelley._poolOwners = poolOwners
+                     , Shelley._poolRelays = poolRelays
+                     , Shelley._poolMD = poolMetaData
+                     }
+  ShelleyStakePoolCertificate . Shelley.DCertPool . Shelley.RegPool $ poolParams
+
+-- | Retire a shelley staking pool.
+shelleyRetireStakePool :: VerificationKey -> Shelley.EpochNo -> Certificate
+shelleyRetireStakePool (VerificationKeyShelley vKey) eNo =
+  ShelleyStakePoolCertificate . Shelley.DCertPool $ Shelley.RetirePool (Shelley.hashKey vKey) eNo
+shelleyRetireStakePool _ _ = panic "Cardano.Api.shelleyRetireStakePool: Please use a shelley verification key."
+
+
 -- | Register a shelley staking key.
 shelleyRegisterStakingKey
   :: (SigningKey, VerificationKey)
   -> Certificate
 shelleyRegisterStakingKey keyPair = do
   let cred = mkShelleyCredential keyPair
-  ShelleyDelegationCertificate $ Shelley.DCertDeleg $ Shelley.RegKey cred
+  ShelleyDelegationCertificate . Shelley.DCertDeleg $ Shelley.RegKey cred
 
 -- | Deregister a shelley staking key.
 shelleyDeregisterStakingKey
   :: (SigningKey, VerificationKey)
   -> Certificate
 shelleyDeregisterStakingKey keyPair = do
   let cred = mkShelleyCredential keyPair
-  ShelleyDelegationCertificate $ Shelley.DCertDeleg $ Shelley.DeRegKey cred
+  ShelleyDelegationCertificate . Shelley.DCertDeleg $  Shelley.DeRegKey cred
 
 -- | Delegate your stake (as the delegator) to a specified delegatee.
 shelleyDelegateStake
@@ -124,8 +188,8 @@ shelleyDelegateStake
   -> Certificate
 shelleyDelegateStake delegatorKeyPair (VerificationKeyShelley delegateeVKey) = do
   let cred = mkShelleyCredential delegatorKeyPair
-  ShelleyDelegationCertificate $ Shelley.DCertDeleg $ Shelley.Delegate $ Shelley.Delegation cred (Shelley.hashKey delegateeVKey)
-shelleyDelegateStake _ _ = panic "Cardano.Api.shelleyDelegateStake Please use a shelley key pair."
+  ShelleyDelegationCertificate . Shelley.DCertDeleg $  Shelley.Delegate $ Shelley.Delegation cred (Shelley.hashKey delegateeVKey)
+shelleyDelegateStake _ (VerificationKeyByron _) = panic "Cardano.Api.mkShelleyCredential: Please use a shelley verification key."
 
 mkShelleyCredential :: (SigningKey, VerificationKey) -> ShelleyCredential
 mkShelleyCredential (SigningKeyShelley sKey, VerificationKeyShelley vKey) =
@@ -200,19 +264,29 @@ buildByronTransaction ins outs =
     bTxHash = coerce $ Crypto.hashRaw (LBS.fromStrict bTxCbor)
 
 
-buildShelleyTransaction :: [TxIn] -> [TxOut] -> SlotNo -> Lovelace -> TxUnsigned
-buildShelleyTransaction txins txouts ttl fee =
-    TxUnsignedShelley $
-      Shelley.TxBody
-        (Set.fromList (map toShelleyTxIn  txins))
-        (Seq.fromList (map toShelleyTxOut txouts))
-        Seq.empty                -- certificates
-        (Shelley.Wdrl Map.empty) -- withdrawals
-        (toShelleyLovelace fee)
-        ttl
-        Shelley.SNothing         -- update proposals
-        Shelley.SNothing         -- metadata hash
-
+buildShelleyTransaction
+  :: [TxIn]
+  -> [TxOut]
+  -> SlotNo
+  -> Lovelace
+  -> [Certificate]
+  -> TxUnsigned
+buildShelleyTransaction txins txouts ttl fee certs = do
+  let relevantCerts = catMaybes [ certDiscrim c | c <- certs ]
+  TxUnsignedShelley $
+    Shelley.TxBody
+      (Set.fromList (map toShelleyTxIn  txins))
+      (Seq.fromList (map toShelleyTxOut txouts))
+      (Seq.fromList relevantCerts)  -- certificates
+      (Shelley.Wdrl Map.empty)      -- withdrawals
+      (toShelleyLovelace fee)
+      ttl
+      Shelley.SNothing              -- update proposals
+      Shelley.SNothing              -- metadata hash
+ where
+   certDiscrim :: Certificate -> Maybe ShelleyCertificate
+   certDiscrim (ShelleyDelegationCertificate delegCert) = Just delegCert
+   certDiscrim (ShelleyStakePoolCertificate sPoolCert) = Just sPoolCert
 
 {-
 inputs outputs, attributes:

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

@@ -3,6 +3,8 @@
 module Cardano.Api.CBOR
   ( addressFromCBOR
   , addressToCBOR
+  , certificateFromCBOR
+  , certificateToCBOR
   , signingKeyFromCBOR
   , signingKeyToCBOR
   , verificationKeyFromCBOR
@@ -58,6 +60,26 @@ addressToCBOR kp =
       AddressByron   addr -> mconcat [ toCBOR (170 :: Word8), toCBOR addr ]
       AddressShelley addr -> mconcat [ toCBOR (171 :: Word8), toCBOR addr ]
 
+certificateFromCBOR :: ByteString -> Either ApiError Certificate
+certificateFromCBOR bs =
+    first ApiErrorCBOR . CBOR.decodeFullDecoder "ShelleyCertificate" decode $ LBS.fromStrict bs
+  where
+    decode :: Decoder s Certificate
+    decode = do
+      tag <- CBOR.decodeWord8
+      case tag of
+        180 -> ShelleyDelegationCertificate <$> fromCBOR
+        181 -> ShelleyStakePoolCertificate <$> fromCBOR
+        _ -> cborError $ DecoderErrorUnknownTag "ShelleyCertificate" tag
+
+certificateToCBOR :: Certificate -> ByteString
+certificateToCBOR sc =
+  CBOR.serializeEncoding' $
+    case sc of
+      ShelleyDelegationCertificate cert -> mconcat [ toCBOR (180 :: Word8) , toCBOR cert]
+      ShelleyStakePoolCertificate cert -> mconcat [ toCBOR (181 :: Word8) , toCBOR cert]
+
+
 signingKeyFromCBOR :: ByteString -> Either ApiError SigningKey
 signingKeyFromCBOR bs =
    first ApiErrorCBOR . CBOR.decodeFullDecoder "SigningKey" decode $ LBS.fromStrict bs

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -41,10 +42,21 @@ module Cardano.Api.Types
   , toByronLovelace
 
     -- ** Shelley
+  , ShelleyCertificate
+  , ShelleyCoin
+  , ShelleyStakePoolMargin
+  , ShelleyStakePoolCertificate
+  , ShelleyStakePoolMetaData
+  , ShelleyStakePoolOwners
+  , ShelleyStakePoolRelay
   , ShelleyVerificationKey
+  , ShelleyVerificationKeyHash
   , ShelleySigningKey
+  , ShelleyVRFVerificationKeyHash
   , ShelleyAddress
   , ShelleyCredential
+  , ShelleyDelegationCertificate
+  , ShelleyRewardAccount
   , ShelleyTxBody
   , ShelleyTx
   , ShelleyTxId
@@ -71,9 +83,13 @@ import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Chain.UTxO   as Byron
 import qualified Cardano.Crypto       as Byron
 
+import qualified Cardano.Crypto.Hash                         as HASH
+import qualified Cardano.Crypto.VRF                          as VRF
 import qualified Ouroboros.Consensus.Shelley.Protocol.Crypto as Shelley
+import qualified Shelley.Spec.Ledger.BaseTypes               as Shelley
 import qualified Shelley.Spec.Ledger.Coin                    as Shelley
 import qualified Shelley.Spec.Ledger.Keys                    as Shelley
+import           Shelley.Spec.Ledger.Keys (KeyDiscriminator(..))
 import qualified Shelley.Spec.Ledger.TxData                  as Shelley
 import qualified Shelley.Spec.Ledger.Tx                      as Shelley
 
@@ -88,16 +104,26 @@ type ByronTx              = Byron.TxAux
 type ByronTxId            = Byron.TxId
 type ByronWitness         = Byron.TxInWitness
 
-type ShelleyVerificationKey = Shelley.VKey   Shelley.TPraosStandardCrypto
-type ShelleySigningKey      = Shelley.SKey   Shelley.TPraosStandardCrypto
+type ShelleyCoin                   = Shelley.Coin
+type ShelleyVerificationKey        = Shelley.VKey   Shelley.TPraosStandardCrypto
+type ShelleyVerificationKeyHash    = Shelley.DiscKeyHash 'Regular Shelley.TPraosStandardCrypto
+type ShelleySigningKey             = Shelley.SKey   Shelley.TPraosStandardCrypto
+type ShelleyVRFVerificationKeyHash = Shelley.Hash HASH.Blake2b_256 (Shelley.VerKeyVRF VRF.SimpleVRF)
 type ShelleyAddress         = Shelley.Addr   Shelley.TPraosStandardCrypto
 type ShelleyTxIn            = Shelley.TxIn   Shelley.TPraosStandardCrypto
 type ShelleyTxOut           = Shelley.TxOut  Shelley.TPraosStandardCrypto
 type ShelleyTxBody          = Shelley.TxBody Shelley.TPraosStandardCrypto
 type ShelleyTx              = Shelley.Tx     Shelley.TPraosStandardCrypto
 type ShelleyTxId            = Shelley.TxId   Shelley.TPraosStandardCrypto
 type ShelleyWitnessVKey     = Shelley.WitVKey Shelley.TPraosStandardCrypto
-type ShelleyDelegationCertificate = Shelley.DCert   Shelley.TPraosStandardCrypto
+type ShelleyCertificate           = Shelley.DCert Shelley.TPraosStandardCrypto
+type ShelleyDelegationCertificate = Shelley.DelegCert Shelley.TPraosStandardCrypto
+type ShelleyStakePoolCertificate  = Shelley.PoolCert Shelley.TPraosStandardCrypto
+type ShelleyStakePoolOwners       = Set (Shelley.KeyHash Shelley.TPraosStandardCrypto)
+type ShelleyStakePoolMargin       = Shelley.UnitInterval
+type ShelleyStakePoolMetaData     = Shelley.PoolMetaData
+type ShelleyStakePoolRelay        = Shelley.StakePoolRelay
+type ShelleyRewardAccount         = Shelley.RewardAcnt Shelley.TPraosStandardCrypto
 type ShelleyCredential            = Shelley.Credential Shelley.TPraosStandardCrypto
 
 -- The 'Address' data type in 'cardano-sl' is a design train wreck.
@@ -110,8 +136,9 @@ data Address
 
 
 data Certificate
-  = ByronCertificate
-  | ShelleyDelegationCertificate !ShelleyDelegationCertificate
+  = ShelleyDelegationCertificate !ShelleyCertificate
+  | ShelleyStakePoolCertificate !ShelleyCertificate
+  deriving (Eq, Show)
 
 -- | The combination of a verification key and a signing key.
 --

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

@@ -1,23 +1,27 @@
 module Cardano.Api.View
   ( parseAddressView
+  , parseCertificateView
   , parseSigningKeyView
   , parseVerificationKeyView
   , parseTxSignedView
   , parseTxUnsignedView
 
   , readAddress
+  , readCertificate
   , readSigningKey
   , readVerificationKey
   , readTxSigned
   , readTxUnsigned
 
   , renderAddressView
+  , renderCertificateView
   , renderSigningKeyView
   , renderVerificationKeyView
   , renderTxSignedView
   , renderTxUnsignedView
 
   , writeAddress
+  , writeCertificate
   , writeSigningKey
   , writeVerificationKey
   , writeTxSigned
@@ -42,6 +46,10 @@ parseAddressView :: ByteString -> Either ApiError Address
 parseAddressView bs =
   either convertTextViewError (addressFromCBOR . tvRawCBOR) $ parseTextView bs
 
+parseCertificateView :: ByteString -> Either ApiError Certificate
+parseCertificateView bs =
+  either convertTextViewError (certificateFromCBOR . tvRawCBOR) $ parseTextView bs
+
 parseSigningKeyView :: ByteString -> Either ApiError SigningKey
 parseSigningKeyView bs =
   either convertTextViewError (signingKeyFromCBOR . tvRawCBOR) $ parseTextView bs
@@ -67,6 +75,15 @@ renderAddressView addr =
     cbor :: ByteString
     cbor = addressToCBOR addr
 
+renderCertificateView :: Certificate -> ByteString
+renderCertificateView cert =
+  case cert of
+    ShelleyDelegationCertificate {} -> renderTextView $ TextView "DelegationCertificateShelley" "Free form text" cbor
+    ShelleyStakePoolCertificate {} -> renderTextView $ TextView "StakePoolCertificateShelley" "Free form text" cbor
+  where
+    cbor :: ByteString
+    cbor = certificateToCBOR cert
+
 renderSigningKeyView :: SigningKey -> ByteString
 renderSigningKeyView kp =
   case kp of
@@ -112,6 +129,12 @@ readAddress path =
     bs <- handleIOExceptT (ApiErrorIO path) $ BS.readFile path
     hoistEither $ parseAddressView bs
 
+readCertificate :: FilePath -> IO (Either ApiError Certificate)
+readCertificate path =
+  runExceptT $ do
+    bs <- handleIOExceptT (ApiErrorIO path) $ BS.readFile path
+    hoistEither $ parseCertificateView bs
+
 readSigningKey :: FilePath -> IO (Either ApiError SigningKey)
 readSigningKey path =
   runExceptT $ do
@@ -141,6 +164,11 @@ writeAddress path kp =
   runExceptT .
     handleIOExceptT (ApiErrorIO path) $ BS.writeFile path (renderAddressView kp)
 
+writeCertificate :: FilePath -> Certificate -> IO (Either ApiError ())
+writeCertificate path cert =
+  runExceptT .
+    handleIOExceptT (ApiErrorIO path) $ BS.writeFile path (renderCertificateView cert)
+
 writeSigningKey :: FilePath -> SigningKey -> IO (Either ApiError ())
 writeSigningKey path kp =
   runExceptT .

cardano-api/test/Test/Cardano/Api/CBOR.hs

@@ -27,6 +27,13 @@ prop_AddressShelley_CBOR =
     addr <- H.forAll genVerificationKeyAddressShelley
     H.tripping addr addressToCBOR addressFromCBOR
 
+prop_Certificate_CBOR :: Property
+prop_Certificate_CBOR =
+  H.property $ do
+    addr <- H.forAll genCertificate
+    H.tripping addr certificateToCBOR certificateFromCBOR
+
+
 prop_SigningKey_CBOR :: Property
 prop_SigningKey_CBOR =
   H.property $ do