Propagate typed api in cardano-node and add BlockIssuer to typed api

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

@@ -54,6 +54,10 @@ module Cardano.Api.Typed (
     Crypto.mkSeedFromBytes,
     Crypto.readSeedFromSystemEntropy,
 
+    -- ** Converting keys
+    Shelley.coerceKeyRole,
+    ShelleyBlockIssuerVerificationKey,
+
     -- ** Hashes
     -- | In Cardano most keys are identified by their hash, and hashes are
     -- used in many other places.
@@ -240,6 +244,7 @@ module Cardano.Api.Typed (
     VrfKey,
 
     -- ** Operational certificates
+    BlockIssuerKey(..),
     OperationalCertificate(..),
     OperationalCertificateIssueCounter(..),
     Shelley.KESPeriod(..),
@@ -261,6 +266,8 @@ module Cardano.Api.Typed (
     -- ** Protocol parameter updates
     UpdateProposal,
     ProtocolParametersUpdate(..),
+    EpochNo,
+    NetworkMagic(..),
     makeShelleyUpdateProposal,
   ) where
 
@@ -2024,37 +2031,50 @@ instance Error OperationalCertIssueError where
       --TODO: include key ids
 
 issueOperationalCertificate :: VerificationKey KesKey
-                            -> SigningKey StakePoolKey
+                            -> BlockIssuerKey
                             -> Shelley.KESPeriod
                             -> OperationalCertificateIssueCounter
                             -> Either OperationalCertIssueError
                                       (OperationalCertificate,
                                       OperationalCertificateIssueCounter)
-issueOperationalCertificate (KesVerificationKey kesVKey)
-                            (StakePoolSigningKey poolSKey)
-                            kesPeriod
-                            (OperationalCertificateIssueCounter counter poolVKey)
-    | poolVKey /= poolVKey'
-    = Left (OperationalCertKeyMismatch poolVKey poolVKey')
-
-    | otherwise
-    = Right (OperationalCertificate ocert poolVKey,
-            OperationalCertificateIssueCounter (succ counter) poolVKey)
-  where
-    poolVKey' = getVerificationKey (StakePoolSigningKey poolSKey)
+issueOperationalCertificate
+  (KesVerificationKey kesVKey)
+  (StakePoolBlockIssuer (StakePoolSigningKey sKeyStakePool))
+  kesPeriod
+  (OperationalCertificateIssueCounter counter poolVKey) =
+    let poolSig :: Crypto.SignedDSIGN (Shelley.DSIGN ShelleyCrypto) (Shelley.VerKeyKES ShelleyCrypto, Natural, Shelley.KESPeriod)
+        poolSig = Crypto.signedDSIGN () (kesVKey, counter, kesPeriod) sKeyStakePool
+
+        poolVKey' = getVerificationKey (StakePoolSigningKey sKeyStakePool)
+
+        ocert :: Shelley.OCert ShelleyCrypto
+        ocert = Shelley.OCert kesVKey counter kesPeriod poolSig
+
+    in if poolVKey' /= poolVKey
+       then Left $ OperationalCertKeyMismatch poolVKey poolVKey'
+       else Right $ (OperationalCertificate ocert poolVKey, OperationalCertificateIssueCounter (succ counter) poolVKey)
 
-    ocert     :: Shelley.OCert ShelleyCrypto
-    ocert     = Shelley.OCert kesVKey counter kesPeriod signature
+issueOperationalCertificate
+  (KesVerificationKey kesVKey)
+  (GenesisDelegateBlockIssuer (GenesisDelegateSigningKey sKeyGenDelegKey))
+  kesPeriod
+  (OperationalCertificateIssueCounter counter poolVKey) =
+    let genDelegSig :: Crypto.SignedDSIGN (Shelley.DSIGN ShelleyCrypto) (Shelley.VerKeyKES ShelleyCrypto, Natural, Shelley.KESPeriod)
+        genDelegSig = Crypto.signedDSIGN () (kesVKey, counter, kesPeriod) sKeyGenDelegKey
 
-    signature :: Crypto.SignedDSIGN
-                   (Shelley.DSIGN ShelleyCrypto)
-                   (Shelley.VerKeyKES ShelleyCrypto,
-                    Natural,
-                    Shelley.KESPeriod)
-    signature = Crypto.signedDSIGN ()
-                  (kesVKey, counter, kesPeriod)
-                  poolSKey
+        poolVKey' = castVerificationKey $ getVerificationKey (GenesisDelegateSigningKey sKeyGenDelegKey)
 
+        ocert :: Shelley.OCert ShelleyCrypto
+        ocert = Shelley.OCert kesVKey counter kesPeriod genDelegSig
+
+    in if poolVKey' /= poolVKey
+       then Left $ OperationalCertKeyMismatch poolVKey poolVKey'
+       else Right (OperationalCertificate ocert poolVKey, OperationalCertificateIssueCounter (succ counter) poolVKey)
+
+
+data BlockIssuerKey
+  = StakePoolBlockIssuer (SigningKey StakePoolKey)
+  | GenesisDelegateBlockIssuer (SigningKey GenesisDelegateKey)
 
 -- ----------------------------------------------------------------------------
 -- Node IPC protocols
@@ -2853,7 +2873,6 @@ instance HasTextEnvelope (SigningKey StakePoolKey) where
     textEnvelopeType _ = "Node operator signing key"
     -- TODO: include the actual crypto algorithm name, to catch changes
 
-
 --
 -- KES keys
 --
@@ -2999,3 +3018,5 @@ backCompatAlgorithmNameVrf p =
 (?!) :: Maybe a -> e -> Either e a
 Nothing ?! e = Left e
 Just x  ?! _ = Right x
+
+type ShelleyBlockIssuerVerificationKey = Shelley.VKey Shelley.BlockIssuer Shelley.TPraosStandardCrypto

cardano-api/test/Test/Cardano/Api/Typed/Gen.hs

@@ -33,6 +33,11 @@ genAddressShelley =
     , makeByronAddress <$> genVerificationKey AsByronKey <*> genNetworkId
     ]
 
+genBlockIssuerSignKey :: Gen BlockIssuerKey
+genBlockIssuerSignKey = Gen.choice [ StakePoolBlockIssuer <$> genSigningKey AsStakePoolKey
+                                   , GenesisDelegateBlockIssuer <$> genSigningKey AsGenesisDelegateKey
+                                   ]
+
 genKESPeriod :: Gen KESPeriod
 genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
 
@@ -55,13 +60,15 @@ genOperationalCertificateIssueCounter = snd <$> genOperationalCertificateWithCou
 genOperationalCertificateWithCounter :: Gen (OperationalCertificate, OperationalCertificateIssueCounter)
 genOperationalCertificateWithCounter = do
   kesVKey <- genVerificationKey AsKesKey
-  stakePoolSign <- genSigningKey AsStakePoolKey
+  blockIssuerSignKey <- genBlockIssuerSignKey
   kesP <- genKESPeriod
   c <- Gen.integral $ Range.linear 0 1000
-  let stakePoolVer = getVerificationKey stakePoolSign
-      iCounter = OperationalCertificateIssueCounter c stakePoolVer
+  stakePoolVer <- case blockIssuerSignKey of
+                   StakePoolBlockIssuer sKeyStakePool -> return  $ getVerificationKey sKeyStakePool
+                   GenesisDelegateBlockIssuer sKeyGenDeleg -> return . castVerificationKey $ getVerificationKey sKeyGenDeleg
+  let iCounter = OperationalCertificateIssueCounter c stakePoolVer
 
-  case issueOperationalCertificate kesVKey stakePoolSign kesP iCounter of
+  case issueOperationalCertificate kesVKey blockIssuerSignKey kesP iCounter of
     -- This case should be impossible as we clearly derive the verification
     -- key from the generated signing key.
     Left err -> fail $ displayError err

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

@@ -52,8 +52,8 @@ import qualified Shelley.Spec.Ledger.TxData as Shelley
 import           Cardano.Api.Shelley.Address (ShelleyAddress)
 import           Cardano.Api.Shelley.ColdKeys (KeyRole (..), OperatorKeyRole (..),
                     readVerKey)
-import           Cardano.Api.Shelley.Genesis
 import           Cardano.Api.Shelley.ColdKeys
+import           Cardano.Api.Shelley.Genesis
 import           Cardano.Api.Shelley.OCert
 import           Cardano.Api.Shelley.VRF
 import           Cardano.Api.TextView (TextViewTitle (..))

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

@@ -1,5 +1,6 @@
 module Cardano.CLI.Shelley.Run.Node
-  ( ShelleyNodeCmdError
+  ( BlockIssuerKey(..)
+  , ShelleyNodeCmdError
   , renderShelleyNodeCmdError
   , runNodeCmd
   ) where
@@ -11,12 +12,13 @@ import           Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, ne
 
 import qualified Data.Text as Text
 
-import           Cardano.Api.Typed (AsType (..), Error (..), FileError,
+import           Cardano.Api.Typed (AsType (..), BlockIssuerKey(..),
+                   Error (..), FileError, FromSomeType(..), HasTextEnvelope,
                    KESPeriod, OperationalCertificateIssueCounter (..),
                    OperationalCertIssueError, TextEnvelopeError,
                    generateSigningKey, getVerificationKey,
-                   issueOperationalCertificate, readFileTextEnvelope,
-                   writeFileTextEnvelope)
+                   issueOperationalCertificate, readFileTextEnvelopeAnyOf,
+                   readFileTextEnvelope, writeFileTextEnvelope)
 
 import           Cardano.Api.TextView (TextViewTitle (..))
 import           Cardano.Config.Types (SigningKeyFile(..))
@@ -141,16 +143,16 @@ runNodeIssueOpCert (VerificationKeyFile vkeyKesPath)
       . newExceptT
       $ readFileTextEnvelope (AsVerificationKey AsKesKey) vkeyKesPath
 
-    signKeyStakePool <- firstExceptT ShelleyNodeReadFileError
+    signKey <- firstExceptT ShelleyNodeReadFileError
       . newExceptT
-      $ readFileTextEnvelope (AsSigningKey AsStakePoolKey) skeyStakePoolPath
+      $ readFileTextEnvelopeAnyOf possibleBlockIssuers skeyStakePoolPath
 
     (ocert, nextOcertCtr) <-
       firstExceptT ShelleyNodeOperationalCertificateIssueError
         . hoistEither
         $ issueOperationalCertificate
             verKeyKes
-            signKeyStakePool
+            signKey
             kesPeriod
             ocertIssueCounter
 
@@ -172,3 +174,8 @@ runNodeIssueOpCert (VerificationKeyFile vkeyKesPath)
 
     ocertCtrDesc :: Natural -> TextViewTitle
     ocertCtrDesc n = TextViewTitle $ "Next certificate issue number: " <> show n
+
+    possibleBlockIssuers :: [FromSomeType HasTextEnvelope BlockIssuerKey]
+    possibleBlockIssuers = [ FromSomeType (AsSigningKey AsStakePoolKey) StakePoolBlockIssuer
+                           , FromSomeType (AsSigningKey AsGenesisDelegateKey) GenesisDelegateBlockIssuer
+                           ]

cardano-config/cardano-config.cabal

@@ -62,7 +62,6 @@ library
                      , directory
                      , file-embed
                      , filepath
-                     , generic-monoid
                      , iohk-monitoring
                      , lobemo-backend-aggregation
                      , lobemo-backend-ekg
@@ -80,19 +79,16 @@ library
                      , ouroboros-network-framework
                      , process
                      , iproute
-                     , safe-exceptions
                      , scientific
                      , shelley-spec-ledger
                      , string-conv
                      , stm
                      , template-haskell
                      , text
-                     , time
                      , transformers
                      , transformers-except
                      , typed-protocols
                      , unordered-containers
-                     , yaml
 
   default-language:    Haskell2010
   default-extensions:  NoImplicitPrelude

cardano-config/src/Cardano/Config/Parsers.hs

@@ -31,7 +31,6 @@ import           Prelude (String)
 import           Cardano.Prelude hiding (option)
 
 import           Cardano.Chain.Common (Lovelace, mkLovelace)
---import           Cardano.Node.Topology
 import           Cardano.Config.Types
 
 

cardano-node/cardano-node.cabal

@@ -36,13 +36,13 @@ library
   exposed-modules:     Cardano.Common.Help
                        Cardano.Node.Features.Node
                        Cardano.Node.Logging
+                       Cardano.Node.Parsers
                        Cardano.Node.Protocol
                        Cardano.Node.Protocol.Byron
                        Cardano.Node.Protocol.Cardano
                        Cardano.Node.Protocol.Mock
                        Cardano.Node.Protocol.Shelley
                        Cardano.Node.Protocol.Types
-                       Cardano.Node.Parsers
                        Cardano.Node.Run
                        Cardano.Node.Shutdown
                        Cardano.Node.Topology
@@ -83,7 +83,7 @@ library
                      , lobemo-backend-trace-forwarder
                      , network
                      , network-mux
-                     , node-config
+                     , cardano-node-config
                      , optparse-applicative
                      , ouroboros-consensus
                      , ouroboros-consensus-byron
@@ -127,7 +127,7 @@ library
                      , Cardano.Node.TUI.Run
 
 
-library node-config
+library cardano-node-config
 
   hs-source-dirs:      src
 
@@ -210,7 +210,7 @@ executable chairman
                      , cardano-prelude
                      , io-sim-classes
                      , network-mux
-                     , node-config
+                     , cardano-node-config
                      , optparse-applicative
                      , ouroboros-consensus
                      , ouroboros-consensus-cardano

cardano-node/chairman/chairman.hs

@@ -16,7 +16,7 @@ import           Ouroboros.Consensus.BlockchainTime (SlotLength, slotLengthFromS
 import           Ouroboros.Consensus.Cardano (SecurityParam(..))
 import           Ouroboros.Network.Block (BlockNo)
 
-import           Cardano.Api (NetworkMagic(..))
+import           Cardano.Api.Typed (NetworkMagic(..))
 import           Cardano.Api.Protocol (mkNodeClientProtocol)
 import           Cardano.Config.Types (SocketPath(..))
 import           Cardano.Node.Types (ConfigYamlFilePath(..),

cardano-node/src/Cardano/Node/Protocol.hs

@@ -13,9 +13,9 @@ import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
 
 import           Cardano.Api.Protocol (MockProtocol(..))
+import           Cardano.Config.Types (ProtocolFilepaths(..))
 import           Cardano.Node.Types (NodeConfiguration(..), NodeProtocolConfiguration(..),
                     NodeMockProtocolConfiguration(..))
-import           Cardano.Config.Types (ProtocolFilepaths(..))
 
 import           Cardano.Node.Protocol.Types (SomeConsensusProtocol(..))
 import           Cardano.Node.Protocol.Mock

cardano-node/src/Cardano/Node/Protocol/Shelley.hs

@@ -24,7 +24,7 @@ import           Cardano.Prelude
 import           Prelude (String)
 
 import           Control.Monad.Trans.Except (ExceptT)
-import           Control.Monad.Trans.Except.Extra (firstExceptT)
+import           Control.Monad.Trans.Except.Extra (firstExceptT, newExceptT)
 import qualified Data.Text as T
 
 import qualified Data.Aeson as Aeson
@@ -39,9 +39,7 @@ import           Ouroboros.Consensus.Shelley.Node
 
 import           Shelley.Spec.Ledger.PParams (ProtVer(..))
 
-import           Cardano.Api.Shelley.OCert
-import           Cardano.Api.Shelley.VRF
-import           Cardano.Api.Shelley.KES
+import qualified Cardano.Api.Typed as Typed
 import           Cardano.Node.Types (NodeShelleyProtocolConfiguration(..))
 import           Cardano.Config.Types
                    (ProtocolFilepaths(..), GenesisFile (..))
@@ -130,19 +128,24 @@ readLeaderCredentials (Just ProtocolFilepaths {
                               shelleyKESFile  = Just kesFile
                             }) = do
 
-    (opcert, vkey) <- firstExceptT OCertError $ readOperationalCert certFile
-    vrfKey <- firstExceptT VRFError $ readVRFSigningKey vrfFile
-    kesKey <- firstExceptT KESError $ readKESSigningKey kesFile
-
-    return $ Just TPraosLeaderCredentials {
-               tpraosLeaderCredentialsIsCoreNode =
-                 TPraosIsCoreNode {
-                   tpraosIsCoreNodeOpCert     = opcert,
-                   tpraosIsCoreNodeColdVerKey = vkey,
-                   tpraosIsCoreNodeSignKeyVRF = vrfKey
-                 },
-               tpraosLeaderCredentialsSignKey = kesKey
-             }
+    Typed.OperationalCertificate opcert (Typed.StakePoolVerificationKey vkey) <-
+      firstExceptT FileError . newExceptT $ Typed.readFileTextEnvelope Typed.AsOperationalCertificate certFile
+    Typed.VrfSigningKey vrfKey <-
+      firstExceptT FileError . newExceptT $ Typed.readFileTextEnvelope (Typed.AsSigningKey Typed.AsVrfKey) vrfFile
+    Typed.KesSigningKey kesKey <-
+      firstExceptT FileError . newExceptT $ Typed.readFileTextEnvelope (Typed.AsSigningKey Typed.AsKesKey) kesFile
+
+    let biVerKey = Typed.coerceKeyRole vkey :: Typed.ShelleyBlockIssuerVerificationKey
+
+    return $ Just TPraosLeaderCredentials
+                    { tpraosLeaderCredentialsIsCoreNode =
+                        TPraosIsCoreNode
+                          { tpraosIsCoreNodeOpCert     = opcert
+                          , tpraosIsCoreNodeColdVerKey = biVerKey
+                          , tpraosIsCoreNodeSignKeyVRF = vrfKey
+                          }
+                    , tpraosLeaderCredentialsSignKey = kesKey
+                    }
 
 -- But not ok to supply some of the files without the others.
 readLeaderCredentials (Just ProtocolFilepaths {shelleyCertFile = Nothing}) =
@@ -158,9 +161,7 @@ readLeaderCredentials (Just ProtocolFilepaths {shelleyKESFile = Nothing}) =
 --
 
 data ShelleyProtocolInstantiationError = GenesisReadError !FilePath !String
-                                       | OCertError OperationalCertError
-                                       | VRFError VRFError
-                                       | KESError KESError
+                                       | FileError (Typed.FileError Typed.TextEnvelopeError)
 
                                        | OCertNotSpecified
                                        | VRFKeyNotSpecified
@@ -176,9 +177,7 @@ renderShelleyProtocolInstantiationError pie =
         "There was an error parsing the genesis file: "
      <> toS fp <> " Error: " <> (T.pack $ show err)
 
-    KESError   err -> renderKESError err
-    VRFError   err -> renderVRFError err
-    OCertError err -> T.pack $ show err --TODO: renderOperationalCertError
+    FileError fileErr -> T.pack $ Typed.displayError fileErr
 
     OCertNotSpecified  -> missingFlagMessage "shelley-operational-certificate"
     VRFKeyNotSpecified -> missingFlagMessage "shelley-vrf-key"

cardano-node/src/Cardano/Node/Types.hs

@@ -27,7 +27,7 @@ import           Data.Yaml (decodeFileThrow)
 import           System.FilePath ((</>), takeDirectory)
 import           System.Posix.Types (Fd)
 
-import           Cardano.Api
+import           Cardano.Api.Typed (EpochNo)
 import           Cardano.Api.Protocol
 import           Cardano.Config.Types
 import           Cardano.Crypto (RequiresNetworkMagic(..))