Implement creation of registration and retirement stake pool certific…

…ates

Integrate delegation and stake pool certificates in `buildShelleyTransaction`

cardano-api/cardano-api.cabal

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

cardano-api/src/Cardano/Api.hs

@@ -52,10 +52,25 @@ module Cardano.Api
   , queryFilteredUTxOFromLocalState
   , queryPParamsFromLocalState
 
-  -- Delegation Certificate Related
+  , ShelleyCredentialStaking
+  , ShelleyRewardAccount
+  , ShelleyStakePoolMetaData
+  , ShelleyStakePoolOwners
+  , ShelleyStakePoolRelay
+  , ShelleyVerificationKeyHashStaking
+  , ShelleyVerificationKeyHashStakePool
+  , ShelleyVerificationKeyStakePool
+  , ShelleyVerificationKeyStaking
+  , ShelleyVRFVerificationKeyHash
+  , mkShelleyStakingCredential
+
+  -- * Shelley Delegation Certificate Related
+  , Certificate(..)
   , shelleyDeregisterStakingAddress
   , shelleyDelegateStake
   , shelleyRegisterStakingAddress
+  , shelleyRegisterStakePool
+  , shelleyRetireStakePool
   ) where
 
 import           Cardano.Prelude
@@ -93,6 +108,7 @@ import qualified Cardano.Chain.UTxO    as Byron
 
 import qualified Ouroboros.Consensus.Shelley.Protocol.Crypto 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
@@ -111,6 +127,57 @@ shelleyGenSigningKey = do
     dsignProxy :: Proxy (Shelley.DSIGN Shelley.TPraosStandardCrypto)
     dsignProxy = Proxy
 
+-- | Register a shelley staking pool.
+shelleyRegisterStakePool
+  :: ShelleyVerificationKeyHashStakePool
+  -- ^ Pool public key hash.
+  -> ShelleyVRFVerificationKeyHash
+  -- ^ VRF verification key hash.
+  -> ShelleyCoin
+  -- ^ Pool pledge.
+  -> ShelleyCoin
+  -- ^ Pool cost.
+  -> ShelleyStakePoolMargin
+  -- ^ Pool margin.
+  -> ShelleyRewardAccount
+  -- ^ Pool reward account.
+  -> ShelleyStakePoolOwners
+  -- ^ Pool owners.
+  -> [Shelley.StakePoolRelay]
+  -- ^ Pool relays.
+  -> Maybe 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 = Seq.fromList relays
+      poolMetaData = Shelley.maybeToStrictMaybe 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 :: ShelleyVerificationKeyStakePool -> Shelley.EpochNo -> Certificate
+shelleyRetireStakePool vKey eNo =
+  ShelleyStakePoolCertificate . Shelley.DCertPool $ Shelley.RetirePool (Shelley.hashKey vKey) eNo
+
+
 -- | Register a shelley staking key.
 shelleyRegisterStakingAddress
   :: ShelleyVerificationKeyHashStaking
@@ -210,19 +277,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 = [ 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 -> ShelleyCertificate
+   certDiscrim (ShelleyDelegationCertificate delegCert) = delegCert
+   certDiscrim (ShelleyStakePoolCertificate sPoolCert) = 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
@@ -57,6 +59,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

@@ -43,13 +43,25 @@ module Cardano.Api.Types
   , toByronLovelace
 
     -- ** Shelley
+  , ShelleyCertificate
+  , ShelleyCoin
+  , ShelleyStakePoolMargin
+  , ShelleyStakePoolCertificate
+  , ShelleyStakePoolMetaData
+  , ShelleyStakePoolOwners
+  , ShelleyStakePoolRelay
   , ShelleyVerificationKey
   , ShelleyVerificationKeyHashStaking
   , ShelleyVerificationKeyHashStakePool
+  , ShelleyVerificationKeyStakePool
+  , ShelleyVerificationKeyStaking
   , ShelleySigningKey
+  , ShelleyVRFVerificationKeyHash
   , ShelleyAddress
   , ShelleyCredentialStaking
   , ShelleyCredentialStakePool
+  , ShelleyDelegationCertificate
+  , ShelleyRewardAccount
   , ShelleyTxBody
   , ShelleyTx
   , ShelleyTxId
@@ -76,7 +88,10 @@ 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 qualified Shelley.Spec.Ledger.TxData                  as Shelley
@@ -93,11 +108,16 @@ type ByronTx              = Byron.TxAux
 type ByronTxId            = Byron.TxId
 type ByronWitness         = Byron.TxInWitness
 
+type ShelleyCertificate                  = Shelley.DCert Shelley.TPraosStandardCrypto
+type ShelleyCoin                         = Shelley.Coin
 type ShelleyCredentialStaking            = Shelley.Credential Shelley.Staking Shelley.TPraosStandardCrypto
 type ShelleyCredentialStakePool          = Shelley.Credential Shelley.StakePool Shelley.TPraosStandardCrypto
 type ShelleyVerificationKey              = Shelley.VKey Shelley.Payment Shelley.TPraosStandardCrypto
+type ShelleyVerificationKeyStaking       = Shelley.VKey Shelley.Staking Shelley.TPraosStandardCrypto
+type ShelleyVerificationKeyStakePool     = Shelley.VKey Shelley.StakePool Shelley.TPraosStandardCrypto
 type ShelleyVerificationKeyHashStaking   = Shelley.KeyHash Shelley.Staking Shelley.TPraosStandardCrypto
 type ShelleyVerificationKeyHashStakePool = Shelley.KeyHash Shelley.StakePool Shelley.TPraosStandardCrypto
+type ShelleyVRFVerificationKeyHash       = Shelley.Hash   Shelley.TPraosStandardCrypto (Shelley.VerKeyVRF Shelley.TPraosStandardCrypto)
 type ShelleySigningKey                   = Shelley.SignKeyDSIGN Shelley.TPraosStandardCrypto
 type ShelleyAddress                      = Shelley.Addr   Shelley.TPraosStandardCrypto
 type ShelleyTxIn                         = Shelley.TxIn   Shelley.TPraosStandardCrypto
@@ -108,6 +128,13 @@ type ShelleyTxId                         = Shelley.TxId   Shelley.TPraosStandard
 type ShelleyWitnessVKey                  = Shelley.WitVKey Shelley.TPraosStandardCrypto
 type ShelleyDelegationCertificate        = Shelley.DCert      Shelley.TPraosStandardCrypto
 
+type ShelleyStakePoolCertificate         = Shelley.PoolCert Shelley.TPraosStandardCrypto
+type ShelleyStakePoolOwners              = Set (Shelley.KeyHash Shelley.Staking Shelley.TPraosStandardCrypto)
+type ShelleyStakePoolMargin              = Shelley.UnitInterval
+type ShelleyStakePoolMetaData            = Shelley.PoolMetaData
+type ShelleyStakePoolRelay               = Shelley.StakePoolRelay
+type ShelleyRewardAccount                = Shelley.RewardAcnt     Shelley.TPraosStandardCrypto
+
 -- The 'Address' data type in 'cardano-sl' is a design train wreck.
 -- We need something that is compatible and discard as much of the insanity as possible.
 data Address
@@ -118,7 +145,9 @@ data Address
 
 
 data Certificate
-  = 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 =
   addressFromCBOR . tvRawCBOR =<< first ApiTextView (parseTextView bs)
 
+parseCertificateView :: ByteString -> Either ApiError Certificate
+parseCertificateView bs =
+  certificateFromCBOR . tvRawCBOR =<< first ApiTextView (parseTextView bs)
+
 parseSigningKeyView :: ByteString -> Either ApiError SigningKey
 parseSigningKeyView bs =
   signingKeyFromCBOR . tvRawCBOR =<< first ApiTextView (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