Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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
Loading