Merge pull request #603 from IntersectMBO/mgalazyn/chore/cleanup-code…

…base Remove CPP extension from `Cardano.Api.Fees`. Use `IsList(toList,fromList)` instead of specialised functions.
IntersectMBO · Jul 30, 2024 · e4fdbbd · e4fdbbd
2 parents fbd4f0c + 53af1d8
commit e4fdbbd
Show file tree

Hide file tree

Showing 15 changed files with 111 additions and 81 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -221,7 +221,6 @@ library internal
     transformers,
     transformers-except ^>=0.1.3,
     typed-protocols ^>=0.1.1,
-    unordered-containers >=0.2.11,
     vector,
     yaml,
 

diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -95,7 +95,6 @@ import qualified Cardano.Ledger.Keys as Ledger
 
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
-import qualified Data.Foldable as Foldable
 import           Data.IP (IPv4, IPv6)
 import           Data.Maybe
 import qualified Data.Sequence.Strict as Seq
@@ -104,6 +103,7 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import           Data.Typeable
+import           GHC.Exts (IsList (..))
 import           Network.Socket (PortNumber)
 
 -- ----------------------------------------------------------------------------
@@ -678,11 +678,11 @@ fromShelleyPoolParams
       , stakePoolMargin = Ledger.unboundRational ppMargin
       , stakePoolRewardAccount = fromShelleyStakeAddr ppRewardAccount
       , stakePoolPledge = ppPledge
-      , stakePoolOwners = map StakeKeyHash (Set.toList ppOwners)
+      , stakePoolOwners = map StakeKeyHash (toList ppOwners)
       , stakePoolRelays =
           map
             fromShelleyStakePoolRelay
-            (Foldable.toList ppRelays)
+            (toList ppRelays)
       , stakePoolMetadata =
           fromShelleyPoolMetadata
             <$> Ledger.strictMaybeToMaybe ppMetadata

diff --git a/cardano-api/internal/Cardano/Api/DeserialiseAnyOf.hs b/cardano-api/internal/Cardano/Api/DeserialiseAnyOf.hs
@@ -41,10 +41,10 @@ import qualified Data.ByteString.Char8 as BSC
 import           Data.Char (toLower)
 import           Data.Data (Data)
 import           Data.List.NonEmpty (NonEmpty)
-import qualified Data.List.NonEmpty as NE
 import           Data.Text (Text)
 import qualified Data.Text.Encoding as Text
 import           Formatting (build, sformat, (%))
+import           GHC.Exts (IsList (..))
 import           Prettyprinter
 
 ------------------------------------------------------------------------------
@@ -113,7 +113,7 @@ deserialiseInput
   -> ByteString
   -> Either InputDecodeError a
 deserialiseInput asType acceptedFormats inputBs =
-  go (NE.toList acceptedFormats)
+  go (toList acceptedFormats)
  where
   inputText :: Text
   inputText = Text.decodeUtf8 inputBs

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -9,7 +8,6 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
 
 -- | Fee calculation
 module Cardano.Api.Fees
@@ -84,7 +82,6 @@ import qualified PlutusLedgerApi.V1 as Plutus
 import           Control.Monad (forM_)
 import           Data.Bifunctor (bimap, first, second)
 import           Data.ByteString.Short (ShortByteString)
-import           Data.Foldable (toList)
 import           Data.Function ((&))
 import qualified Data.List as List
 import           Data.Map.Strict (Map)
@@ -96,6 +93,7 @@ import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           GHC.Exts (IsList (..))
 import           Lens.Micro ((.~), (^.))
 
 {- HLINT ignore "Redundant return" -}
@@ -265,7 +263,10 @@ estimateBalancedTxBody
            in sum
                 [ maryEraOnwardsConstraints w $
                     L.getTotalDepositsTxCerts pparams assumeStakePoolHasNotBeenRegistered certificates
-                , mconcat $ map (^. L.pProcDepositL) $ toList proposalProcedures
+                , maryEraOnwardsConstraints w $
+                    mconcat $
+                      map (^. L.pProcDepositL) $
+                        toList proposalProcedures
                 ]
 
         availableUTxOValue =
@@ -718,7 +719,7 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc
       [ ( toScriptIndex aOnwards rdmrptr
         , bimap (fromAlonzoScriptExecutionError aOnwards) (second fromAlonzoExUnits) exunitsOrFailure
         )
-      | (rdmrptr, exunitsOrFailure) <- Map.toList exmap
+      | (rdmrptr, exunitsOrFailure) <- toList exmap
       ]
 
   fromAlonzoScriptExecutionError
@@ -931,7 +932,7 @@ handleExUnitsErrors ScriptValid failuresMap exUnitsMap =
     else Left (TxBodyScriptExecutionError failures)
  where
   failures :: [(ScriptWitnessIndex, ScriptExecutionError)]
-  failures = Map.toList failuresMap
+  failures = toList failuresMap
 handleExUnitsErrors ScriptInvalid failuresMap exUnitsMap
   | null failuresMap = Left TxBodyScriptBadScriptValidity
   | otherwise = Right $ Map.map (\_ -> ExecutionUnits 0 0) failuresMap <> exUnitsMap
@@ -1276,14 +1277,13 @@ calcReturnAndTotalCollateral
   -- ^ Total available collateral in lovelace
   -> (TxReturnCollateral CtxTx era, TxTotalCollateral era)
 calcReturnAndTotalCollateral _ _ _ TxInsCollateralNone _ _ _ _ = (TxReturnCollateralNone, TxTotalCollateralNone)
-calcReturnAndTotalCollateral _ _ _ _ rc@TxReturnCollateral{} tc@TxTotalCollateral{} _ _ = (rc, tc)
 calcReturnAndTotalCollateral retColSup fee pp' TxInsCollateral{} txReturnCollateral txTotalCollateral cAddr totalAvailableAda =
   do
     let colPerc = pp' ^. Ledger.ppCollateralPercentageL
-    -- We must first figure out how much lovelace we have committed
-    -- as collateral and we must determine if we have enough lovelace at our
-    -- collateral tx inputs to cover the tx
-    let totalCollateralLovelace = totalAvailableAda
+        -- We must first figure out how much lovelace we have committed
+        -- as collateral and we must determine if we have enough lovelace at our
+        -- collateral tx inputs to cover the tx
+        totalCollateralLovelace = totalAvailableAda
         requiredCollateral@(L.Coin reqAmt) = fromIntegral colPerc * fee
         totalCollateral =
           TxTotalCollateral retColSup . L.rationalToCoinViaCeiling $
@@ -1296,12 +1296,8 @@ calcReturnAndTotalCollateral retColSup fee pp' TxInsCollateral{} txReturnCollate
         L.Coin amt = totalCollateralLovelace * 100 - requiredCollateral
         returnCollateral = L.rationalToCoinViaFloor $ amt % 100
     case (txReturnCollateral, txTotalCollateral) of
-#if MIN_VERSION_base(4,16,0)
-#else
-      -- For ghc-9.2, this pattern match is redundant, but ghc-8.10 will complain if its missing.
       (rc@TxReturnCollateral{}, tc@TxTotalCollateral{}) ->
         (rc, tc)
-#endif
       (rc@TxReturnCollateral{}, TxTotalCollateralNone) ->
         (rc, TxTotalCollateralNone)
       (TxReturnCollateralNone, tc@TxTotalCollateral{}) ->
@@ -1395,14 +1391,36 @@ maybeDummyTotalCollAndCollReturnOutput sbe TxBodyContent{txInsCollateral, txRetu
         )
 
 substituteExecutionUnits
-  :: forall era. Map ScriptWitnessIndex ExecutionUnits
+  :: forall era
+   . Map ScriptWitnessIndex ExecutionUnits
   -> TxBodyContent BuildTx era
   -> Either (TxBodyErrorAutoBalance era) (TxBodyContent BuildTx era)
 substituteExecutionUnits
   exUnitsMap
-  txbodycontent@(TxBodyContent txIns _ _ _ _ _ _ _ _ _ _ _ _ txWithdrawals txCertificates _
-                   txMintValue _ txProposalProcedures txVotingProcedures _ _) = do
-
+  txbodycontent@( TxBodyContent
+                    txIns
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    _
+                    txWithdrawals
+                    txCertificates
+                    _
+                    txMintValue
+                    _
+                    txProposalProcedures
+                    txVotingProcedures
+                    _
+                    _
+                  ) = do
     mappedTxIns <- mapScriptWitnessesTxIns txIns
     mappedWithdrawals <- mapScriptWitnessesWithdrawals txWithdrawals
     mappedMintedVals <- mapScriptWitnessesMinting txMintValue
@@ -1418,7 +1436,6 @@ substituteExecutionUnits
         & setTxWithdrawals mappedWithdrawals
         & setTxVotingProcedures mappedVotes
         & setTxProposalProcedures mappedProposals
-
    where
     substituteExecUnits
       :: ScriptWitnessIndex
@@ -1531,43 +1548,52 @@ substituteExecutionUnits
 
     mapScriptWitnessesVotes
       :: Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era))
-      -> Either (TxBodyErrorAutoBalance era) (Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
+      -> Either
+          (TxBodyErrorAutoBalance era)
+          (Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era)))
     mapScriptWitnessesVotes Nothing = return Nothing
     mapScriptWitnessesVotes (Just (Featured _ TxVotingProceduresNone)) = return Nothing
     mapScriptWitnessesVotes (Just (Featured _ (TxVotingProcedures _ ViewTx))) = return Nothing
     mapScriptWitnessesVotes (Just (Featured era (TxVotingProcedures vProcedures (BuildTxWith sWitMap)))) = do
-
       let eSubstitutedExecutionUnits =
             [ (vote, updatedWitness)
             | let allVoteMap = L.unVotingProcedures vProcedures
-            , (vote, scriptWitness) <- Map.toList sWitMap
+            , (vote, scriptWitness) <- toList sWitMap
             , index <- maybeToList $ Map.lookupIndex vote allVoteMap
             , let updatedWitness = substituteExecUnits (ScriptWitnessIndexVoting $ fromIntegral index) scriptWitness
             ]
 
-      substitutedExecutionUnits  <- traverseScriptWitnesses eSubstitutedExecutionUnits
+      substitutedExecutionUnits <- traverseScriptWitnesses eSubstitutedExecutionUnits
 
-      return $ Just (Featured era (TxVotingProcedures vProcedures (BuildTxWith $ Map.fromList substitutedExecutionUnits)))
+      return $
+        Just
+          (Featured era (TxVotingProcedures vProcedures (BuildTxWith $ Map.fromList substitutedExecutionUnits)))
 
     mapScriptWitnessesProposals
       :: Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era))
-      -> Either (TxBodyErrorAutoBalance era) (Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
+      -> Either
+          (TxBodyErrorAutoBalance era)
+          (Maybe (Featured ConwayEraOnwards era (TxProposalProcedures build era)))
     mapScriptWitnessesProposals Nothing = return Nothing
     mapScriptWitnessesProposals (Just (Featured _ TxProposalProceduresNone)) = return Nothing
     mapScriptWitnessesProposals (Just (Featured _ (TxProposalProcedures _ ViewTx))) = return Nothing
     mapScriptWitnessesProposals (Just (Featured era (TxProposalProcedures osetProposalProcedures (BuildTxWith sWitMap)))) = do
       let eSubstitutedExecutionUnits =
             [ (proposal, updatedWitness)
             | let allProposalsList = toList osetProposalProcedures
-            , (proposal, scriptWitness) <- Map.toList sWitMap
+            , (proposal, scriptWitness) <- toList sWitMap
             , index <- maybeToList $ List.elemIndex proposal allProposalsList
             , let updatedWitness = substituteExecUnits (ScriptWitnessIndexProposing $ fromIntegral index) scriptWitness
             ]
 
-      substitutedExecutionUnits  <- traverseScriptWitnesses eSubstitutedExecutionUnits
-
-      return $ Just (Featured era (TxProposalProcedures osetProposalProcedures (BuildTxWith $ Map.fromList substitutedExecutionUnits)))
+      substitutedExecutionUnits <- traverseScriptWitnesses eSubstitutedExecutionUnits
 
+      return $
+        Just
+          ( Featured
+              era
+              (TxProposalProcedures osetProposalProcedures (BuildTxWith $ Map.fromList substitutedExecutionUnits))
+          )
 
     mapScriptWitnessesMinting
       :: TxMintValue BuildTx era

diff --git a/cardano-api/internal/Cardano/Api/IPC.hs b/cardano-api/internal/Cardano/Api/IPC.hs
@@ -127,8 +127,8 @@ import           Control.Monad.IO.Class
 import           Control.Tracer (nullTracer)
 import           Data.Aeson (ToJSON, object, toJSON, (.=))
 import qualified Data.ByteString.Lazy as LBS
-import qualified Data.Map.Strict as Map
 import           Data.Void (Void)
+import           GHC.Exts (IsList (..))
 
 -- ----------------------------------------------------------------------------
 -- The types for the client side of the node-to-client IPC protocols
@@ -255,7 +255,7 @@ mkVersionedProtocols networkid ptcl unversionedClients =
             }
           (protocols (unversionedClients ptclVersion) ptclBlockVersion ptclVersion)
     )
-    (Map.toList (Consensus.supportedNodeToClientVersions proxy))
+    (toList (Consensus.supportedNodeToClientVersions proxy))
  where
   proxy :: Proxy block
   proxy = Proxy

diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs
@@ -152,6 +152,7 @@ import           Data.Maybe.Strict (StrictMaybe (..))
 import           Data.String (IsString)
 import           Data.Text (Text)
 import           Data.Word
+import           GHC.Exts (IsList (..))
 import           GHC.Generics
 import           Lens.Micro
 import           Numeric.Natural
@@ -1014,7 +1015,7 @@ toAlonzoCostModels
   :: Map AnyPlutusScriptVersion CostModel
   -> Either ProtocolParametersConversionError Alonzo.CostModels
 toAlonzoCostModels m = do
-  f <- mapM conv $ Map.toList m
+  f <- mapM conv $ toList m
   Right $ Plutus.mkCostModels $ Map.fromList f
  where
   conv
@@ -1030,7 +1031,7 @@ fromAlonzoCostModels
 fromAlonzoCostModels cModels =
   Map.fromList
     . map (bimap fromAlonzoScriptLanguage fromAlonzoCostModel)
-    $ Map.toList
+    $ toList
     $ Plutus.costModelsValid cModels
 
 toAlonzoScriptLanguage :: AnyPlutusScriptVersion -> Plutus.Language

diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
@@ -122,7 +122,6 @@ import           Data.Aeson.Types (Parser)
 import           Data.Bifunctor (bimap, first)
 import qualified Data.ByteString.Lazy as LBS
 import           Data.Either.Combinators (rightToMaybe)
-import qualified Data.HashMap.Strict as HMS
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (mapMaybe)
@@ -132,6 +131,7 @@ import           Data.SOP.Constraint (SListI)
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Word (Word64)
+import           GHC.Exts (IsList (..))
 import           GHC.Stack
 
 -- ----------------------------------------------------------------------------
@@ -374,7 +374,7 @@ instance
   => FromJSON (UTxO era)
   where
   parseJSON = withObject "UTxO" $ \hm -> do
-    let l = HMS.toList $ KeyMap.toHashMapText hm
+    let l = toList $ KeyMap.toHashMapText hm
     res <- mapM toTxIn l
     pure . UTxO $ Map.fromList res
    where
@@ -475,7 +475,7 @@ toShelleyAddrSet era =
     -- e.g. Shelley addresses in the Byron era, as these would not
     -- appear in the UTxO anyway.
     . mapMaybe (rightToMaybe . anyAddressInEra era)
-    . Set.toList
+    . toList
 
 toLedgerUTxO
   :: ()
@@ -487,7 +487,7 @@ toLedgerUTxO sbe (UTxO utxo) =
     $ Shelley.UTxO
       . Map.fromList
       . map (bimap toShelleyTxIn (toShelleyTxOut sbe))
-      . Map.toList
+      . toList
     $ utxo
 
 fromLedgerUTxO
@@ -500,7 +500,7 @@ fromLedgerUTxO sbe (Shelley.UTxO utxo) =
     $ UTxO
       . Map.fromList
       . map (bimap fromShelleyTxIn (fromShelleyTxOut sbe))
-      . Map.toList
+      . toList
     $ utxo
 
 fromShelleyPoolDistr
@@ -511,7 +511,7 @@ fromShelleyPoolDistr =
   -- Map.fromListAsc or to use Map.mapKeysMonotonic
   Map.fromList
     . map (bimap StakePoolKeyHash Consensus.individualPoolStake)
-    . Map.toList
+    . toList
     . Consensus.unPoolDistr
 
 fromShelleyDelegations
@@ -526,7 +526,7 @@ fromShelleyDelegations =
   -- do not match the one for StakeCredential
   Map.fromList
     . map (bimap fromShelleyStakeCredential StakePoolKeyHash)
-    . Map.toList
+    . toList
 
 fromShelleyRewardAccounts
   :: Shelley.RewardAccounts Consensus.StandardCrypto
@@ -536,7 +536,7 @@ fromShelleyRewardAccounts =
   -- Map.fromListAsc or to use Map.mapKeysMonotonic
   Map.fromList
     . map (first fromShelleyStakeCredential)
-    . Map.toList
+    . toList
 
 -- ----------------------------------------------------------------------------
 -- Conversions of queries into the consensus types.