Merge #2127 #2130

2127: CAD-2337 API extensions for address and credentials r=deepfire a=deepfire - `toAddressAny :: Address addr -> AddressAny` - `fromShelleyPaymentCredential :: Shelley.PaymentCredential StandardShelley -> PaymentCredential` - `fromShelleyStakeReference :: Shelley.StakeReference StandardShelley -> StakeAddressReference` - export `fromShelleyStakeCredential` 2130: Testnet with more configurable parameters r=newhoggy a=newhoggy Co-authored-by: Kosyrev Serge <serge.kosyrev@iohk.io> Co-authored-by: John Ky <john.ky@iohk.io>
IntersectMBO · Nov 26, 2020 · 63ba413 · 63ba413
3 parents 16d8e8e + 8c1afb3 + 20f5309
commit 63ba413
Show file tree

Hide file tree

Showing 11 changed files with 122 additions and 71 deletions.
diff --git a/cardano-api/src/Cardano/API.hs b/cardano-api/src/Cardano/API.hs
@@ -79,6 +79,7 @@ module Cardano.API (
     shelleyAddressInEra,
     anyAddressInShelleyBasedEra,
     anyAddressInEra,
+    toAddressAny,
     makeByronAddressInEra,
     makeShelleyAddressInEra,
 

diff --git a/cardano-api/src/Cardano/Api/Address.hs b/cardano-api/src/Cardano/Api/Address.hs
@@ -32,6 +32,7 @@ module Cardano.Api.Address (
     shelleyAddressInEra,
     anyAddressInShelleyBasedEra,
     anyAddressInEra,
+    toAddressAny,
     makeByronAddressInEra,
     makeShelleyAddressInEra,
 
@@ -48,8 +49,10 @@ module Cardano.Api.Address (
     toShelleyStakeAddr,
     toShelleyStakeCredential,
     fromShelleyAddr,
+    fromShelleyPaymentCredential,
     fromShelleyStakeAddr,
     fromShelleyStakeCredential,
+    fromShelleyStakeReference,
 
     -- * Serialising addresses
     SerialiseAddress(..),
@@ -389,6 +392,9 @@ anyAddressInEra (AddressShelley addr) =
       LegacyByronEra      -> Nothing
       ShelleyBasedEra era -> Just (AddressInEra (ShelleyAddressInEra era) addr)
 
+toAddressAny :: Address addr -> AddressAny
+toAddressAny a@ShelleyAddress{} = AddressShelley a
+toAddressAny a@ByronAddress{}   = AddressByron a
 
 makeByronAddressInEra :: NetworkId
                       -> VerificationKey ByronKey
@@ -550,6 +556,21 @@ fromShelleyStakeCredential (Shelley.KeyHashObj kh) =
 fromShelleyStakeCredential (Shelley.ScriptHashObj sh) =
     StakeCredentialByScript (fromShelleyScriptHash sh)
 
+fromShelleyPaymentCredential :: Shelley.PaymentCredential StandardShelley
+                             -> PaymentCredential
+fromShelleyPaymentCredential (Shelley.KeyHashObj kh) =
+  PaymentCredentialByKey (PaymentKeyHash kh)
+fromShelleyPaymentCredential (Shelley.ScriptHashObj sh) =
+  PaymentCredentialByScript (ScriptHash sh)
+
+fromShelleyStakeReference :: Shelley.StakeReference StandardShelley
+                          -> StakeAddressReference
+fromShelleyStakeReference (Shelley.StakeRefBase stakecred) =
+  StakeAddressByValue (fromShelleyStakeCredential stakecred)
+fromShelleyStakeReference (Shelley.StakeRefPtr ptr) =
+  StakeAddressByPointer ptr
+fromShelleyStakeReference Shelley.StakeRefNull =
+  NoStakeAddress
 
 -- The era parameter in these types is a phantom type so it is safe to cast.
 -- We choose to cast because we need to use an era-independent address
@@ -566,4 +587,3 @@ coerceShelleyStakeCredential = coerce
 coerceShelleyStakeReference :: Shelley.StakeReference eraA
                             -> Shelley.StakeReference eraB
 coerceShelleyStakeReference = coerce
-
diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs
@@ -78,6 +78,11 @@ module Cardano.Api.Shelley
     EpochNo(..),
     NetworkMagic(..),
 
+    -- * Credentials & stake references
+    fromShelleyPaymentCredential,
+    fromShelleyStakeCredential,
+    fromShelleyStakeReference,
+
     -- * Scripts
     -- | Both 'PaymentCredential's and 'StakeCredential's can use scripts.
     -- Shelley supports multi-signatures via scripts.

diff --git a/cardano-api/src/Cardano/Api/Typed.hs b/cardano-api/src/Cardano/Api/Typed.hs
@@ -95,6 +95,7 @@ module Cardano.Api.Typed (
     shelleyAddressInEra,
     anyAddressInShelleyBasedEra,
     anyAddressInEra,
+    toAddressAny,
     makeByronAddressInEra,
     makeShelleyAddressInEra,
 

diff --git a/cardano-node-chairman/src/Testnet/Byron.hs b/cardano-node-chairman/src/Testnet/Byron.hs
@@ -9,11 +9,7 @@ module Testnet.Byron
   ) where
 
 import           Control.Monad
-import           Control.Monad.IO.Class
-import           Data.Aeson (Value, toJSON, (.=))
-import           Data.Bool
-import           Data.Either
-import           Data.Eq
+import           Data.Aeson (Value, (.=))
 import           Data.Function
 import           Data.Functor
 import           Data.Int
@@ -60,7 +56,7 @@ rewriteConfiguration s = s
 
 rewriteParams :: Value -> Value
 rewriteParams = rewriteObject
-  $ HM.insert "slotDuration" (toJSON @String "2000")
+  $ HM.insert "slotDuration" (J.toJSON @String "2000")
 
 testnet :: H.Conf -> H.Integration [String]
 testnet H.Conf {..} = do
@@ -69,7 +65,7 @@ testnet H.Conf {..} = do
   baseConfig <- H.noteShow $ base </> "configuration/chairman/defaults/simpleview"
   currentTime <- H.noteShowIO DTC.getCurrentTime
   startTime <- H.noteShow $ DTC.addUTCTime 15 currentTime -- 15 seconds into the future
-  allPorts <- H.noteShowIO $ IO.allocateRandomPorts 3
+  allPorts <- H.noteShowIO $ IO.allocateRandomPorts nodeCount
 
   H.copyRewriteJsonFile
     (base </> "scripts/protocol-params.json")
@@ -85,7 +81,7 @@ testnet H.Conf {..} = do
     , "--k", "10"
     , "--protocol-magic", show @Int testnetMagic
     , "--n-poor-addresses", "128"
-    , "--n-delegate-addresses", "3"
+    , "--n-delegate-addresses", show @Int nodeCount
     , "--total-balance", "8000000000000000"
     , "--avvm-entry-count", "128"
     , "--avvm-entry-balance", "10000000000000"
@@ -126,16 +122,16 @@ testnet H.Conf {..} = do
     H.lbsWriteFile (tempAbsPath </> "topology-node-" <> si <> ".json") $ J.encode $
       J.object
       [ ( "Producers"
-        , toJSON
+        , J.toJSON
           [ J.object
             [ ("addr", "127.0.0.1")
-            , ("valency", toJSON @Int 1)
-            , ("port", toJSON (otherPorts L.!! 0))
+            , ("valency", J.toJSON @Int 1)
+            , ("port", J.toJSON (otherPorts L.!! 0))
             ]
           , J.object
             [ ("addr", "127.0.0.1")
-            , ("valency", toJSON @Int 1)
-            , ("port", toJSON (otherPorts L.!! 1))
+            , ("valency", J.toJSON @Int 1)
+            , ("port", J.toJSON (otherPorts L.!! 1))
             ]
           ]
         )

diff --git a/cardano-node-chairman/src/Testnet/ByronShelley.hs b/cardano-node-chairman/src/Testnet/ByronShelley.hs
@@ -11,7 +11,7 @@
 
 module Testnet.ByronShelley
   ( TestnetOptions(..)
-  , emptyTestnetOptions
+  , defaultTestnetOptions
 
   , testnet
   ) where
@@ -71,14 +71,14 @@ import qualified Testnet.Conf as H
 {- HLINT ignore "Redundant flip" -}
 
 data TestnetOptions = TestnetOptions
-  { maybeActiveSlotsCoeff :: Maybe Double
-  , maybeEpochLength :: Maybe Int
+  { activeSlotsCoeff :: Double
+  , epochLength :: Int
   } deriving (Eq, Show)
 
-emptyTestnetOptions :: TestnetOptions
-emptyTestnetOptions = TestnetOptions
-  { maybeActiveSlotsCoeff = Nothing
-  , maybeEpochLength = Nothing
+defaultTestnetOptions :: TestnetOptions
+defaultTestnetOptions = TestnetOptions
+  { activeSlotsCoeff = 0.1
+  , epochLength = 1500
   }
 
 ifaceAddress :: String
@@ -334,9 +334,9 @@ testnet testnetOptions H.Conf {..} = do
   -- cycling KES keys
   H.rewriteJsonFile (tempAbsPath </> "shelley/genesis.spec.json") . J.rewriteObject
     $ HM.insert "slotLength" (J.toJSON @Double 0.2)
-    . HM.insert "activeSlotsCoeff" (J.toJSON @Double (fromMaybe 0.1 (maybeActiveSlotsCoeff testnetOptions)))
+    . HM.insert "activeSlotsCoeff" (J.toJSON @Double (activeSlotsCoeff testnetOptions))
     . HM.insert "securityParam" (J.toJSON @Int 10)
-    . HM.insert "epochLength" (J.toJSON @Int (fromMaybe 1500 (maybeEpochLength testnetOptions)))
+    . HM.insert "epochLength" (J.toJSON @Int (epochLength testnetOptions))
     . HM.insert "slotLength" (J.toJSON @Double 0.2)
     . HM.insert "maxLovelaceSupply" (J.toJSON @Int maxSupply)
     . flip HM.adjust "protocolParams"

diff --git a/cardano-node-chairman/src/Testnet/Shelley.hs b/cardano-node-chairman/src/Testnet/Shelley.hs
@@ -9,15 +9,17 @@
 
 module Testnet.Shelley
   ( TestnetOptions(..)
-  , emptyTestnetOptions
+  , defaultTestnetOptions
 
   , testnet
   , hprop_testnet
   , hprop_testnet_pause
   ) where
 
 #ifdef UNIX
-import           Prelude (map)
+import           Prelude (map, Integer)
+#else
+import           Prelude (Integer)
 #endif
 
 import           Control.Monad
@@ -72,34 +74,40 @@ import qualified Testnet.Conf as H
 {- HLINT ignore "Redundant flip" -}
 
 data TestnetOptions = TestnetOptions
-  { maybeActiveSlotsCoeff :: Maybe Double
-  , maybeEpochLength :: Maybe Int
+  { activeSlotsCoeff :: Double
+  , securityParam :: Int
+  , epochLength :: Int
+  , slotLength :: Double
+  , maxLovelaceSupply :: Integer
   } deriving (Eq, Show)
 
-emptyTestnetOptions :: TestnetOptions
-emptyTestnetOptions = TestnetOptions
-  { maybeActiveSlotsCoeff = Nothing
-  , maybeEpochLength = Nothing
+defaultTestnetOptions :: TestnetOptions
+defaultTestnetOptions = TestnetOptions
+  { activeSlotsCoeff = 0.1
+  , securityParam = 10
+  , epochLength = 1000
+  , slotLength = 0.2
+  , maxLovelaceSupply = 1000000000
   }
 
 ifaceAddress :: String
 ifaceAddress = "127.0.0.1"
 
-rewriteGenesisSpec :: TestnetOptions -> UTCTime -> Int -> Value -> Value
-rewriteGenesisSpec testnetOptions startTime supply =
+rewriteGenesisSpec :: TestnetOptions -> UTCTime -> Value -> Value
+rewriteGenesisSpec testnetOptions startTime =
   rewriteObject
-    $ HM.insert "activeSlotsCoeff" (toJSON @Double (fromMaybe 0.1 (maybeActiveSlotsCoeff testnetOptions)))
-    . HM.insert "securityParam" (toJSON @Int 10)
-    . HM.insert "epochLength" (J.toJSON @Int (fromMaybe 1000 (maybeEpochLength testnetOptions)))
-    . HM.insert "slotLength" (toJSON @Double 0.2)
-    . HM.insert "maxLovelaceSupply" (toJSON supply)
-    . HM.insert "systemStart" (toJSON @String (DTC.formatIso8601 startTime))
+    $ HM.insert "activeSlotsCoeff" (J.toJSON @Double (activeSlotsCoeff testnetOptions))
+    . HM.insert "securityParam" (J.toJSON @Int (securityParam testnetOptions))
+    . HM.insert "epochLength" (J.toJSON @Int (epochLength testnetOptions))
+    . HM.insert "slotLength" (J.toJSON @Double (slotLength testnetOptions))
+    . HM.insert "maxLovelaceSupply" (J.toJSON @Integer (maxLovelaceSupply testnetOptions))
+    . HM.insert "systemStart" (J.toJSON @String (DTC.formatIso8601 startTime))
     . flip HM.adjust "protocolParams"
       ( rewriteObject (HM.insert "decentralisationParam" (toJSON @Double 0.7))
       )
 
 testnet :: TestnetOptions -> H.Conf -> H.Integration [String]
-testnet testOptions H.Conf {..} = do
+testnet testnetOptions H.Conf {..} = do
   void $ H.note OS.os
 
   let praosNodes = ["node-praos1", "node-praos2"] :: [String]
@@ -129,13 +137,12 @@ testnet testOptions H.Conf {..} = do
     ]
 
   -- Then edit the genesis.spec.json ...
-  let supply = 1000000000
 
   -- We're going to use really quick epochs (300 seconds), by using short slots 0.2s
   -- and K=10, but we'll keep long KES periods so we don't have to bother
   -- cycling KES keys
-  H.rewriteJsonFile (tempAbsPath </> "genesis.spec.json") (rewriteGenesisSpec testOptions startTime supply)
-  H.rewriteJsonFile (tempAbsPath </> "genesis.json"     ) (rewriteGenesisSpec testOptions startTime supply)
+  H.rewriteJsonFile (tempAbsPath </> "genesis.spec.json") (rewriteGenesisSpec testnetOptions startTime)
+  H.rewriteJsonFile (tempAbsPath </> "genesis.json"     ) (rewriteGenesisSpec testnetOptions startTime)
 
   H.assertIsJsonFile $ tempAbsPath </> "genesis.spec.json"
 
@@ -325,7 +332,7 @@ testnet testOptions H.Conf {..} = do
     , "--ttl", "1000"
     , "--fee", "0"
     , "--tx-in", genesisTxinResult
-    , "--tx-out", user1Addr <> "+" <> show supply
+    , "--tx-out", user1Addr <> "+" <> show @Integer (maxLovelaceSupply testnetOptions)
     , "--certificate-file", tempAbsPath </> "addresses/pool-owner1-stake.reg.cert"
     , "--certificate-file", tempAbsPath </> "node-pool1/registration.cert"
     , "--certificate-file", tempAbsPath </> "addresses/user1-stake.reg.cert"
@@ -422,7 +429,7 @@ hprop_testnet = H.integration . H.runFinallies . H.workspace "chairman" $ \tempA
 
   void . liftResourceT . resourceForkIO . forever . liftIO $ IO.threadDelay 10000000
 
-  void $ testnet emptyTestnetOptions conf
+  void $ testnet defaultTestnetOptions conf
 
   H.failure -- Intentional failure to force failure report
 

diff --git a/cardano-node-chairman/test/Spec/Chairman/ByronShelley.hs b/cardano-node-chairman/test/Spec/Chairman/ByronShelley.hs
@@ -22,6 +22,6 @@ hprop_chairman :: H.Property
 hprop_chairman = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsPath' -> do
   conf <- H.mkConf tempAbsPath' Nothing
 
-  allNodes <- H.testnet H.emptyTestnetOptions conf
+  allNodes <- H.testnet H.defaultTestnetOptions conf
 
   chairmanOver 120 52 conf allNodes
diff --git a/cardano-node-chairman/test/Spec/Chairman/Shelley.hs b/cardano-node-chairman/test/Spec/Chairman/Shelley.hs
@@ -22,6 +22,6 @@ hprop_chairman :: H.Property
 hprop_chairman = H.integration . H.runFinallies . H.workspace "chairman" $ \tempAbsPath' -> do
   conf <- H.mkConf tempAbsPath' Nothing
 
-  allNodes <- H.testnet H.emptyTestnetOptions conf
+  allNodes <- H.testnet H.defaultTestnetOptions conf
 
   chairmanOver 120 21 conf allNodes
diff --git a/cardano-node-chairman/testnet/Testnet/Commands/ByronShelley.hs b/cardano-node-chairman/testnet/Testnet/Commands/ByronShelley.hs
@@ -24,19 +24,19 @@ data ByronShelleyOptions = ByronShelleyOptions
 
 optsTestnet :: Parser TestnetOptions
 optsTestnet = TestnetOptions
-  <$> optional
-      ( OA.option auto
-        (   long "active-slots-coeff"
-        <>  help "Active slots co-efficient"
-        <>  metavar "DOUBLE"
-        )
+  <$> OA.option auto
+      (   OA.long "active-slots-coeff"
+      <>  OA.help "Active slots co-efficient"
+      <>  OA.metavar "DOUBLE"
+      <>  OA.showDefault
+      <>  OA.value (activeSlotsCoeff defaultTestnetOptions)
       )
-  <*> optional
-      ( OA.option auto
-        (   long "epoch-length"
-        <>  help "Epoch length"
-        <>  metavar "MILLISECONDS"
-        )
+  <*> OA.option auto
+      (   OA.long "epoch-length"
+      <>  OA.help "Epoch length"
+      <>  OA.metavar "MILLISECONDS"
+      <>  OA.showDefault
+      <>  OA.value (epochLength defaultTestnetOptions)
       )
 
 optsByronShelley :: Parser ByronShelleyOptions

diff --git a/cardano-node-chairman/testnet/Testnet/Commands/Shelley.hs b/cardano-node-chairman/testnet/Testnet/Commands/Shelley.hs
@@ -25,19 +25,40 @@ data ShelleyOptions = ShelleyOptions
 
 optsTestnet :: Parser TestnetOptions
 optsTestnet = TestnetOptions
-  <$> optional
-      ( OA.option auto
-        (   long "active-slots-coeff"
-        <>  help "Active slots co-efficient"
-        <>  metavar "DOUBLE"
-        )
+  <$> OA.option auto
+      (   OA.long "active-slots-coeff"
+      <>  OA.help "Active slots co-efficient"
+      <>  OA.metavar "DOUBLE"
+      <>  OA.showDefault
+      <>  OA.value (activeSlotsCoeff defaultTestnetOptions)
       )
-  <*> optional
-      ( OA.option auto
-        (   long "epoch-length"
-        <>  help "Epoch length"
-        <>  metavar "MILLISECONDS"
-        )
+  <*> OA.option auto
+      (   OA.long "security-param"
+      <>  OA.help "Security param"
+      <>  OA.metavar "INT"
+      <>  OA.showDefault
+      <>  OA.value (securityParam defaultTestnetOptions)
+      )
+  <*> OA.option auto
+      (   OA.long "epoch-length"
+      <>  OA.help "Epoch length"
+      <>  OA.metavar "MILLISECONDS"
+      <>  OA.showDefault
+      <>  OA.value (epochLength defaultTestnetOptions)
+      )
+  <*> OA.option auto
+      (   OA.long "slot-length"
+      <>  OA.help "Slot length"
+      <>  OA.metavar "MILLISECONDS"
+      <>  OA.showDefault
+      <>  OA.value (slotLength defaultTestnetOptions)
+      )
+  <*> OA.option auto
+      (   OA.long "max-lovelace-supply"
+      <>  OA.help "Max lovelace supply"
+      <>  OA.metavar "INTEGER"
+      <>  OA.showDefault
+      <>  OA.value (maxLovelaceSupply defaultTestnetOptions)
       )
 
 optsShelley :: Parser ShelleyOptions