Skip to content

Commit 7850574

Browse files
committed
vesting contracts
1 parent 65cec24 commit 7850574

File tree

26 files changed

+1203
-19
lines changed

26 files changed

+1203
-19
lines changed
2.04 KB
Binary file not shown.
2.32 KB
Binary file not shown.

cardano-dex-contracts-offchain/ErgoDex/Contracts/Pool.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ import qualified Prelude as Haskell
3838

3939
import ErgoDex.Contracts.Types
4040
import qualified GHC.Generics as Haskell
41-
import Plutus.V1.Ledger.Value (AssetClass, assetClassValueOf, flattenValue)
41+
import Plutus.V1.Ledger.Value (AssetClass, assetClassValueOf, flattenValue, CurrencySymbol)
4242
import Plutus.V1.Ledger.Api (PubKeyHash)
4343
import qualified PlutusTx
4444
import PlutusTx.Builtins
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/Contracts/Typed.hs

Lines changed: 7 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,10 +7,10 @@ module ErgoDex.Contracts.Typed where
77

88
import qualified Prelude as Haskell
99

10-
import Data.Aeson (FromJSON, ToJSON)
1110
import ErgoDex.Contracts.Class
1211
import qualified ErgoDex.Contracts.Pool as P
1312
import ErgoDex.Contracts.Types
13+
import Plutus.V1.Ledger.Value (CurrencySymbol(..))
1414
import GHC.Generics (Generic)
1515
import PlutusTx.Prelude
1616

@@ -20,6 +20,8 @@ data PoolConfig = PoolConfig
2020
, poolY :: Coin Y
2121
, poolLq :: Coin Liquidity
2222
, poolFeeNum :: Integer
23+
, stakeAdminPolicy :: [CurrencySymbol]
24+
, lqBound :: Integer
2325
}
2426
deriving (Haskell.Show, Haskell.Eq, Generic)
2527

@@ -31,6 +33,8 @@ instance UnliftErased PoolConfig P.PoolConfig where
3133
, poolY = unCoin poolY
3234
, poolLq = unCoin poolLq
3335
, poolFeeNum = poolFeeNum
36+
, stakeAdminPolicy = stakeAdminPolicy
37+
, lqBound = lqBound
3438
}
3539

3640
unlift P.PoolConfig{..} =
@@ -40,4 +44,6 @@ instance UnliftErased PoolConfig P.PoolConfig where
4044
, poolY = Coin poolY
4145
, poolLq = Coin poolLq
4246
, poolFeeNum = poolFeeNum
47+
, stakeAdminPolicy = stakeAdminPolicy
48+
, lqBound = lqBound
4349
}

cardano-dex-contracts-offchain/ErgoDex/Contracts/Types.hs

Lines changed: 1 addition & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -24,14 +24,7 @@ import Data.Aeson (FromJSON, ToJSON)
2424
import GHC.Generics (Generic)
2525

2626
import ErgoDex.Plutus (adaAssetClass)
27-
import qualified Data.Text as Text
28-
import qualified Data.Aeson as JSON
29-
import qualified Data.Aeson.Types as JSON
30-
import Plutus.V1.Ledger.Value (AssetClass (..), Value (..), assetClassValue, assetClassValueOf, TokenName(..), CurrencySymbol(..))
31-
import qualified Data.ByteString.Base16 as Base16
32-
import qualified Data.ByteString as BSS
33-
import qualified Data.Text.Encoding as TE
34-
import Control.Monad ((>=>))
27+
import Plutus.V1.Ledger.Value (AssetClass (..), Value (..), assetClassValue, assetClassValueOf)
3528
import qualified PlutusTx
3629
import PlutusTx.Prelude
3730
import Text.Printf (PrintfArg)

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+

0 commit comments

Comments
 (0)