tx-generator: stop supporting Byron and use more recent API way to ha…

…ndle era

bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs

@@ -77,21 +77,32 @@ initConstants = do
   emit $ DefineSigningKey keyNameBenchmarkInputs keyBenchmarkInputs
   emit $ DefineSigningKey keyNameBenchmarkDone keyBenchmarkDone
 
+-- TODO delete this function and replace 'AnyCardanoEra' by
+-- 'AnyShelleyBasedEra' in 'NixServiceOption'
+requireAnyShelleyBasedEra :: AnyCardanoEra -> Compiler AnyShelleyBasedEra
+requireAnyShelleyBasedEra (AnyCardanoEra era) =
+  caseByronOrShelleyBasedEra
+    (throwCompileError $ SomeCompilerError "Byron era not supported")
+    (return . AnyShelleyBasedEra)
+    era
+
 importGenesisFunds :: Compiler String
 importGenesisFunds = do
   logMsg "Importing Genesis Fund."
   wallet <- newWallet "genesis_wallet"
   era <- askNixOption _nix_era
+  sbe <- requireAnyShelleyBasedEra era
   txParams <- askNixOption txGenTxParams
   cmd1 (ReadSigningKey keyNameGenesisInputFund) _nix_sigKey
-  emit $ Submit era LocalSocket txParams $ SecureGenesis wallet keyNameGenesisInputFund keyNameTxGenFunds
+  emit $ Submit sbe LocalSocket txParams $ SecureGenesis wallet keyNameGenesisInputFund keyNameTxGenFunds
   delay
   logMsg "Importing Genesis Fund. Done."
   return wallet
 
 addCollaterals :: SrcWallet -> Compiler (Maybe String)
 addCollaterals src = do
   era <- askNixOption _nix_era
+  sbe <- requireAnyShelleyBasedEra era
   txParams <- askNixOption txGenTxParams
   isAnyPlutusMode >>= \case
     False -> return Nothing
@@ -103,7 +114,7 @@ addCollaterals src = do
                         (PayToAddr keyNameCollaterals collateralWallet)
                         (PayToAddr keyNameTxGenFunds src)
                         [ safeCollateral ]
-      emit $ Submit era LocalSocket txParams generator
+      emit $ Submit sbe LocalSocket txParams generator
       logMsg "Create collaterals. Done."
       return $ Just collateralWallet
 
@@ -112,25 +123,26 @@ splittingPhase srcWallet = do
   tx_count <- askNixOption _nix_tx_count
   inputs_per_tx <- askNixOption _nix_inputs_per_tx
   era <- askNixOption _nix_era
+  sbe <- requireAnyShelleyBasedEra era
   txParams <- askNixOption txGenTxParams
   minValuePerInput <- _minValuePerInput <$> evilFeeMagic
   finalDest <- newWallet "final_split_wallet"
   splitSteps <- splitSequenceWalletNames srcWallet finalDest $
     unfoldSplitSequence (txParamFee txParams) minValuePerInput (tx_count * inputs_per_tx)
   isPlutus <- isAnyPlutusMode
-  forM_ (init splitSteps) $ createChange txParams False False era
-  createChange txParams True isPlutus era $ last splitSteps
+  forM_ (init splitSteps) $ createChange sbe txParams False False
+  createChange sbe txParams True isPlutus $ last splitSteps
   return finalDest
  where
-  createChange :: TxGenTxParams -> Bool -> Bool -> AnyCardanoEra -> (SrcWallet, DstWallet, Split) -> Compiler ()
-  createChange txParams isLastStep isPlutus era (src, dst, split) = do
+  createChange :: AnyShelleyBasedEra -> TxGenTxParams -> Bool -> Bool -> (SrcWallet, DstWallet, Split) -> Compiler ()
+  createChange sbe txParams isLastStep isPlutus (src, dst, split) = do
     logMsg $ Text.pack $ "Splitting step: " ++ show split
     let valuePayMode = PayToAddr (if isLastStep then keyNameSplitPhase else keyNameBenchmarkInputs) dst
     payMode <- if isPlutus then plutusPayMode dst else return valuePayMode
     let generator = case split of
           SplitWithChange lovelace count -> Split src payMode (PayToAddr keyNameTxGenFunds src) $ replicate count lovelace
           FullSplits txCount -> Take txCount $ Cycle $ SplitN src payMode maxOutputsPerTx
-    emit $ Submit era LocalSocket txParams generator
+    emit $ Submit sbe LocalSocket txParams generator
     delay
     logMsg "Splitting step: Done"
 
@@ -192,6 +204,7 @@ benchmarkingPhase wallet collateralWallet = do
   targetNodes <- askNixOption _nix_targetNodes
   tps <- askNixOption _nix_tps
   era <- askNixOption _nix_era
+  sbe <- requireAnyShelleyBasedEra era
   txCount <- askNixOption _nix_tx_count
   inputs <- askNixOption _nix_inputs_per_tx
   outputs <- askNixOption _nix_outputs_per_tx
@@ -203,7 +216,7 @@ benchmarkingPhase wallet collateralWallet = do
         then LocalSocket
         else Benchmark targetNodes tps txCount
     generator = Take txCount $ Cycle $ NtoM wallet payMode inputs outputs (Just $ txParamAddTxSize txParams) collateralWallet
-  emit $ Submit era submitMode txParams generator
+  emit $ Submit sbe submitMode txParams generator
   unless debugMode $ do
     emit WaitBenchmark
   return doneWallet

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs

@@ -110,14 +110,14 @@ handleTxSubmissionClientError
       LogErrors   -> traceWith traceSubmit $
         TraceBenchTxSubError (pack errDesc)
 
-walletBenchmark :: forall era. IsShelleyBasedEra era
-  => Trace IO (TraceBenchTxSubmit TxId)
+walletBenchmark :: ()
+  => ShelleyBasedEra era
+  -> Trace IO (TraceBenchTxSubmit TxId)
   -> Trace IO NodeToNodeSubmissionTrace
   -> ConnectClient
   -> NonEmpty NodeDescription
   -> TPSRate
   -> SubmissionErrorPolicy
-  -> AsType era
 -- this is used in newTpsThrottle to limit the tx-count !
 -- This should not be needed, the stream should do it itself (but it does not!)
   -> NumberOfTxs
@@ -128,13 +128,13 @@ walletBenchmark :: forall era. IsShelleyBasedEra era
   -> TxStream IO era
   -> ExceptT TxGenError IO AsyncBenchmarkControl
 walletBenchmark
+  sbe
   traceSubmit
   traceN2N
   connectClient
   targets
   tpsRate
   errorPolicy
-  _era
   count
   txSource
   = liftIO $ do
@@ -157,6 +157,7 @@ walletBenchmark
   abcWorkers <- forM asyncList \(reportRef, remoteInfo@(remoteName, remoteAddrInfo)) -> do
     let errorHandler = handleTxSubmissionClientError traceSubmit remoteInfo reportRef errorPolicy
         client = txSubmissionClient
+                     sbe
                      traceN2N
                      traceSubmit
                      (txStreamSource txStreamRef tpsThrottle)

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SizedMetadata.hs

@@ -1,8 +1,6 @@
 {- HLINT ignore "Use camelCase" -}
 {- HLINT ignore "Use uncurry" -}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 module Cardano.Benchmarking.GeneratorTx.SizedMetadata
 where
 
@@ -46,23 +44,23 @@ prop_mapCostsMary    :: Bool
 prop_mapCostsAlonzo  :: Bool
 prop_mapCostsBabbage :: Bool
 prop_mapCostsConway  :: Bool
-prop_mapCostsShelley = measureMapCosts AsShelleyEra   == assumeMapCosts AsShelleyEra
-prop_mapCostsAllegra = measureMapCosts AsAllegraEra   == assumeMapCosts AsAllegraEra
-prop_mapCostsMary    = measureMapCosts AsMaryEra      == assumeMapCosts AsMaryEra
-prop_mapCostsAlonzo  = measureMapCosts AsAlonzoEra    == assumeMapCosts AsAlonzoEra
-prop_mapCostsBabbage = measureMapCosts AsBabbageEra   == assumeMapCosts AsBabbageEra
-prop_mapCostsConway  = measureMapCosts AsConwayEra    == assumeMapCosts AsConwayEra
-
-assumeMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
-assumeMapCosts _proxy = stepFunction [
+prop_mapCostsShelley = measureMapCosts ShelleyBasedEraShelley == assumeMapCosts ShelleyBasedEraShelley
+prop_mapCostsAllegra = measureMapCosts ShelleyBasedEraAllegra == assumeMapCosts ShelleyBasedEraAllegra
+prop_mapCostsMary    = measureMapCosts ShelleyBasedEraMary    == assumeMapCosts ShelleyBasedEraMary
+prop_mapCostsAlonzo  = measureMapCosts ShelleyBasedEraAlonzo  == assumeMapCosts ShelleyBasedEraAlonzo
+prop_mapCostsBabbage = measureMapCosts ShelleyBasedEraBabbage == assumeMapCosts ShelleyBasedEraBabbage
+prop_mapCostsConway  = measureMapCosts ShelleyBasedEraConway  == assumeMapCosts ShelleyBasedEraConway
+
+assumeMapCosts :: ShelleyBasedEra era -> [Int]
+assumeMapCosts sbe = stepFunction [
       (   1 , 0)          -- An empty map of metadata has the same cost as TxMetadataNone.
     , (   1 , firstEntry) -- Using Metadata costs 37 or 39 bytes  (first map entry).
     , (  22 , 2)          -- The next 22 entries cost 2 bytes each.
     , ( 233 , 3)          -- 233 entries at 3 bytes.
     , ( 744 , 4)          -- 744 entries at 4 bytes.
     ]
   where
-    firstEntry = case shelleyBasedEra @era of
+    firstEntry = case sbe of
       ShelleyBasedEraShelley -> 37
       ShelleyBasedEraAllegra -> 39
       ShelleyBasedEraMary    -> 39
@@ -78,21 +76,21 @@ prop_bsCostsMary    :: Bool
 prop_bsCostsAlonzo  :: Bool
 prop_bsCostsBabbage :: Bool
 prop_bsCostsConway  :: Bool
-prop_bsCostsShelley = measureBSCosts AsShelleyEra == [37..60] ++ [62..102]
-prop_bsCostsAllegra = measureBSCosts AsAllegraEra == [39..62] ++ [64..104]
-prop_bsCostsMary    = measureBSCosts AsMaryEra    == [39..62] ++ [64..104]
-prop_bsCostsAlonzo  = measureBSCosts AsAlonzoEra  == [42..65] ++ [67..107]
-prop_bsCostsBabbage = measureBSCosts AsBabbageEra == [42..65] ++ [67..107]
-prop_bsCostsConway  = measureBSCosts AsConwayEra  == [42..65] ++ [67..107]
+prop_bsCostsShelley = measureBSCosts ShelleyBasedEraShelley == [37..60] ++ [62..102]
+prop_bsCostsAllegra = measureBSCosts ShelleyBasedEraAllegra == [39..62] ++ [64..104]
+prop_bsCostsMary    = measureBSCosts ShelleyBasedEraMary    == [39..62] ++ [64..104]
+prop_bsCostsAlonzo  = measureBSCosts ShelleyBasedEraAlonzo  == [42..65] ++ [67..107]
+prop_bsCostsBabbage = measureBSCosts ShelleyBasedEraBabbage == [42..65] ++ [67..107]
+prop_bsCostsConway  = measureBSCosts ShelleyBasedEraConway  == [42..65] ++ [67..107]
 
 stepFunction :: [(Int, Int)] -> [Int]
 stepFunction f = scanl1 (+) steps
  where steps = concatMap (\(count,step) -> replicate count step) f
 
 -- Measure the cost of metadata map entries.
 -- This is the cost of the index with an empty BS as payload.
-measureMapCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
-measureMapCosts era = map (metadataSize era . Just . replicateEmptyBS) [0..maxMapSize]
+measureMapCosts :: ShelleyBasedEra era -> [Int]
+measureMapCosts sbe = map (metadataSize sbe . Just . replicateEmptyBS) [0..maxMapSize]
  where
   replicateEmptyBS :: Int -> TxMetadata
   replicateEmptyBS n = listMetadata $ replicate n $ TxMetaBytes BS.empty
@@ -101,46 +99,44 @@ listMetadata :: [TxMetadataValue] -> TxMetadata
 listMetadata l = makeTransactionMetadata $ Map.fromList $ zip [0..] l
 
 -- Cost of metadata with a single BS of size [0..maxBSSize].
-measureBSCosts :: forall era . IsShelleyBasedEra era => AsType era -> [Int]
-measureBSCosts era = map (metadataSize era . Just . bsMetadata) [0..maxBSSize]
+measureBSCosts :: ShelleyBasedEra era -> [Int]
+measureBSCosts sbe = map (metadataSize sbe . Just . bsMetadata) [0..maxBSSize]
  where bsMetadata s = listMetadata [TxMetaBytes $ BS.replicate s 0]
 
-metadataSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
-metadataSize p m = dummyTxSize p m - dummyTxSize p Nothing
+metadataSize :: ShelleyBasedEra era -> Maybe TxMetadata -> Int
+metadataSize sbe m = dummyTxSize sbe m - dummyTxSize sbe Nothing
 
-dummyTxSizeInEra :: IsShelleyBasedEra era => TxMetadataInEra era -> Int
-dummyTxSizeInEra metadata = case createAndValidateTransactionBody shelleyBasedEra dummyTx of
-  Right b -> BS.length $ serialiseToCBOR b
+dummyTxSizeInEra :: ShelleyBasedEra era -> TxMetadataInEra era -> Int
+dummyTxSizeInEra sbe metadata = case createAndValidateTransactionBody sbe dummyTx of
+  Right b -> shelleyBasedEraConstraints sbe $ BS.length $ serialiseToCBOR b
   Left err -> error $ "metaDataSize " ++ show err
  where
-  dummyTx = defaultTxBodyContent shelleyBasedEra
+  dummyTx = defaultTxBodyContent sbe
     & setTxIns
       [ ( TxIn "dbaff4e270cfb55612d9e2ac4658a27c79da4a5271c6f90853042d1403733810" (TxIx 0)
         , BuildTxWith $ KeyWitness KeyWitnessForSpending
         )
       ]
-    & setTxFee (mkTxFee 0)
+    & setTxFee (mkTxFee sbe 0)
     & setTxValidityLowerBound TxValidityNoLowerBound
-    & setTxValidityUpperBound (mkTxValidityUpperBound 0)
+    & setTxValidityUpperBound (mkTxValidityUpperBound sbe 0)
     & setTxMetadata metadata
 
-dummyTxSize :: forall era . IsShelleyBasedEra era => AsType era -> Maybe TxMetadata -> Int
-dummyTxSize _p m = (dummyTxSizeInEra @era) $ metadataInEra m
+dummyTxSize :: ShelleyBasedEra era -> Maybe TxMetadata -> Int
+dummyTxSize sbe m = dummyTxSizeInEra sbe $ metadataInEra sbe m
 
-metadataInEra :: forall era . IsShelleyBasedEra era => Maybe TxMetadata -> TxMetadataInEra era
-metadataInEra Nothing = TxMetadataNone
-metadataInEra (Just m) = case forEraMaybeEon (cardanoEra @era) of
-  Nothing -> error "unreachable"
-  Just e -> TxMetadataInEra e m
+metadataInEra :: ShelleyBasedEra era -> Maybe TxMetadata -> TxMetadataInEra era
+metadataInEra _ Nothing = TxMetadataNone
+metadataInEra sbe (Just m) = TxMetadataInEra sbe m
 
-mkMetadata :: forall era . IsShelleyBasedEra era => Int -> Either String (TxMetadataInEra era)
-mkMetadata 0 = Right $ metadataInEra Nothing
-mkMetadata size
+mkMetadata :: ShelleyBasedEra era -> Int -> Either String (TxMetadataInEra era)
+mkMetadata sbe 0 = Right $ metadataInEra sbe Nothing
+mkMetadata sbe size
   = if size < minSize
       then Left $ "Error : metadata must be 0 or at least " ++ show minSize ++ " bytes in this era."
-      else Right $ metadataInEra $ Just metadata
+      else Right $ metadataInEra sbe $ Just metadata
  where
-  minSize = case shelleyBasedEra @era of
+  minSize = case sbe of
     ShelleyBasedEraShelley -> 37
     ShelleyBasedEraAllegra -> 39
     ShelleyBasedEraMary    -> 39

bench/tx-generator/src/Cardano/Benchmarking/GeneratorTx/SubmissionClient.hs

@@ -86,16 +86,14 @@ type LocalState era = (TxSource era, UnAcked (Tx era), SubmissionThreadStats)
 type EndOfProtocolCallback m = SubmissionThreadStats -> m ()
 
 txSubmissionClient
-  :: forall m era.
-     ( MonadIO m, MonadFail m
-     , IsShelleyBasedEra era
-     )
-  => Trace m NodeToNodeSubmissionTrace
+  :: forall m era. ( MonadIO m, MonadFail m )
+  => ShelleyBasedEra era
+  -> Trace m NodeToNodeSubmissionTrace
   -> Trace m (TraceBenchTxSubmit TxId)
   -> TxSource era
   -> EndOfProtocolCallback m
   -> TxSubmissionClient (GenTxId CardanoBlock) (GenTx CardanoBlock) m ()
-txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
+txSubmissionClient sbe tr bmtr initialTxSource endOfProtocolCallback =
   TxSubmissionClient $
     pure $ client (initialTxSource, UnAcked [], SubmissionThreadStats 0 0 0)
  where
@@ -181,11 +179,11 @@ txSubmissionClient tr bmtr initialTxSource endOfProtocolCallback =
   txToIdSize = (Mempool.txId . toGenTx) &&& (SizeInBytes . fromInteger . getTxSize)
     where
       getTxSize :: Tx era -> Integer
-      getTxSize (ShelleyTx sbe tx) =
+      getTxSize (ShelleyTx _ tx) =
         shelleyBasedEraConstraints sbe $ tx ^. Ledger.sizeTxF
 
   toGenTx :: Tx era -> GenTx CardanoBlock
-  toGenTx tx = toConsensusGenTx $ TxInMode shelleyBasedEra tx
+  toGenTx tx = toConsensusGenTx $ TxInMode sbe tx
 
   fromGenTxId :: GenTxId CardanoBlock -> TxId
   fromGenTxId (Block.GenTxIdShelley (Mempool.ShelleyTxId i)) = fromShelleyTxId i

bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs

@@ -13,6 +13,8 @@ module Cardano.Benchmarking.Script.Action
        )
        where
 
+import           Cardano.Api
+
 import           Cardano.Benchmarking.OuroborosImports as Core (protocolToNetworkId)
 import           Cardano.Benchmarking.Script.Core
 import           Cardano.Benchmarking.Script.Env
@@ -21,8 +23,6 @@ import           Cardano.Benchmarking.Tracer
 import           Cardano.TxGenerator.Setup.NodeConfig
 import           Cardano.TxGenerator.Types (TxGenError)
 
-import           Control.Monad.IO.Class
-import           Control.Monad.Trans.Except.Extra
 import qualified Data.Text as Text (unpack)
 
 
@@ -43,9 +43,9 @@ action a = case a of
   StartProtocol configFile cardanoTracerSocket -> startProtocol configFile cardanoTracerSocket
   ReadSigningKey name filePath -> readSigningKey name filePath
   DefineSigningKey name descr -> defineSigningKey name descr
-  AddFund era wallet txIn lovelace keyName -> addFund era wallet txIn lovelace keyName
+  AddFund (AnyShelleyBasedEra sbe) wallet txIn lovelace keyName -> addFund sbe wallet txIn lovelace keyName
   Delay t -> delay t
-  Submit era submitMode txParams generator -> submitAction era submitMode generator txParams
+  Submit (AnyShelleyBasedEra sbe) submitMode txParams generator -> submitAction sbe submitMode generator txParams
   WaitBenchmark -> waitBenchmark
   CancelBenchmark -> cancelBenchmark
   WaitForEra era -> waitForEra era