Skip to content

Commit

Permalink
chore: clean up the code
Browse files Browse the repository at this point in the history
  • Loading branch information
euonymos committed Dec 6, 2024
1 parent 2a866fd commit 92c7301
Show file tree
Hide file tree
Showing 14 changed files with 60 additions and 245 deletions.
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 10 additions & 6 deletions cem-script.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -53,9 +61,6 @@ common common-lang
UndecidableInstances
ViewPatterns

if flag(dev)
default-extensions: PartialTypeSignatures

default-language: GHC2021

common common-onchain
Expand Down Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion src-lib/cardano-extras/Cardano/Extras.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 0 additions & 2 deletions src-lib/data-spine/Data/Spine.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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|
Expand Down
8 changes: 4 additions & 4 deletions src/Cardano/CEM.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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.
Expand Down
1 change: 0 additions & 1 deletion src/Cardano/CEM/Indexing/Event.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 1 addition & 4 deletions src/Cardano/CEM/Monads.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -38,7 +37,6 @@ data SomeCEMAction where
SomeCEMAction

instance Show SomeCEMAction where
-- FIXME: show script name
show :: SomeCEMAction -> String
show (MkSomeCEMAction action) = show action

Expand All @@ -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)
Expand Down
4 changes: 2 additions & 2 deletions src/Cardano/CEM/Monads/CLB.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
Expand Down
151 changes: 0 additions & 151 deletions src/Cardano/CEM/Monads/L1.hs

This file was deleted.

28 changes: 9 additions & 19 deletions src/Cardano/CEM/Monads/L1Commons.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 92c7301

Please sign in to comment.