Skip to content

Commit 810c506

Browse files
koslambroukoslambrou
authored
SCP-2565: Define chain index query effect types in plutus-contract (IntersectMBO#3671)
1 parent b274898 commit 810c506

File tree

13 files changed

+205
-41
lines changed

13 files changed

+205
-41
lines changed

‎nix/pkgs/haskell/materialized-darwin/.plan.nix/playground-common.nix‎

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎nix/pkgs/haskell/materialized-darwin/.plan.nix/plutus-chain-index.nix‎

Lines changed: 1 addition & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎nix/pkgs/haskell/materialized-linux/.plan.nix/playground-common.nix‎

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎nix/pkgs/haskell/materialized-linux/.plan.nix/plutus-chain-index.nix‎

Lines changed: 1 addition & 2 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎playground-common/playground-common.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ library
6565
newtype-generics -any,
6666
process -any,
6767
prometheus >=2,
68+
plutus-chain-index -any,
6869
plutus-contract -any,
6970
plutus-ledger -any,
7071
row-types -any,

‎playground-common/src/PSGenerator/Common.hs‎

Lines changed: 28 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,9 @@ import Language.PureScript.Bridge (BridgePart, Language
1818
import Language.PureScript.Bridge.Builder (BridgeData)
1919
import Language.PureScript.Bridge.PSTypes (psArray, psInt, psNumber, psString)
2020
import Language.PureScript.Bridge.TypeParameters (A)
21-
import Ledger (Address, DatumHash, MintingPolicy, OnChainTx, PubKey,
22-
PubKeyHash, RedeemerPtr, ScriptTag, Signature, Tx, TxId,
23-
TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex,
21+
import Ledger (Address, BlockId, DatumHash, MintingPolicy, OnChainTx,
22+
PubKey, PubKeyHash, RedeemerPtr, ScriptTag, Signature, Tx,
23+
TxId, TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex,
2424
ValidationPhase, Validator)
2525
import Ledger.Ada (Ada)
2626
import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx)
@@ -36,10 +36,12 @@ import Ledger.TimeSlot (SlotConfig)
3636
import Ledger.Typed.Tx (ConnectionError, WrongOutTypeError)
3737
import Ledger.Value (AssetClass, CurrencySymbol, TokenName, Value)
3838
import Playground.Types (ContractCall, FunctionSchema, KnownCurrency)
39+
import Plutus.ChainIndex.Tx (ChainIndexTx)
40+
import Plutus.ChainIndex.Types (Page, PageSize, Tip)
3941
import Plutus.Contract.Checkpoint (CheckpointError)
40-
import Plutus.Contract.Effects (ActiveEndpoint, BalanceTxResponse, Depth, PABReq, PABResp,
41-
TxStatus, TxValidity, UtxoAtAddress,
42-
WriteBalancedTxResponse)
42+
import Plutus.Contract.Effects (ActiveEndpoint, BalanceTxResponse, ChainIndexQuery,
43+
ChainIndexResponse, Depth, PABReq, PABResp, TxStatus,
44+
TxValidity, UtxoAtAddress, WriteBalancedTxResponse)
4345
import Plutus.Contract.Resumable (IterationID, Request, RequestID, Response)
4446
import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceMsg,
4547
ContractInstanceTag, EmulatorRuntimeError, UserThreadMsg)
@@ -209,6 +211,12 @@ datumBridge = do
209211
typeModule ^== "Plutus.V1.Ledger.Scripts"
210212
pure psString
211213

214+
redeemerHashBridge :: BridgePart
215+
redeemerHashBridge = do
216+
typeName ^== "RedeemerHash"
217+
typeModule ^== "Plutus.V1.Ledger.Scripts"
218+
pure psString
219+
212220
redeemerBridge :: BridgePart
213221
redeemerBridge = do
214222
typeName ^== "Redeemer"
@@ -235,7 +243,13 @@ ledgerBytesBridge = do
235243

236244
ledgerBridge :: BridgePart
237245
ledgerBridge =
238-
scriptBridge <|> redeemerBridge <|> datumBridge <|> validatorHashBridge <|> mpsHashBridge <|> ledgerBytesBridge
246+
scriptBridge
247+
<|> redeemerHashBridge
248+
<|> redeemerBridge
249+
<|> datumBridge
250+
<|> validatorHashBridge
251+
<|> mpsHashBridge
252+
<|> ledgerBytesBridge
239253

240254
------------------------------------------------------------
241255
headersBridge :: BridgePart
@@ -293,6 +307,7 @@ ledgerTypes =
293307
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ValidationError)
294308
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ValidationPhase)
295309
, (order <*> (genericShow <*> mkSumType)) (Proxy @Address)
310+
, (order <*> (genericShow <*> mkSumType)) (Proxy @BlockId)
296311
, (order <*> (genericShow <*> mkSumType)) (Proxy @DatumHash)
297312
, (order <*> (genericShow <*> mkSumType)) (Proxy @PubKey)
298313
, (order <*> (genericShow <*> mkSumType)) (Proxy @PubKeyHash)
@@ -330,6 +345,12 @@ ledgerTypes =
330345
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ScriptType)
331346
, (equal <*> (genericShow <*> mkSumType)) (Proxy @PABReq)
332347
, (equal <*> (genericShow <*> mkSumType)) (Proxy @PABResp)
348+
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ChainIndexQuery)
349+
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ChainIndexResponse)
350+
, (equal <*> (genericShow <*> mkSumType)) (Proxy @ChainIndexTx)
351+
, (equal <*> (genericShow <*> mkSumType)) (Proxy @(Page A))
352+
, (equal <*> (genericShow <*> mkSumType)) (Proxy @Tip)
353+
, (equal <*> (genericShow <*> mkSumType)) (Proxy @PageSize)
333354
, (equal <*> (genericShow <*> mkSumType)) (Proxy @AddressChangeRequest)
334355
, (equal <*> (genericShow <*> mkSumType)) (Proxy @AddressChangeResponse)
335356
, (equal <*> (genericShow <*> mkSumType)) (Proxy @(EndpointValue A))

‎plutus-chain-index/plutus-chain-index.cabal‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,13 +47,12 @@ library
4747
aeson -any,
4848
base >=4.7 && <5,
4949
containers -any,
50+
data-default -any,
5051
fingertree -any,
5152
freer-simple -any,
5253
lens -any,
5354
prettyprinter >=1.1.0.1,
5455
semigroups -any,
55-
bytestring -any,
56-
data-default -any
5756

5857
test-suite plutus-chain-index-test
5958
import: lang

‎plutus-chain-index/src/Plutus/ChainIndex/Tx.hs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DeriveAnyClass #-}
12
{-# LANGUAGE DeriveGeneric #-}
23
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE NamedFieldPuns #-}
@@ -21,6 +22,7 @@ module Plutus.ChainIndex.Tx(
2122
) where
2223

2324
import Control.Lens (makeLenses)
25+
import Data.Aeson (FromJSON, ToJSON)
2426
import Data.Map (Map)
2527
import qualified Data.Map as Map
2628
import Data.Set (Set)
@@ -40,7 +42,7 @@ data ChainIndexTx = ChainIndexTx {
4042
_citxRedeemers :: Map RedeemerHash Redeemer,
4143
_citxMintingPolicies :: Map MintingPolicyHash MintingPolicy,
4244
_citxValidators :: Map ValidatorHash Validator
43-
} deriving (Show, Eq, Generic)
45+
} deriving (Show, Eq, Generic, ToJSON, FromJSON)
4446

4547
makeLenses ''ChainIndexTx
4648

‎plutus-chain-index/src/Plutus/ChainIndex/Types.hs‎

Lines changed: 16 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
1-
{-# LANGUAGE DeriveAnyClass #-}
2-
{-# LANGUAGE DerivingStrategies #-}
3-
{-# LANGUAGE DerivingVia #-}
4-
{-# LANGUAGE NamedFieldPuns #-}
1+
{-# LANGUAGE DeriveAnyClass #-}
2+
{-# LANGUAGE DerivingVia #-}
3+
{-# LANGUAGE NamedFieldPuns #-}
4+
{-# LANGUAGE OverloadedStrings #-}
55
{-| Misc. types used in this package
66
-}
77
module Plutus.ChainIndex.Types(
@@ -20,6 +20,7 @@ import GHC.Generics (Generic)
2020
import Ledger.Blockchain (BlockId (..))
2121
import Ledger.Slot (Slot)
2222
import Numeric.Natural (Natural)
23+
import Prettyprinter (Pretty (..), (<+>))
2324

2425
newtype PageSize = PageSize { getPageSize :: Natural }
2526
deriving stock (Eq, Ord, Show, Generic)
@@ -70,3 +71,14 @@ instance Ord Tip where
7071
TipAtGenesis <= _ = True
7172
_ <= TipAtGenesis = False
7273
(Tip _ _ ln) <= (Tip _ _ rn) = ln <= rn
74+
75+
instance Pretty Tip where
76+
pretty TipAtGenesis = "TipAtGenesis"
77+
pretty Tip {tipSlot, tipBlockId, tipBlockNo} =
78+
"Tip(slot="
79+
<+> pretty tipSlot
80+
<> ", blockId="
81+
<+> pretty tipBlockId
82+
<> ", blockNo="
83+
<+> pretty tipBlockNo
84+
<> ")"

0 commit comments

Comments
 (0)