wip

Author: Bromel777

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

@@ -60,13 +60,15 @@ newtype VestingWithPeriodConfig (s :: S)
         )
     deriving stock (GHC.Generic)
     deriving
-        (PIsData, PDataFields, PlutusType)
+        (PIsData, PDataFields, PlutusType, PEq)
 
 instance DerivePlutusType VestingWithPeriodConfig where type DPTStrat _ = PlutusTypeData
 
 instance PUnsafeLiftDecl VestingWithPeriodConfig where type PLifted VestingWithPeriodConfig = VWP.VestingWithPeriodConfig
 deriving via (DerivePConstantViaData VWP.VestingWithPeriodConfig VestingWithPeriodConfig) instance (PConstantDecl VWP.VestingWithPeriodConfig)
 
+instance PTryFrom PData (PAsData VestingWithPeriodConfig)
+
 vestingWithPeriodValidatorT :: ClosedTerm (VestingWithPeriodConfig :--> VestingWithPeriodRedeemer :--> PScriptContext :--> PBool)
 vestingWithPeriodValidatorT = plam $ \conf' redeemer' ctx' -> unTermCont $ do
   let ctx = pfield @"txInfo" # ctx'
@@ -100,18 +102,30 @@ vestingWithPeriodValidatorT = plam $ \conf' redeemer' ctx' -> unTermCont $ do
 
   correctReward <- 
      tlet $ 
-         isLastPeriod #|| (checkRewardCorrectness # ctx' # totalVested # periodVested # vestingPeriodIdx # vestingAC)
+         isLastPeriod #|| (checkRewardAndDatumCorrectness # ctx' # conf' # totalVested # periodVested # vestingPeriodIdx # vestingAC)
   pure $ validTime
        #&& validSignature 
        #&& correctReward
 
-checkRewardCorrectness :: Term s (PScriptContext :--> PInteger :--> PInteger :--> PInteger :--> PAssetClass :--> PBool)
-checkRewardCorrectness = 
-    plam $ \ctx totalVested periodVested periodId vestingAC -> unTermCont $ do
+checkRewardAndDatumCorrectness :: Term s (PScriptContext :--> VestingWithPeriodConfig :--> PInteger :--> PInteger :--> PInteger :--> PAssetClass :--> PBool)
+checkRewardAndDatumCorrectness = 
+    plam $ \ctx prevCfg totalVested periodVested periodId vestingAC -> unTermCont $ do
         let
             selfOutputsList = getContinuingOutputs # ctx
             selfOutput      = phead # selfOutputsList
-            selfValue       = pfield @"value" # selfOutput 
+            selfValue       = pfield @"value" # selfOutput
+
+        txOutDatum <- tletField @"datum" selfOutput
+
+        POutputDatum txOutOutputDatum <- pmatchC txOutDatum
+
+        rawDatum <- tletField @"outputDatum" txOutOutputDatum
+
+        PDatum vestingDatumRaw <- pmatchC rawDatum
+
+        newVestingConfig <- tletUnwrap $ ptryFromData @(VestingWithPeriodConfig) $ vestingDatumRaw
+        let    
             correctOutQty   = totalVested - (periodId * periodVested) 
             realOutQty      = assetClassValueOf # selfValue # vestingAC
-        pure $ realOutQty #== correctOutQty
+            correctConfigs  = prevCfg #== newVestingConfig
+        pure $ (realOutQty #== correctOutQty) #&& correctConfigs

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

@@ -19,23 +19,24 @@ main = do
   defaultMain tests
 
 tests = testGroup "Contracts"
-  [ checkStakeChangeMintingPolicy
-  , checkPool
-  , checkPoolRedeemer
-  , checkRedeem
-  , checkRedeemIdentity
-  , checkRedeemIsFair
-  , checkRedeemRedeemer
-  , checkDeposit 
-  , checkDepositChange
-  , checkDepositRedeemer
-  , checkDepositIdentity
-  , checkDepositLq
-  , checkDepositTokenReward
-  , checkSwap
-  , checkSwapRedeemer
-  , checkSwapIdentity
-  , checkVesting
-  , checkVestingWithPeriod
-  , checkPkhLockStaking
+  [ 
+  --   checkStakeChangeMintingPolicy
+  -- , checkPool
+  -- , checkPoolRedeemer
+  -- , checkRedeem
+  -- , checkRedeemIdentity
+  -- , checkRedeemIsFair
+  -- , checkRedeemRedeemer
+  -- , checkDeposit 
+  -- , checkDepositChange
+  -- , checkDepositRedeemer
+  -- , checkDepositIdentity
+  -- , checkDepositLq
+  -- , checkDepositTokenReward
+  -- , checkSwap
+  -- , checkSwapRedeemer
+  -- , checkSwapIdentity
+  -- , checkVesting
+  checkVestingWithPeriod
+  -- , checkPkhLockStaking
   ]

cardano-dex-contracts-onchain/test/Tests/VestingWithPeriod.hs

@@ -28,10 +28,12 @@ import Gen.Models
 import Debug.Trace
 
 checkVestingWithPeriod = testGroup "checkVestingWithPeriod"
-  [ HH.testProperty "correct_vesting" correctVesting
-  , HH.testProperty "incorrect_signature_qty_vesting" incorrectSignatureQtyVesting
-  , HH.testProperty "incorrect_time_vesting" incorrectTimeVesting
-  , HH.testProperty "incorrect_value_vesting" incorrectValueVesting
+  [ 
+  --   HH.testProperty "correct_vesting" correctVesting
+  -- , HH.testProperty "incorrect_signature_qty_vesting" incorrectSignatureQtyVesting
+  -- , HH.testProperty "incorrect_time_vesting" incorrectTimeVesting
+  -- , HH.testProperty "incorrect_value_vesting" incorrectValueVesting
+  , HH.testProperty "incorrect_datum_in_output" incorrectDatumVesting
   ]
 
 correctVesting :: Property
@@ -290,4 +292,59 @@ incorrectValueVesting = property $ do
           in (newVestingBoxInput, prevResult && isRight resultEither)
       ) (initialVestingWPTxIn, True) periodsList
 
+  result === False
+
+incorrectDatumVesting :: Property
+incorrectDatumVesting = property $ do
+  let
+    range = linear 24 4096
+  firstPkh        <- forAll genPkh
+  secondPkh       <- forAll genPkh
+  vestingOutTxRef <- forAll genTxOutRef
+  vestingAC       <- forAll genAssetClass
+  vestingStartInt <- (forAll $ int range)
+
+  vestingPeriodDurationInt <- forAll $ int range
+
+  totalVestedInt  <- forAll $ int range
+  let
+    vestedRange = linear 24 totalVestedInt
+
+  maxPeriodIdInt <- forAll $ int vestedRange
+  let
+
+    vestingStart = toInteger vestingStartInt
+
+    vestingPeriodDuration = toInteger vestingPeriodDurationInt
+
+    totalVested = toInteger totalVestedInt
+    maxPeriodId = toInteger maxPeriodIdInt
+
+    periodVested = totalVested `div` maxPeriodId
+
+    vestingWPCfg          = genVestingWithPeriodConfig vestingStart vestingPeriodDuration totalVested periodVested [firstPkh, secondPkh] vestingAC
+    vestingWPCfgData      = toData vestingWPCfg
+    vestingWPDatum        = OutputDatum $ mkDatum vestingWPCfg
+    initialVestingWPTxIn  = genVestingWPTxIn vestingOutTxRef vestingWPDatum vestingAC totalVested
+    periodsList           = [1..maxPeriodId]
+
+    deadline      = vestingStart + vestingPeriodDuration * periodId
+
+    vestingRedeemToData = toData $ PPVestingWP.VestingWithPeriodRedeemer 0 periodId
+
+    newVestingBox = genVestingWPTxOut NoOutputDatum vestingAC (totalVested - periodId * periodVested)
+    
+    newVestingBoxInput = mkTxIn vestingOutTxRef newVestingBox
+
+    userTxOut     = genUserTxOut vestingAC periodVested firstPkh
+
+    txInfo        = mkVestingTxInfo [vestingBox] [newVestingBox, userTxOut] (deadline + 5) (deadline + 10) [secondPkh]
+
+    purpose      = mkPurpose vestingOutTxRef
+
+    cxtData      = toData $ mkContext txInfo purpose
+
+    resultEither = eraseRight $ evalWithArgs (wrapValidator PVestingWP.vestingWithPeriodValidatorT) [vestingWPCfgData, vestingRedeemToData, cxtData]
+    
+
   result === False