Fix partial pattern matches by adding Conway case

lib/wallet/api/http/Cardano/Wallet/Api/Http/Shelley/Server.hs

@@ -4139,6 +4139,7 @@ type RewardAccountBuilder k
 
 guardIsRecentEra :: AnyCardanoEra -> Handler AnyRecentEra
 guardIsRecentEra (Cardano.AnyCardanoEra era) = case era of
+    Cardano.ConwayEra -> pure $ WriteTx.AnyRecentEra WriteTx.RecentEraConway
     Cardano.BabbageEra -> pure $ WriteTx.AnyRecentEra WriteTx.RecentEraBabbage
     Cardano.AlonzoEra  -> pure $ WriteTx.AnyRecentEra WriteTx.RecentEraAlonzo
     Cardano.MaryEra    -> liftE invalidEra
@@ -4786,7 +4787,7 @@ data ErrUnexpectedPoolIdPlaceholder = ErrUnexpectedPoolIdPlaceholder
     deriving (Eq, Show)
 
 data ErrCreateWallet
-    = ErrCreateWalletAlreadyExists ErrWalletAlreadyExists
+    = ErrCreateWalletAlreadyExists !ErrWalletAlreadyExists
         -- ^ Wallet already exists
     | ErrCreateWalletFailedToCreateWorker
         -- ^ Somehow, we couldn't create a worker or open a db connection
@@ -4842,8 +4843,8 @@ instance IsServerError ErrGetAsset where
 -- | The type of log messages coming from the server 'ApiLayer', which may or
 -- may not be associated with a particular worker thread.
 data WalletEngineLog
-    = MsgWalletWorker (WorkerLog WalletId W.WalletWorkerLog)
-    | MsgSubmitSealedTx TxSubmitLog
+    = MsgWalletWorker !(WorkerLog WalletId W.WalletWorkerLog)
+    | MsgSubmitSealedTx !TxSubmitLog
     deriving (Show, Eq)
 
 instance ToText WalletEngineLog where

lib/wallet/src/Cardano/Wallet/Pools.hs

@@ -109,11 +109,14 @@ import Cardano.Wallet.Shelley.Compatibility
     , fromAllegraBlock
     , fromAlonzoBlock
     , fromBabbageBlock
+    , fromConwayBlock
     , fromMaryBlock
     , fromShelleyBlock
     , getBabbageProducer
+    , getConwayProducer
     , getProducer
     , toBabbageBlockHeader
+    , toConwayBlockHeader
     , toShelleyBlockHeader
     )
 import Cardano.Wallet.Unsafe
@@ -654,6 +657,9 @@ monitorStakePools tr (NetworkParameters gp sp _pp) genesisPools nl DBLayer{..} =
             BlockBabbage blk ->
                 forEachShelleyBlock
                     (fromBabbageBlock gp blk) (getBabbageProducer blk)
+            BlockConway blk ->
+                forEachShelleyBlock
+                    (fromConwayBlock gp blk) (getConwayProducer blk)
 
         forLastBlock = \case
             BlockByron blk ->
@@ -668,6 +674,8 @@ monitorStakePools tr (NetworkParameters gp sp _pp) genesisPools nl DBLayer{..} =
                 putHeader (toShelleyBlockHeader getGenesisBlockHash blk)
             BlockBabbage blk ->
                 putHeader (toBabbageBlockHeader getGenesisBlockHash blk)
+            BlockConway blk ->
+                putHeader (toConwayBlockHeader getGenesisBlockHash blk)
 
         forEachShelleyBlock (blk, certificates) poolId = do
             let header = view #header blk

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx.hs

@@ -21,6 +21,8 @@ import Cardano.Wallet.Read.Primitive.Tx.Babbage
     ( fromBabbageTx )
 import Cardano.Wallet.Read.Primitive.Tx.Byron
     ( fromTxAux )
+import Cardano.Wallet.Read.Primitive.Tx.Conway
+    ( fromConwayTx )
 import Cardano.Wallet.Read.Primitive.Tx.Mary
     ( fromMaryTx )
 import Cardano.Wallet.Read.Primitive.Tx.Shelley
@@ -63,6 +65,8 @@ fromCardanoTx witCtx = \case
             extract $ fromAlonzoTx tx witCtx
         Cardano.ShelleyBasedEraBabbage ->
             extract $ fromBabbageTx tx witCtx
+        Cardano.ShelleyBasedEraConway ->
+            extract $ fromConwayTx tx witCtx
     Cardano.ByronTx tx ->
         ( fromTxAux tx
         , emptyTokenMapWithScripts

lib/wallet/src/Cardano/Wallet/Read/Primitive/Tx/Features/Validity.hs

@@ -37,6 +37,7 @@ getValidity = EraFun
     , maryFun = yesMaryValidity
     , alonzoFun = yesMaryValidity
     , babbageFun = yesMaryValidity
+    , conwayFun = yesMaryValidity
     }
     where
         noValidity = const $ K Nothing

lib/wallet/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -87,6 +87,7 @@ module Cardano.Wallet.Shelley.Compatibility
     , fromMaryPParams
     , fromAlonzoPParams
     , fromBabbagePParams
+    , fromConwayPParams
     , fromLedgerExUnits
     , toLedgerExUnits
     , fromCardanoAddress
@@ -141,7 +142,9 @@ module Cardano.Wallet.Shelley.Compatibility
     , fromMaryBlock
     , fromAlonzoBlock
     , fromBabbageBlock
+    , fromConwayBlock
     , getBabbageProducer
+    , getConwayProducer
 
       -- * Internal Conversions
     , decentralizationLevelFromPParams
@@ -169,11 +172,11 @@ import Cardano.Api
     , AnyCardanoEra (..)
     , AsType (..)
     , BabbageEra
-    , ConwayEra
     , CardanoEra (..)
     , CardanoEraStyle (..)
     , CardanoMode
     , ConsensusModeParams (CardanoModeParams)
+    , ConwayEra
     , EraInMode (..)
     , InAnyCardanoEra (..)
     , IsCardanoEra (..)
@@ -330,6 +333,7 @@ import Ouroboros.Consensus.Cardano.Block
     , StandardAllegra
     , StandardAlonzo
     , StandardBabbage
+    , StandardConway
     , StandardMary
     , StandardShelley
     )
@@ -377,6 +381,7 @@ import qualified Cardano.Ledger.Babbage.Tx as Babbage hiding
 import qualified Cardano.Ledger.Babbage.TxBody as Babbage
 import qualified Cardano.Ledger.BaseTypes as SL
 import qualified Cardano.Ledger.Conway as Conway
+import qualified Cardano.Ledger.Conway.PParams as Conway
 import qualified Cardano.Ledger.Credential as SL
 import qualified Cardano.Ledger.Crypto as SL
 import qualified Cardano.Ledger.Era as Ledger.Era
@@ -531,41 +536,31 @@ toBabbageBlockHeader
     -> ShelleyBlock (Consensus.Praos StandardCrypto) era
     -> W.BlockHeader
 toBabbageBlockHeader genesisHash blk =
-    let
-        ShelleyBlock (SL.Block header _txSeq) _headerHash = blk
-    in
-        W.BlockHeader
-            { slotNo =
-                Consensus.pHeaderSlot header
-            , blockHeight =
-                fromBlockNo $ Consensus.pHeaderBlock header
-            , headerHash =
-                fromShelleyHash $ Consensus.pHeaderHash header
-            , parentHeaderHash = Just $
-                fromPrevHash (coerce genesisHash) $
-                    Consensus.pHeaderPrevHash header
-            }
+    W.BlockHeader
+        { slotNo = Consensus.pHeaderSlot header
+        , blockHeight = fromBlockNo $ Consensus.pHeaderBlock header
+        , headerHash = fromShelleyHash $ Consensus.pHeaderHash header
+        , parentHeaderHash = Just $ fromPrevHash (coerce genesisHash) $
+            Consensus.pHeaderPrevHash header
+        }
+  where
+    ShelleyBlock (SL.Block header _txSeq) _headerHash = blk
 
 toConwayBlockHeader
     :: (ShelleyCompatible (Consensus.Praos StandardCrypto) era)
     => W.Hash "Genesis"
     -> ShelleyBlock (Consensus.Praos StandardCrypto) era
     -> W.BlockHeader
 toConwayBlockHeader genesisHash blk =
-    let
-        ShelleyBlock (SL.Block header _txSeq) _headerHash = blk
-    in
-        W.BlockHeader
-            { slotNo =
-                Consensus.pHeaderSlot header
-            , blockHeight =
-                fromBlockNo $ Consensus.pHeaderBlock header
-            , headerHash =
-                fromShelleyHash $ Consensus.pHeaderHash header
-            , parentHeaderHash = Just $
-                fromPrevHash (coerce genesisHash) $
-                    Consensus.pHeaderPrevHash header
-            }
+    W.BlockHeader
+        { slotNo = Consensus.pHeaderSlot header
+        , blockHeight = fromBlockNo $ Consensus.pHeaderBlock header
+        , headerHash = fromShelleyHash $ Consensus.pHeaderHash header
+        , parentHeaderHash = Just $ fromPrevHash (coerce genesisHash) $
+            Consensus.pHeaderPrevHash header
+        }
+  where
+    ShelleyBlock (SL.Block header _txSeq) _headerHash = blk
 
 getProducer
     :: (Era era, ToCBORGroup (Ledger.Era.TxSeq era))
@@ -579,6 +574,12 @@ getBabbageProducer
 getBabbageProducer (ShelleyBlock (SL.Block (Consensus.Header header _) _) _) =
     fromPoolKeyHash $ SL.hashKey (Consensus.hbVk header)
 
+getConwayProducer
+    :: (Era era, ToCBORGroup (Ledger.Era.TxSeq era))
+    => ShelleyBlock (Consensus.Praos StandardCrypto) era -> PoolId
+getConwayProducer (ShelleyBlock (SL.Block (Consensus.Header header _) _) _) =
+    fromPoolKeyHash $ SL.hashKey (Consensus.hbVk header)
+
 fromCardanoBlock
     :: W.GenesisParameters
     -> CardanoBlock StandardCrypto
@@ -1007,6 +1008,30 @@ fromBabbagePParams eraInfo currentNodeProtocolParameters pp =
         , currentNodeProtocolParameters
         }
 
+fromConwayPParams
+    :: HasCallStack
+    => W.EraInfo Bound
+    -> Maybe Cardano.ProtocolParameters
+    -> Babbage.BabbagePParams StandardConway
+    -> W.ProtocolParameters
+fromConwayPParams eraInfo currentNodeProtocolParameters pp =
+    W.ProtocolParameters
+        { decentralizationLevel = decentralizationLevelFromPParams pp
+        , txParameters = txParametersFromPParams
+            (W.TokenBundleMaxSize $ W.TxSize $ Conway._maxValSize pp)
+            (fromLedgerExUnits (getField @"_maxTxExUnits" pp))
+            pp
+        , desiredNumberOfStakePools = desiredNumberOfStakePoolsFromPParams pp
+        , minimumUTxO = minimumUTxOForShelleyBasedEra ShelleyBasedEraConway pp
+        , stakeKeyDeposit = stakeKeyDepositFromPParams pp
+        , eras = fromBoundToEpochNo <$> eraInfo
+        , maximumCollateralInputCount =
+            unsafeIntToWord $ Conway._maxCollateralInputs pp
+        , minimumCollateralPercentage = Conway._collateralPercentage pp
+        , executionUnitPrices = Just $ executionUnitPricesFromPParams pp
+        , currentNodeProtocolParameters
+        }
+
 -- | Extract the current network decentralization level from the given set of
 -- protocol parameters.
 decentralizationLevelFromPParams

lib/wallet/src/Cardano/Wallet/Shelley/Network/Node.hs

@@ -46,6 +46,8 @@ import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
 import Cardano.Launcher.Node
     ( CardanoNodeConn, nodeSocketFile )
+import Cardano.Pool.Types
+    ( PoolId, StakePoolsSummary (..) )
 import Cardano.Wallet.Byron.Compatibility
     ( byronCodecConfig, protocolParametersFromUpdateState )
 import Cardano.Wallet.Logging
@@ -77,6 +79,7 @@ import Cardano.Wallet.Shelley.Compatibility
     , fromAllegraPParams
     , fromAlonzoPParams
     , fromBabbagePParams
+    , fromConwayPParams
     , fromMaryPParams
     , fromNonMyopicMemberRewards
     , fromPoint
@@ -214,6 +217,8 @@ import Ouroboros.Consensus.Protocol.Praos
     ( Praos )
 import Ouroboros.Consensus.Protocol.TPraos
     ( TPraos )
+import Ouroboros.Consensus.Shelley.Eras
+    ( StandardConway )
 import Ouroboros.Consensus.Shelley.Ledger.Config
     ( CodecConfig (..), getCompactGenesis )
 import Ouroboros.Network.Block
@@ -278,11 +283,10 @@ import qualified Cardano.Api as Cardano
 import qualified Cardano.Crypto.Hash as Crypto
 import qualified Cardano.Ledger.Alonzo.PParams as Alonzo
 import qualified Cardano.Ledger.Babbage.PParams as Babbage
+import qualified Cardano.Ledger.Conway.PParams as Conway
 import qualified Cardano.Ledger.Crypto as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.LedgerState as SL
-import Cardano.Pool.Types
-    ( PoolId, StakePoolsSummary (..) )
 import qualified Cardano.Wallet.Primitive.SyncProgress as SP
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as W
@@ -501,6 +505,8 @@ withNodeNetworkLayerBase
                 <$> LSQry Shelley.GetCurrentPParams)
             (Just . fromIntegral . Babbage._nOpt
                 <$> LSQry Shelley.GetCurrentPParams)
+            (Just . fromIntegral . Conway._nOpt
+                <$> LSQry Shelley.GetCurrentPParams)
 
         queryNonMyopicMemberRewards
             :: LSQ (CardanoBlock StandardCrypto) IO
@@ -713,6 +719,8 @@ mkWalletToNodeProtocols
                     <$> LSQry Shelley.GetCurrentPParams)
                 (Just . Cardano.fromLedgerPParams Cardano.ShelleyBasedEraBabbage
                     <$> LSQry Shelley.GetCurrentPParams)
+                (Just . Cardano.fromLedgerPParams Cardano.ShelleyBasedEraConway
+                    <$> LSQry Shelley.GetCurrentPParams)
 
             pp <- onAnyEra
                 (protocolParametersFromUpdateState eraBounds ppNode
@@ -727,6 +735,8 @@ mkWalletToNodeProtocols
                     <$> LSQry Shelley.GetCurrentPParams)
                 (fromBabbagePParams eraBounds ppNode
                     <$> LSQry Shelley.GetCurrentPParams)
+                (fromConwayPParams eraBounds ppNode
+                    <$> LSQry Shelley.GetCurrentPParams)
 
             return (pp, sp)
 
@@ -818,6 +828,7 @@ fetchRewardAccounts tr queryRewardQ accounts = do
                 shelleyQry
                 shelleyQry
                 shelleyQry
+                shelleyQry
 
         (res,logs) <- bracketQuery "queryRewards" tr (send queryRewardQ (SomeLSQ qry))
         liftIO $ mapM_ (traceWith tr) logs
@@ -1373,6 +1384,7 @@ byronOrShelleyBased onByron onShelleyBased = onAnyEra
     onShelleyBased
     onShelleyBased
     onShelleyBased
+    onShelleyBased
 
 -- | Create a local state query specific to the each era.
 --
@@ -1390,15 +1402,17 @@ onAnyEra
     -> LSQ (Shelley.ShelleyBlock (TPraos StandardCrypto) StandardMary) m a
     -> LSQ (Shelley.ShelleyBlock (TPraos StandardCrypto) StandardAlonzo) m a
     -> LSQ (Shelley.ShelleyBlock (Praos StandardCrypto) StandardBabbage) m a
+    -> LSQ (Shelley.ShelleyBlock (Praos StandardCrypto) StandardConway) m a
     -> LSQ (CardanoBlock StandardCrypto) m a
-onAnyEra onByron onShelley onAllegra onMary onAlonzo onBabbage =
+onAnyEra onByron onShelley onAllegra onMary onAlonzo onBabbage onConway =
     currentEra >>= \case
         AnyCardanoEra ByronEra -> mapQuery QueryIfCurrentByron onByron
         AnyCardanoEra ShelleyEra -> mapQuery QueryIfCurrentShelley onShelley
         AnyCardanoEra AllegraEra -> mapQuery QueryIfCurrentAllegra onAllegra
         AnyCardanoEra MaryEra -> mapQuery QueryIfCurrentMary onMary
         AnyCardanoEra AlonzoEra -> mapQuery QueryIfCurrentAlonzo onAlonzo
         AnyCardanoEra BabbageEra -> mapQuery QueryIfCurrentBabbage onBabbage
+        AnyCardanoEra ConwayEra -> mapQuery QueryIfCurrentConway onConway
   where
     mapQuery
         :: (forall r. BlockQuery block1 r