Merge pull request #109 from mlabs-haskell/euonymos/final-clean-up

Final code clean-up

Author: euonymos

cabal.project

@@ -22,7 +22,7 @@ source-repository-package
   tag: d5b0e7ce07258482d53704ce19383013b1fa6610
   --sha256: 6+Os/mQDzBOU+TkTD+n/T1MFcI+Mn0/tcBMJhLRfqyA=
 
--- FIXME: Cannot use new commit, because it requires `plutus-ledger-api==1.29`
+-- Cannot use new commit, because it requires `plutus-ledger-api==1.29`
 source-repository-package
   type: git
   location: https://github.com/Plutonomicon/plutarch-plutus

cem-script.cabal

@@ -15,9 +15,11 @@ flag dev
   default:     True
   manual:      False
 
-common common-lang
-  -- Options from MLabs styleguide
+flag force-recomp
+  description: Compile with -fforce-recomp and -Wunused-packages
+  default:     False
 
+common common-lang
   ghc-options:
     -Wall -Wcompat -Wincomplete-record-updates
     -Wincomplete-uni-patterns -Wredundant-constraints
@@ -26,6 +28,12 @@ common common-lang
   if !flag(dev)
     ghc-options: -Werror
 
+  if flag(dev)
+    default-extensions: PartialTypeSignatures
+
+  if flag(force-recomp)
+    ghc-options: -fforce-recomp -Wunused-packages
+
   build-depends:
     , base
     , extra
@@ -53,9 +61,6 @@ common common-lang
     UndecidableInstances
     ViewPatterns
 
-  if flag(dev)
-    default-extensions: PartialTypeSignatures
-
   default-language:   GHC2021
 
 common common-onchain
@@ -150,7 +155,6 @@ library
     Cardano.CEM.Indexing.Tx
     Cardano.CEM.Monads
     Cardano.CEM.Monads.CLB
-    Cardano.CEM.Monads.L1
     Cardano.CEM.OffChain
     Cardano.CEM.OnChain
     Cardano.CEM.Testing.StateMachine

src-lib/cardano-extras/Cardano/Extras.hs

@@ -275,7 +275,6 @@ mintedTokens ::
   [(AssetName, Quantity)] ->
   Cardano.TxMintValue BuildTx Era
 mintedTokens script redeemer assets =
-  -- FIXME: is hardcoding era correct?
   TxMintValue Cardano.MaryEraOnwardsBabbage mintedTokens' mintedWitnesses'
   where
     mintedTokens' = valueFromList (fmap (first (AssetId policyId)) assets)

src-lib/data-spine/Data/Spine.hs

@@ -88,8 +88,6 @@ deriveSpine name = do
     suffix = "Spine"
     spineName = addSuffix name suffix
   spineDec <- deriveTags name suffix [''Eq, ''Ord, ''Enum, ''Show]
-  -- TODO: derive Sing
-  -- TODO: derive HasField (OfSpine ...)
 
   decls <-
     [d|

src/Cardano/CEM.hs

@@ -111,7 +111,7 @@ class
 type EqShow datatype =
   ( Prelude.Eq datatype
   , Prelude.Show datatype
-  -- TODO: add IsData here? (now it breaks Plutus compilation)
+  -- Shoul we add IsData here? (now it breaks Plutus compilation)
   )
 
 {- | All associated types for 'CEMScript' class defined separately to simplify
@@ -223,7 +223,7 @@ data TxFanKind
 -- | Constraint on a single tx fan
 data TxFanFilter script = MkTxFanFilter
   { address :: AddressSpec
-  , rest :: FilterDatum script -- TODO: not ideal naming
+  , datumFilter :: FilterDatum script
   }
   deriving stock (Show, Prelude.Eq)
 
@@ -252,8 +252,8 @@ bySameCEM = UnsafeBySameCEM . toBuiltinData
 
 -- | How many tx fans should satify a 'TxFansConstraint'
 data Quantifier
-  = ExactlyNFans Integer -- TODO: use natural numbers
-  | FansWithTotalValueOfAtLeast Value -- TODO: use natural numbers
+  = ExactlyNFans Integer -- Here we'd better use natural numbers
+  | FansWithTotalValueOfAtLeast Value
   deriving stock (Show)
 
 -- | A constraint on Tx inputs or Outputs.

src/Cardano/CEM/Indexing/Event.hs

@@ -43,7 +43,6 @@ import Prelude
   (3) For the final transition the situation is like (2) except the target
   datum is missing, which doesn't matter.
 
-
   TODO: How we can improve this in the future:
   * API is probably bad, as we always have some transition like Init state -
   which you can decode, as you have State. If one changes data

src/Cardano/CEM/Monads.hs

@@ -29,7 +29,6 @@ data CEMAction script
 deriving stock instance
   (CEMScript script) => Show (CEMAction script)
 
--- FIXME: use generic Some
 data SomeCEMAction where
   MkSomeCEMAction ::
     forall script.
@@ -38,7 +37,6 @@ data SomeCEMAction where
     SomeCEMAction
 
 instance Show SomeCEMAction where
-  -- FIXME: show script name
   show :: SomeCEMAction -> String
   show (MkSomeCEMAction action) = show action
 
@@ -54,8 +52,7 @@ data TxSpec = MkTxSpec
 data BlockchainParams = MkBlockchainParams
   { protocolParameters :: PParams LedgerEra
   , systemStart :: SystemStart
-  , -- FIXME: rename
-    eraHistory :: LedgerEpochInfo
+  , ledgerEpochInfo :: LedgerEpochInfo
   , stakePools :: Set PoolId
   }
   deriving stock (Show)

src/Cardano/CEM/Monads/CLB.hs

@@ -60,14 +60,14 @@ instance
   queryBlockchainParams = do
     protocolParameters <- gets (mockConfigProtocol . mockConfig)
     slotConfig <- gets (mockConfigSlotConfig . mockConfig)
-    eraHistory <- LedgerEpochInfo <$> getEpochInfo
+    ledgerEpochInfo <- LedgerEpochInfo <$> getEpochInfo
     let systemStart =
           SystemStart $ posixTimeToUTCTime $ scSlotZeroTime slotConfig
     return $
       MkBlockchainParams
         { protocolParameters
         , systemStart
-        , eraHistory
+        , ledgerEpochInfo
         , -- Staking is not supported
           stakePools = Set.empty
         }

src/Cardano/CEM/Monads/L1.hs

@@ -3,31 +3,22 @@
 -- | Code common for resolving Tx of backends which use `cardano-api`
 module Cardano.CEM.Monads.L1Commons where
 
-import Prelude
-
-import Data.List (nub)
-import Data.Map qualified as Map
-
--- Cardano imports
 import Cardano.Api hiding (queryUtxo)
 import Cardano.Api.Shelley (LedgerProtocolParameters (..))
-
--- Project imports
 import Cardano.CEM.Monads
 import Cardano.CEM.OffChain
 import Cardano.Extras
+import Data.List (nub)
+import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
+import Prelude
 
--- Main function
-
+-- | Main function
 cardanoTxBodyFromResolvedTx ::
   (MonadQueryUtxo m, MonadBlockchainParams m) =>
   ResolvedTx ->
   m (Either (TxBodyErrorAutoBalance Era) (TxBodyContent BuildTx Era, TxBody Era, TxInMode, UTxO Era))
 cardanoTxBodyFromResolvedTx (MkResolvedTx {..}) = do
-  -- (lowerBound, upperBound) <- convertValidityBound validityBound
-
-  -- FIXME: proper fee coverage selection
   utxo <- queryUtxo $ ByAddresses [signingKeyToAddress signer]
   let
     feeTxIns = Map.keys $ unUTxO utxo
@@ -41,8 +32,7 @@ cardanoTxBodyFromResolvedTx (MkResolvedTx {..}) = do
 
   let preBody =
         TxBodyContent
-          { -- FIXME: duplicate TxIn for coin-selection redeemer bug
-            txIns = nub allTxIns
+          { txIns = nub allTxIns -- duplicate TxIn for coin-selection redeemer bug
           , txInsCollateral =
               TxInsCollateral AlonzoEraOnwardsBabbage feeTxIns
           , txInsReference =
@@ -98,14 +88,14 @@ cardanoTxBodyFromResolvedTx (MkResolvedTx {..}) = do
     recordFee txInsUtxo body@(TxBody content) = do
       case txFee content of
         TxFeeExplicit era coin -> do
-          MkBlockchainParams {protocolParameters, systemStart, eraHistory} <-
+          MkBlockchainParams {protocolParameters, systemStart, ledgerEpochInfo} <-
             queryBlockchainParams
           Right report <-
             return $
               evaluateTransactionExecutionUnits
                 (shelleyBasedToCardanoEra era)
                 systemStart
-                eraHistory
+                ledgerEpochInfo
                 (LedgerProtocolParameters protocolParameters)
                 txInsUtxo
                 body
@@ -150,13 +140,13 @@ callBodyAutoBalance
   preBody
   utxo
   changeAddress = do
-    MkBlockchainParams {protocolParameters, systemStart, eraHistory, stakePools} <-
+    MkBlockchainParams {protocolParameters, systemStart, ledgerEpochInfo, stakePools} <-
       queryBlockchainParams
     let result =
           makeTransactionBodyAutoBalance @Era
             shelleyBasedEra
             systemStart
-            eraHistory
+            ledgerEpochInfo
             (LedgerProtocolParameters protocolParameters)
             stakePools
             Map.empty -- Stake credentials