Skip to content

Commit 55059dc

Browse files
committed
add contracts uplc files
1 parent 60193b0 commit 55059dc

File tree

11 files changed

+156
-15
lines changed

11 files changed

+156
-15
lines changed
Binary file not shown.
Binary file not shown.
Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE DeriveAnyClass #-}
4+
{-# LANGUAGE DeriveGeneric #-}
5+
{-# LANGUAGE DerivingStrategies #-}
6+
{-# LANGUAGE EmptyDataDecls #-}
7+
{-# LANGUAGE FlexibleContexts #-}
8+
{-# LANGUAGE FlexibleInstances #-}
9+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10+
{-# LANGUAGE MultiParamTypeClasses #-}
11+
{-# LANGUAGE NamedFieldPuns #-}
12+
{-# LANGUAGE OverloadedStrings #-}
13+
{-# LANGUAGE PartialTypeSignatures #-}
14+
{-# LANGUAGE RecordWildCards #-}
15+
{-# LANGUAGE ScopedTypeVariables #-}
16+
{-# LANGUAGE TemplateHaskell #-}
17+
{-# LANGUAGE TypeApplications #-}
18+
{-# LANGUAGE TypeFamilies #-}
19+
{-# LANGUAGE TypeOperators #-}
20+
{-# LANGUAGE ViewPatterns #-}
21+
{-# LANGUAGE NoImplicitPrelude #-}
22+
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
23+
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
24+
{-# OPTIONS_GHC -fno-specialise #-}
25+
{-# OPTIONS_GHC -fno-strictness #-}
26+
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:profile-all #-}
27+
28+
module ErgoDex.Contracts.Proxy.Vesting where
29+
30+
import qualified Prelude as Haskell
31+
32+
import qualified GHC.Generics as GHC
33+
import Plutus.V1.Ledger.Api (PubKeyHash, POSIXTime)
34+
import Plutus.V1.Ledger.Value
35+
import qualified PlutusTx
36+
import PlutusTx.Prelude
37+
38+
data VestingRedeemer = VestingRedeemer
39+
{ vestingInIx :: Integer
40+
, rewardOutIx :: Integer
41+
}
42+
deriving stock (Haskell.Show, GHC.Generic)
43+
44+
PlutusTx.makeIsDataIndexed ''VestingRedeemer [('VestingRedeemer, 0)]
45+
PlutusTx.makeLift ''VestingRedeemer
46+
47+
data VestingConfig = VestingConfig
48+
{ deadline :: POSIXTime
49+
, pkh :: PubKeyHash
50+
, vestingAC :: AssetClass
51+
}
52+
deriving stock (Haskell.Show, GHC.Generic)
53+
54+
PlutusTx.makeIsDataIndexed ''VestingConfig [('VestingConfig, 0)]
55+
PlutusTx.makeLift ''VestingConfig
Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE DeriveAnyClass #-}
4+
{-# LANGUAGE DeriveGeneric #-}
5+
{-# LANGUAGE DerivingStrategies #-}
6+
{-# LANGUAGE EmptyDataDecls #-}
7+
{-# LANGUAGE FlexibleContexts #-}
8+
{-# LANGUAGE FlexibleInstances #-}
9+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10+
{-# LANGUAGE MultiParamTypeClasses #-}
11+
{-# LANGUAGE NamedFieldPuns #-}
12+
{-# LANGUAGE OverloadedStrings #-}
13+
{-# LANGUAGE PartialTypeSignatures #-}
14+
{-# LANGUAGE RecordWildCards #-}
15+
{-# LANGUAGE ScopedTypeVariables #-}
16+
{-# LANGUAGE TemplateHaskell #-}
17+
{-# LANGUAGE TypeApplications #-}
18+
{-# LANGUAGE TypeFamilies #-}
19+
{-# LANGUAGE TypeOperators #-}
20+
{-# LANGUAGE ViewPatterns #-}
21+
{-# LANGUAGE NoImplicitPrelude #-}
22+
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
23+
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
24+
{-# OPTIONS_GHC -fno-specialise #-}
25+
{-# OPTIONS_GHC -fno-strictness #-}
26+
{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:profile-all #-}
27+
28+
module ErgoDex.Contracts.Proxy.VestingWithPeriod where
29+
30+
import qualified Prelude as Haskell
31+
32+
import qualified GHC.Generics as GHC
33+
import Plutus.V1.Ledger.Api (PubKeyHash, POSIXTime)
34+
import Plutus.V1.Ledger.Value
35+
import qualified PlutusTx
36+
import PlutusTx.Prelude
37+
38+
data VestingWithPeriodRedeemer = VestingWithPeriodRedeemer
39+
{ vestingInIx :: Integer
40+
, vestingPeriodIdx :: Integer
41+
}
42+
deriving stock (Haskell.Show, GHC.Generic)
43+
44+
PlutusTx.makeIsDataIndexed ''VestingWithPeriodRedeemer [('VestingWithPeriodRedeemer, 0)]
45+
PlutusTx.makeLift ''VestingWithPeriodRedeemer
46+
47+
data VestingWithPeriodConfig = VestingWithPeriodConfig
48+
{ vestingStart :: POSIXTime
49+
, vestingPeriodDuration :: POSIXTime
50+
, totalVested :: Integer
51+
, periodVested :: Integer
52+
, pkhs :: [PubKeyHash]
53+
, vestingAC :: AssetClass
54+
}
55+
deriving stock (Haskell.Show, GHC.Generic)
56+
57+
PlutusTx.makeIsDataIndexed ''VestingWithPeriodConfig [('VestingWithPeriodConfig, 0)]
58+
PlutusTx.makeLift ''VestingWithPeriodConfig

cardano-dex-contracts-offchain/ErgoDex/PValidators.hs

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,8 @@ module ErgoDex.PValidators (
33
swapValidator,
44
depositValidator,
55
redeemValidator,
6+
vestingValidator,
7+
vestingWithPeriodValidator,
68
simpleStakingValidator,
79
lockPkhStakingValidator
810
) where
@@ -51,6 +53,18 @@ lockPkhStakingValidatorDataFileName = "stakinWithPkh.uplc"
5153
lockPkhStakingValidator :: (MonadIO m) => m PV2.Validator
5254
lockPkhStakingValidator = readValidatorFromFile lockPkhStakingValidatorDataFileName
5355

56+
vestingValidatorDataFileName :: String
57+
vestingValidatorDataFileName = "vesting.uplc"
58+
59+
vestingValidator :: (MonadIO m) => m PV2.Validator
60+
vestingValidator = readValidatorFromFile vestingValidatorDataFileName
61+
62+
vestingWithPeriodValidatorDataFileName :: String
63+
vestingWithPeriodValidatorDataFileName = "vestingWithPeriod.uplc"
64+
65+
vestingWithPeriodValidator :: (MonadIO m) => m PV2.Validator
66+
vestingWithPeriodValidator = readValidatorFromFile vestingWithPeriodValidatorDataFileName
67+
5468
readValidatorFromFile :: (MonadIO m) => String -> m PV2.Validator
5569
readValidatorFromFile dataFieldName = do
5670
path <- liftIO $ getDataFileName dataFieldName

cardano-dex-contracts-offchain/cardano-dex-contracts-offchain.cabal

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@ license: CC0-1.0
1515
license-files: LICENSE
1616
author: ErgoLabs
1717
maintainer: [email protected]
18-
data-files: deposit.uplc swap.uplc redeem.uplc pool.uplc simpleStaking.uplc
18+
data-files: deposit.uplc swap.uplc redeem.uplc pool.uplc vesting.uplc vestingWithPeriod.uplc simpleStaking.uplc
1919
data-dir: Contracts
2020

2121
-- A copyright notice.
@@ -106,6 +106,8 @@ library
106106
ErgoDex.Contracts.Proxy.Deposit
107107
ErgoDex.Contracts.Proxy.Order
108108
ErgoDex.Contracts.Proxy.Redeem
109+
ErgoDex.Contracts.Proxy.Vesting
110+
ErgoDex.Contracts.Proxy.VestingWithPeriod
109111
ErgoDex.PValidators
110112
ErgoDex.Contracts.Proxy.Swap
111113
ErgoDex.Contracts.Typed

cardano-dex-contracts-offchain/test/Tests/Contracts.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,8 @@ checkContractsRecovering = testGroup "ContractsRecovering"
1515
, HH.testProperty "pool_contract_recovering" poolRecovering
1616
, HH.testProperty "deposit_contract_recovering" depositRecovering
1717
, HH.testProperty "redeem_contract_recovering" redeemRecovering
18+
, HH.testProperty "vesting_contract_recovering" redeemRecovering
19+
, HH.testProperty "vesting_with_period_contract_recovering" redeemRecovering
1820
]
1921

2022
swapRecovering :: Property
@@ -28,3 +30,10 @@ redeemRecovering = withTests 1 . property $ evalIO (void redeemValidator)
2830

2931
poolRecovering :: Property
3032
poolRecovering = withTests 1 . property $ evalIO (void poolValidator)
33+
34+
vestingRecovering :: Property
35+
vestingRecovering = withTests 1 . property $ evalIO (void vestingValidator)
36+
37+
vestingWithPeriodRecovering :: Property
38+
vestingWithPeriodRecovering = withTests 1 . property $ evalIO (void vestingWithPeriodValidator)
39+

cardano-dex-contracts-onchain/ErgoDex/PContracts/PVestingWithPeriod.hs

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ import Plutarch
1111
import Plutarch.List
1212
import Plutarch.Api.V2
1313
import Plutarch.Extra.Interval
14+
import Plutarch.Extra.Api
1415
import Plutarch.DataRepr
1516
import Plutarch.Lift
1617
import Plutarch.Prelude
@@ -100,17 +101,17 @@ vestingWithPeriodValidatorT = plam $ \conf' redeemer' ctx' -> unTermCont $ do
100101
correctReward <-
101102
tlet $
102103
isLastPeriod #|| (checkRewardCorrectness # ctx' # totalVested # periodVested # vestingPeriodIdx # vestingAC)
103-
104-
pure $ validTime #&& validSignature #&& correctReward
105-
104+
pure $ validTime
105+
#&& validSignature
106+
#&& correctReward
106107

107108
checkRewardCorrectness :: Term s (PScriptContext :--> PInteger :--> PInteger :--> PInteger :--> PAssetClass :--> PBool)
108109
checkRewardCorrectness =
109-
plam $ \ctx totalVested periodVested periodId vestingAC ->
110+
plam $ \ctx totalVested periodVested periodId vestingAC -> unTermCont $ do
110111
let
111112
selfOutputsList = getContinuingOutputs # ctx
112113
selfOutput = phead # selfOutputsList
113114
selfValue = pfield @"value" # selfOutput
114115
correctOutQty = totalVested - (periodId * periodVested)
115116
realOutQty = assetClassValueOf # selfValue # vestingAC
116-
in realOutQty #== correctOutQty
117+
pure $ realOutQty #== correctOutQty

cardano-dex-contracts-onchain/ErgoDex/PValidators.hs

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -12,11 +12,13 @@ module ErgoDex.PValidators (
1212
import PlutusLedgerApi.V1.Scripts (Validator (getValidator))
1313
import PlutusLedgerApi.V1.Address
1414

15-
import qualified ErgoDex.PContracts.PDeposit as PD
16-
import qualified ErgoDex.PContracts.PPool as PP
17-
import qualified ErgoDex.PContracts.PRedeem as PR
18-
import qualified ErgoDex.PContracts.PSwap as PS
19-
import qualified ErgoDex.PContracts.PVesting as PV
15+
import qualified ErgoDex.PContracts.PDeposit as PD
16+
import qualified ErgoDex.PContracts.PPool as PP
17+
import qualified ErgoDex.PContracts.PRedeem as PR
18+
import qualified ErgoDex.PContracts.PSwap as PS
19+
import qualified ErgoDex.PContracts.PVesting as PV
20+
21+
import qualified ErgoDex.PContracts.PVestingWithPeriod as PVWP
2022

2123
import Plutarch
2224
import Plutarch.Api.V2 (mkValidator, validatorHash)
@@ -26,7 +28,7 @@ import Plutarch.Unsafe (punsafeCoerce)
2628
import Plutarch.Internal
2729

2830
cfgForValidator :: Config
29-
cfgForValidator = Config NoTracing
31+
cfgForValidator = Config DoTracingAndBinds
3032

3133
wrapValidator ::
3234
(PIsData dt, PIsData rdmr) =>
@@ -54,7 +56,7 @@ vestingValidator :: Validator
5456
vestingValidator = mkValidator cfgForValidator $ wrapValidator PV.vestingValidatorT
5557

5658
vestingWithPeriodValidator :: Validator
57-
vestingWithPeriodValidator = mkValidator cfgForValidator $ wrapValidator PV.vestingValidatorT
59+
vestingWithPeriodValidator = mkValidator cfgForValidator $ wrapValidator PVWP.vestingWithPeriodValidatorT
5860

5961
validatorAddress :: Validator -> Address
6062
validatorAddress = scriptHashAddress . validatorHash

cardano-dex-contracts-onchain/test/Eval.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ import UntypedPlutusCore (DeBruijn, DefaultFun, DefaultUni, Program)
1313
import PlutusTx (Data)
1414

1515
evalConfig :: Config
16-
evalConfig = Config DoTracing
16+
evalConfig = Config NoTracing
1717

1818
evalWithArgs :: ClosedTerm a -> [Data] -> Either Text (ExBudget, [Text], Program DeBruijn DefaultUni DefaultFun ())
1919
evalWithArgs x args = do

0 commit comments

Comments
 (0)