Temp: wip make cardano-testnet compile

Author: ana-pantilie

cardano-testnet/cardano-testnet.cabal

@@ -89,6 +89,7 @@ library
                       , retry
                       , safe-exceptions
                       , scientific
+                      , stm
                       , tasty ^>= 1.5
                       , tasty-expected-failure
                       , tasty-hedgehog

cardano-testnet/src/Parsers/Cardano.hs

@@ -111,35 +111,6 @@ pAnyShelleyBasedEra envCli =
     AnyCardanoEra era <- envCliAnyCardanoEra envCli'
     forEraInEonMaybe era EraInEon
 
-pAnyShelleyBasedEra :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
-pAnyShelleyBasedEra envCli =
-  asum $
-    mconcat
-      [
-        [ OA.flag' (EraInEon ShelleyBasedEraShelley) $
-            mconcat [OA.long "shelley-era", OA.help $ "Specify the Shelley era" <> deprecationText]
-        , OA.flag' (EraInEon ShelleyBasedEraAllegra) $
-            mconcat [OA.long "allegra-era", OA.help $ "Specify the Allegra era" <> deprecationText]
-        , OA.flag' (EraInEon ShelleyBasedEraMary) $
-            mconcat [OA.long "mary-era", OA.help $ "Specify the Mary era" <> deprecationText]
-        , OA.flag' (EraInEon ShelleyBasedEraAlonzo) $
-            mconcat [OA.long "alonzo-era", OA.help $ "Specify the Alonzo era" <> deprecationText]
-        , OA.flag' (EraInEon ShelleyBasedEraBabbage) $
-            mconcat [OA.long "babbage-era", OA.help $ "Specify the Babbage era (default)" <> deprecationText]
-        , fmap (EraInEon . convert) $ pConwayEra envCli
-        ]
-      , maybeToList $ pure <$> envCliAnyEon envCli
-      , pure $ pure $ EraInEon ShelleyBasedEraConway
-      ]
- where
-  deprecationText :: String
-  deprecationText = " - DEPRECATED - will be removed in the future"
-
-  envCliAnyEon :: Typeable eon => Eon eon => EnvCli -> Maybe (EraInEon eon)
-  envCliAnyEon envCli' = do
-    AnyCardanoEra era <- envCliAnyCardanoEra envCli'
-    forEraInEonMaybe era EraInEon
-
 pTestnetNodeOptions :: Parser [NodeOption]
 pTestnetNodeOptions =
   -- If `--num-pool-nodes N` is present, return N nodes with option `SpoNodeOptions []`.

cardano-testnet/src/Testnet/Blockfrost.hs

@@ -14,6 +14,7 @@ import           Cardano.Ledger.BaseTypes (EpochInterval, Nonce, NonNegativeInte
                   UnitInterval, ProtVer(..), Version)
 import           Cardano.Ledger.Coin (Coin)
 import           Cardano.Ledger.Core (PParams(..))
+import           Cardano.Ledger.Compactible (toCompactPartial)
 import           Cardano.Ledger.Shelley.Genesis (ShelleyGenesis(..))
 import           Cardano.Ledger.Shelley.PParams (ShelleyPParams(..))
 import           Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis(..))
@@ -248,7 +249,7 @@ blockfrostToGenesis (alonzoGenesis', conwayGenesis', shelleyGenesis') Blockfrost
       , sppMaxTxSize = bfgMaxTxSize
       , sppMaxBHSize = bfgMaxBlockHeaderSize
       , sppKeyDeposit = bfgKeyDeposit
-      , sppPoolDeposit = bfgPoolDeposit
+      , sppPoolDeposit = toCompactPartial bfgPoolDeposit
       , sppEMax = bfgEMax
       , sppNOpt = bfgNOpt
       , sppA0 = bfgA0

cardano-testnet/src/Testnet/Components/Configuration.hs

@@ -146,10 +146,9 @@ getDefaultShelleyGenesis asbe maxSupply opts = do
 getDefaultAlonzoGenesis :: ()
   => HasCallStack
   => MonadTest m
-  => ShelleyBasedEra era
-  -> m AlonzoGenesis
-getDefaultAlonzoGenesis sbe =
-  H.evalEither $ first prettyError (Defaults.defaultAlonzoGenesis sbe)
+  => m AlonzoGenesis
+getDefaultAlonzoGenesis =
+  H.evalEither $ first prettyError Defaults.defaultAlonzoGenesis
 
 numSeededUTxOKeys :: Int
 numSeededUTxOKeys = 3
@@ -181,7 +180,7 @@ createSPOGenesisAndFiles
         { sgSecurityParam = unsafeNonZero 5
         , sgUpdateQuorum = 2
         }
-  alonzoGenesis' <- getDefaultAlonzoGenesis sbe
+  alonzoGenesis' <- getDefaultAlonzoGenesis 
   let conwayGenesis' = Defaults.defaultConwayGenesis
 
   (alonzoGenesis, conwayGenesis, shelleyGenesis) <- resolveOnChainParams onChainParams

cardano-testnet/src/Testnet/Components/Query.hs

@@ -54,6 +54,8 @@ import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.PParams as L
 import qualified Cardano.Ledger.Shelley.LedgerState as L
 import qualified Cardano.Ledger.UMap as L
+import qualified Cardano.Ledger.Api.State.Query as SQ
+import qualified Data.Set as Set
 
 import           Prelude
 
@@ -409,12 +411,9 @@ checkDRepState epochStateView@EpochStateView{nodeConfigPath, socketPath} sbe f =
   result <- H.evalIO . runExceptT $ foldEpochState nodeConfigPath socketPath QuickValidation terminationEpoch Nothing
       $ \(AnyNewEpochState actualEra newEpochState _) _slotNumber _blockNumber -> do
         Refl <- either error pure $ assertErasEqual sbe actualEra
-        let dreps = shelleyBasedEraConstraints sbe newEpochState
-                      ^. L.nesEsL
-                       . L.esLStateL
-                       . L.lsCertStateL
-                       . L.certVStateL
-                       . L.vsDRepsL
+        let dreps =
+              shelleyBasedEraConstraints sbe 
+                $ SQ.queryDRepState newEpochState Set.empty
         case f dreps of
           Nothing -> pure ConditionNotMet
           Just a -> do put $ Just a
@@ -602,7 +601,6 @@ getDelegationState epochStateView = do
                  . L.esLStateL
                  . L.lsCertStateL
                  . L.certDStateL
-                 . L.dsUnifiedL
 
   pure $ L.toStakeCredentials pools
 

cardano-testnet/src/Testnet/Defaults.hs

@@ -41,7 +41,7 @@ module Testnet.Defaults
   ) where
 
 import           Cardano.Api (AnyShelleyBasedEra (..), CardanoEra (..), File (..),
-                   ShelleyBasedEra (..), pshow, toCardanoEra, unsafeBoundedRational)
+                   ShelleyBasedEra (..), pshow, unsafeBoundedRational)
 import qualified Cardano.Api as Api
 
 import           Cardano.Ledger.Alonzo.Core (PParams (..))
@@ -106,9 +106,9 @@ newtype AlonzoGenesisError
   = AlonzoGenErrTooMuchPrecision Rational
   deriving Show
 
-defaultAlonzoGenesis :: ShelleyBasedEra era -> Either AlonzoGenesisError AlonzoGenesis
-defaultAlonzoGenesis sbe = do
-  let genesis = Api.alonzoGenesisDefaults (toCardanoEra sbe)
+defaultAlonzoGenesis :: Either AlonzoGenesisError AlonzoGenesis
+defaultAlonzoGenesis = do
+  let genesis = Api.alonzoGenesisDefaults
       prices = Ledger.agPrices genesis
 
   -- double check that prices have correct values - they're set using unsafeBoundedRational in cardano-api
@@ -192,6 +192,7 @@ defaultYamlHardforkViaConfig sbe =
         ShelleyBasedEraAlonzo -> ("LastKnownBlockVersion-Major", Aeson.Number 5)
         ShelleyBasedEraBabbage -> ("LastKnownBlockVersion-Major", Aeson.Number 8)
         ShelleyBasedEraConway -> ("LastKnownBlockVersion-Major", Aeson.Number 9)
+        ShelleyBasedEraDijkstra -> ("LastKnownBlockVersion-Major", Aeson.Number 10)
       , ("LastKnownBlockVersion-Minor", Aeson.Number 0)
       , ("LastKnownBlockVersion-Alt", Aeson.Number 0)
       ]
@@ -236,7 +237,17 @@ defaultYamlHardforkViaConfig sbe =
                 , ("TestAlonzoHardForkAtEpoch", Aeson.Number 0)
                 , ("TestBabbageHardForkAtEpoch", Aeson.Number 0)
                 , ("TestConwayHardForkAtEpoch", Aeson.Number 0)
-                ])
+                ]
+            ShelleyBasedEraDijkstra ->
+                [ ("TestShelleyHardForkAtEpoch", Aeson.Number 0)
+                , ("TestAllegraHardForkAtEpoch", Aeson.Number 0)
+                , ("TestMaryHardForkAtEpoch", Aeson.Number 0)
+                , ("TestAlonzoHardForkAtEpoch", Aeson.Number 0)
+                , ("TestBabbageHardForkAtEpoch", Aeson.Number 0)
+                , ("TestConwayHardForkAtEpoch", Aeson.Number 0)
+                , ("TestDijkstraHardForkAtEpoch", Aeson.Number 0)
+                ]
+                )
   -- | Various tracers we can turn on or off
   tracers :: Aeson.KeyMap Aeson.Value
   tracers = Aeson.fromList $ map (bimap Aeson.fromText Aeson.Bool)
@@ -429,6 +440,8 @@ eraToProtocolVersion =
     AnyShelleyBasedEra ShelleyBasedEraBabbage -> mkProtVer (8, 0)
     -- By default start after bootstrap (which is PV9)
     AnyShelleyBasedEra ShelleyBasedEraConway -> mkProtVer (10, 0)
+    -- TODO: is this correct?
+    AnyShelleyBasedEra ShelleyBasedEraDijkstra -> mkProtVer (11, 0)
 
 -- TODO: Expose from cardano-api
 mkProtVer :: (Natural, Natural) -> ProtVer
@@ -438,7 +451,7 @@ mkProtVer (majorProtVer, minorProtVer) =
     Nothing -> error "mkProtVer: invalid protocol version"
 
 ppProtocolVersionL' ::  Lens' (PParams Ledger.ShelleyEra) ProtVer
-ppProtocolVersionL' = Ledger.ppLens . Ledger.hkdProtocolVersionL @Ledger.ShelleyEra @Identity
+ppProtocolVersionL' = Ledger.ppLensHKD . Ledger.hkdProtocolVersionL @Ledger.ShelleyEra @Identity
 
 defaultMainnetTopology :: Topology.NetworkTopology RemoteAddress
 defaultMainnetTopology =

cardano-testnet/src/Testnet/Ping.hs

@@ -80,10 +80,10 @@ pingNode networkMagic sprocket = liftIO $ bracket
     Socket.connect sd (Socket.addrAddress peer)
     peerStr <- peerString
 
-    bearer <- getBearer makeSocketBearer sduTimeout nullTracer sd Nothing
+    bearer <- getBearer makeSocketBearer sduTimeout sd Nothing
 
     let versions = supportedNodeToClientVersions networkMagic
-    !_ <- Mux.write bearer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions doHandshakeQuery)
+    !_ <- Mux.write bearer nullTracer timeoutfn $ wrap handshakeNum InitiatorDir (handshakeReq versions doHandshakeQuery)
     (msg, !_) <- nextMsg bearer timeoutfn handshakeNum
 
     pure $ case CBOR.deserialiseFromBytes handshakeDec msg of
@@ -130,7 +130,7 @@ pingNode networkMagic sprocket = liftIO $ bracket
             -> MiniProtocolNum -- ^ handshake protocol number
             -> IO (LBS.ByteString, Time) -- ^ raw message and timestamp
     nextMsg bearer timeoutfn ptclNum = do
-      (sdu, t_e) <- Mux.read bearer timeoutfn
+      (sdu, t_e) <- Mux.read bearer nullTracer timeoutfn
       if mhNum (msHeader sdu) == ptclNum
         then pure (msBlob sdu, t_e)
         else nextMsg bearer timeoutfn ptclNum

cardano-testnet/src/Testnet/Types.hs

@@ -209,7 +209,7 @@ getStartTime
 getStartTime tempRootPath TestnetRuntime{configurationFile} = withFrozenCallStack $ H.evalEither <=< H.evalIO . runExceptT $ do
   byronGenesisFile <-
     decodeNodeConfiguration configurationFile >>= \case
-      NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ _ ->
+      NodeProtocolConfigurationCardano NodeByronProtocolConfiguration{npcByronGenesisFile} _ _ _ _ _ _ ->
         pure $ unGenesisFile npcByronGenesisFile
   let byronGenesisFilePath = tempRootPath </> byronGenesisFile
   SystemStart . G.gdStartTime . G.configGenesisData <$> decodeGenesisFile byronGenesisFilePath