diff --git a/src/YieldFarming.hs b/src/YieldFarming.hs index 0a7f9bb..aeb1173 100644 --- a/src/YieldFarming.hs +++ b/src/YieldFarming.hs @@ -1,11 +1,16 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} -module YieldFarming (pvalidateYieldFarmW) where +module YieldFarming ( + pvalidateYieldFarmW, + YieldFarmingDatum (..), + YieldFarmRedeemer (..), +) where import Plutarch.Api.V1 (PCredential (PPubKeyCredential, PScriptCredential)) import Plutarch.Api.V1.Value @@ -14,9 +19,18 @@ import Plutarch.Bool import Plutarch.DataRepr import Plutarch.Extra.ScriptContext (pfromPDatum, ptryFromInlineDatum) import Plutarch.Prelude +import PlutusLedgerApi.V2 ( + Address, + BuiltinByteString, + CurrencySymbol, + TokenName, + ) +import PlutusTx qualified import "liqwid-plutarch-extra" Plutarch.Extra.TermCont -- import qualified PlutusTx + +import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (PLifted)) import Plutarch.Unsafe (punsafeCoerce) pcountOfUniqueTokens :: @@ -31,7 +45,16 @@ pcountOfUniqueTokens = phoistAcyclic $ in pmatch val $ \(PValue val') -> pmatch val' $ \(PMap csPairs) -> pfoldl # plam (\acc x -> acc + (tokensLength # x)) # 0 # csPairs -data PYieldFarmDatum (s :: S) +data YieldFarmingDatum = YieldFarmingDatum + { owner :: Address + , lpCS :: CurrencySymbol + , lpTN :: TokenName + } + deriving stock (Generic, Eq, Show) + +PlutusTx.makeIsDataIndexed ''YieldFarmingDatum [('YieldFarmingDatum, 0)] + +newtype PYieldFarmDatum (s :: S) = PYieldFarmDatum ( Term s @@ -50,6 +73,23 @@ instance DerivePlutusType PYieldFarmDatum where instance PTryFrom PData PYieldFarmDatum +instance PUnsafeLiftDecl PYieldFarmDatum where type PLifted PYieldFarmDatum = YieldFarmingDatum +deriving via (DerivePConstantViaData YieldFarmingDatum PYieldFarmDatum) instance PConstantDecl YieldFarmingDatum + +data YieldFarmRedeemer + = Terminate + | HarvestRewards {ownIndex :: Integer} + | AddRewards {ownIndex :: Integer, authIndex :: Integer} + deriving stock (Show, Eq, Generic) + +PlutusTx.makeIsDataIndexed + ''YieldFarmRedeemer + [ ('Terminate, 0) + , ('HarvestRewards, 1) + , ('AddRewards, 2) + ] +PlutusTx.makeLift ''YieldFarmRedeemer + data PYieldFarmRedeemer (s :: S) = PTerminate (Term s (PDataRecord '[])) | PHarvestRewards (Term s (PDataRecord '["ownIndex" ':= PInteger])) @@ -62,6 +102,9 @@ instance DerivePlutusType PYieldFarmRedeemer where instance PTryFrom PData PYieldFarmRedeemer +instance PUnsafeLiftDecl PYieldFarmRedeemer where type PLifted PYieldFarmRedeemer = YieldFarmRedeemer +deriving via (DerivePConstantViaData YieldFarmRedeemer PYieldFarmRedeemer) instance PConstantDecl YieldFarmRedeemer + ptryOwnInput :: (PIsListLike list PTxInInfo) => Term s (list PTxInInfo :--> PTxOutRef :--> PTxOut) ptryOwnInput = phoistAcyclic $ plam $ \inputs ownRef -> @@ -99,7 +142,6 @@ pharvestYieldFarm = phoistAcyclic $ plam $ \ownIndex oldDatum ctx -> ownInput <- pletFieldsC @'["address", "datum"] (ptryOwnInput # txInfo.inputs # ownRef) ownOutput <- pletFieldsC @'["address", "datum"] (pelemAt @PBuiltinList # ownIndex # txInfo.outputs) - datum <- pletFieldsC @'["owner", "lpCS", "lpTN"] oldDatum ownerAddress <- pletC datum.owner @@ -137,7 +179,6 @@ pvalidateYieldFarm = phoistAcyclic $ plam $ \batcherCS batcherTN datum redeemer PAddRewards red -> pletFields @'["ownIndex", "authIndex"] red $ \redF -> paddYieldFarmRewards # batcherCS # batcherTN # redF.ownIndex # redF.authIndex # ctx PHarvestRewards r -> pharvestYieldFarm # (pfield @"ownIndex" # r) # datum # ctx - pvalidateYieldFarmW :: Term s (PAsData PCurrencySymbol :--> PAsData PTokenName :--> PValidator) pvalidateYieldFarmW = phoistAcyclic $ plam $ \batcherCS batcherTN datum redeemer ctx -> let dat :: Term _ PYieldFarmDatum diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..c4e6210 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,12 @@ +module Main (main) where + +import Spec.YieldFarmingSpec (unitTest) +import Test.Tasty (defaultMain, testGroup) + +main :: IO () +main = do + defaultMain $ + testGroup + "Unit Test Group" + [ unitTest + ] diff --git a/test/Spec/YieldFarmingSpec.hs b/test/Spec/YieldFarmingSpec.hs new file mode 100644 index 0000000..0bf9330 --- /dev/null +++ b/test/Spec/YieldFarmingSpec.hs @@ -0,0 +1,320 @@ +module Spec.YieldFarmingSpec (unitTest) where + +import Plutarch.Context ( + UTXO, + address, + buildSpending', + input, + output, + signedWith, + txId, + withInlineDatum, + withSpendingOutRefId, + withValue, + ) +import Plutarch.Prelude +import Plutarch.Test.Precompiled (Expectation (Failure, Success), testEvalCase, tryFromPTerm) +import PlutusLedgerApi.V2 ( + Address (..), + Credential (..), + CurrencySymbol, + PubKeyHash (..), + ScriptContext, + ScriptHash (..), + TokenName (..), + TxId (..), + Value (..), + singleton, + ) +import PlutusTx qualified +import Test.Tasty (TestTree) +import YieldFarming (YieldFarmRedeemer (..), YieldFarmingDatum (..), pvalidateYieldFarmW) + +currencySymbol :: CurrencySymbol +currencySymbol = "746fa3ba2daded6ab9ccc1e39d3835aa1dfcb9b5a54acc2ebe6b79a4" + +tokenName :: TokenName +tokenName = "yield-farming-test" + +ownerPKH :: PubKeyHash +ownerPKH = "b1f2f20a8781a3ba967d8c7b5068d21d799e809dcce22f651679d661" + +ownerAddress :: Address +ownerAddress = Address (PubKeyCredential ownerPKH) Nothing + +scriptHash :: ScriptHash +scriptHash = "b055a795895b15d9af25acb752ac89c78524acfa387acb626c7e1bc8" + +scriptAddress :: Address +scriptAddress = Address (ScriptCredential scriptHash) Nothing + +datum :: YieldFarmingDatum +datum = + YieldFarmingDatum + { owner = ownerAddress + , lpCS = currencySymbol + , lpTN = tokenName + } + +terminateRedeemer :: YieldFarmRedeemer +terminateRedeemer = Terminate + +terminateScriptContext :: ScriptContext +terminateScriptContext = + buildSpending' $ + mconcat + [ signedWith ownerPKH + ] + +badTerminateScriptContext :: ScriptContext +badTerminateScriptContext = + buildSpending' $ + mconcat [] + +incorrectPKH :: PubKeyHash +incorrectPKH = "65c4b5e51c3c58c15af080106e8ce05b6efbb475aa5e5c5ca9372a45" + +badTerminateScriptContext2 :: ScriptContext +badTerminateScriptContext2 = + buildSpending' $ + mconcat [signedWith incorrectPKH] + +harvestRedeemer :: YieldFarmRedeemer +harvestRedeemer = HarvestRewards {ownIndex = 0} + +harvestInTxId :: TxId +harvestInTxId = TxId "2c6dbc95c1e96349c4131a9d19b029362542b31ffd2340ea85dd8f28e271ff6d" + +harvestInputUTXO :: UTXO +harvestInputUTXO = + mconcat + [ address scriptAddress + , withValue (singleton "" "" 5_000_000) + , withInlineDatum datum + ] + +harvestOutputUTXO :: UTXO +harvestOutputUTXO = + mconcat + [ address scriptAddress + , withValue (singleton "" "" 5_000_000) + , withInlineDatum datum + ] + +changedDatum :: YieldFarmingDatum +changedDatum = + YieldFarmingDatum + { owner = ownerAddress + , lpCS = currencySymbol + , lpTN = TokenName "changed" + } + +invalidDatumHarvestOutputUTXO :: UTXO +invalidDatumHarvestOutputUTXO = + mconcat + [ address scriptAddress + , withValue (singleton "" "" 5_000_000) + , withInlineDatum changedDatum + ] + +harvestScriptContext :: ScriptContext +harvestScriptContext = + buildSpending' $ + mconcat + [ txId harvestInTxId + , input harvestInputUTXO + , output harvestOutputUTXO + , withSpendingOutRefId harvestInTxId + , signedWith ownerPKH + ] + +invalidDatumHarvestScriptContext :: ScriptContext +invalidDatumHarvestScriptContext = + buildSpending' $ + mconcat + [ txId harvestInTxId + , input harvestInputUTXO + , output invalidDatumHarvestOutputUTXO + , withSpendingOutRefId harvestInTxId + , signedWith ownerPKH + ] + +missSignatureHarvestScriptContext :: ScriptContext +missSignatureHarvestScriptContext = + buildSpending' $ + mconcat + [ txId harvestInTxId + , input harvestInputUTXO + , output harvestOutputUTXO + , withSpendingOutRefId harvestInTxId + ] + +randomOutputUTXO :: UTXO +randomOutputUTXO = + mconcat + [withValue (singleton "" "" 2_000_000)] + +incorrectOwnIndexHarvestScriptContext :: ScriptContext +incorrectOwnIndexHarvestScriptContext = + buildSpending' $ + mconcat + [ txId harvestInTxId + , input harvestInputUTXO + , output randomOutputUTXO + , output harvestOutputUTXO + , withSpendingOutRefId harvestInTxId + , signedWith ownerPKH + ] + +addRewardsRedeemer :: YieldFarmRedeemer +addRewardsRedeemer = AddRewards {ownIndex = 0, authIndex = 1} + +addRewardsInTxId :: TxId +addRewardsInTxId = TxId "2c6dbc95c1e96349c4131a9d19b029362542b31ffd2340ea85dd8f28e271ff6d" + +addRewardsInputUTXO :: UTXO +addRewardsInputUTXO = + mconcat + [ address scriptAddress + , withValue (singleton "" "" 5_000_000) + , withInlineDatum datum + ] + +rewardToken :: Value +rewardToken = singleton "" "" 10_000_000 + +addRewardsOutputUTXO :: UTXO +addRewardsOutputUTXO = + mconcat + [ address scriptAddress + , withValue (singleton "" "" 5_000_000 <> rewardToken) + , withInlineDatum datum + ] + +authAddress :: Address +authAddress = Address (PubKeyCredential "e1317b152faac13426e6a83e06ff88a4d62cce3c1634ab0a5ec13309") Nothing + +authToken :: Value +authToken = singleton currencySymbol tokenName 1 + +authInputUTXO :: UTXO +authInputUTXO = + mconcat + [ address authAddress + , withValue (singleton "" "" 5_000_000 <> authToken) + , withInlineDatum datum + ] + +addRewardScriptContext :: ScriptContext +addRewardScriptContext = + buildSpending' $ + mconcat + [ txId addRewardsInTxId + , input addRewardsInputUTXO + , input authInputUTXO + , output addRewardsOutputUTXO + , withSpendingOutRefId addRewardsInTxId + ] + +incorrectValueAddRewardsOutputUTXO :: UTXO +incorrectValueAddRewardsOutputUTXO = + mconcat + [ address scriptAddress + , withValue (singleton "" "" 5_000_000) + , withInlineDatum datum + ] + +incorrectOutputAddRewardScriptContext :: ScriptContext +incorrectOutputAddRewardScriptContext = + buildSpending' $ + mconcat + [ txId addRewardsInTxId + , input addRewardsInputUTXO + , input authInputUTXO + , output incorrectValueAddRewardsOutputUTXO + , withSpendingOutRefId addRewardsInTxId + ] + +incorrectAuthIndexAddRewardScriptContext :: ScriptContext +incorrectAuthIndexAddRewardScriptContext = + buildSpending' $ + mconcat + [ txId addRewardsInTxId + , input authInputUTXO + , input addRewardsInputUTXO + , output addRewardsOutputUTXO + , withSpendingOutRefId addRewardsInTxId + ] + +unitTest :: TestTree +unitTest = tryFromPTerm "Yield Farming Unit Test" (pvalidateYieldFarmW # pdata (pconstant currencySymbol) # pdata (pconstant tokenName)) $ do + testEvalCase + "Pass - Terminate Yield Farming" + Success + [ PlutusTx.toData datum + , PlutusTx.toData terminateRedeemer + , PlutusTx.toData terminateScriptContext + ] + testEvalCase + "Failure - Terminate Yield Farming - missing signature" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData terminateRedeemer + , PlutusTx.toData badTerminateScriptContext + ] + testEvalCase + "Failure - Terminate Yield Farming - incorrect signature" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData terminateRedeemer + , PlutusTx.toData badTerminateScriptContext2 + ] + testEvalCase + "Pass - Harvest Yield Farming" + Success + [ PlutusTx.toData datum + , PlutusTx.toData harvestRedeemer + , PlutusTx.toData harvestScriptContext + ] + testEvalCase + "Failure - Harvest Yield Farming - incorrect output datum" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData harvestRedeemer + , PlutusTx.toData invalidDatumHarvestScriptContext + ] + testEvalCase + "Failure - Harvest Yield Farming - miss owner's signature" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData harvestRedeemer + , PlutusTx.toData missSignatureHarvestScriptContext + ] + testEvalCase + "Failure - Harvest Yield Farming - incorrect own index" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData harvestRedeemer + , PlutusTx.toData incorrectOwnIndexHarvestScriptContext + ] + testEvalCase + "Pass - Add Rewards Yield Farming" + Success + [ PlutusTx.toData datum + , PlutusTx.toData addRewardsRedeemer + , PlutusTx.toData addRewardScriptContext + ] + testEvalCase + "Failure - Add Rewards Yield Farming - incorrect output value" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData addRewardsRedeemer + , PlutusTx.toData incorrectOutputAddRewardScriptContext + ] + testEvalCase + "Failure - Add Rewards Yield Farming - incorrect auth index" + Failure + [ PlutusTx.toData datum + , PlutusTx.toData addRewardsRedeemer + , PlutusTx.toData incorrectAuthIndexAddRewardScriptContext + ] diff --git a/yield-farming.cabal b/yield-farming.cabal index 83890b8..b3cf1be 100644 --- a/yield-farming.cabal +++ b/yield-farming.cabal @@ -116,6 +116,26 @@ common dependencies , serialise , text +common test-dependencies + build-depends: + , base + , bytestring + , hedgehog + , hedgehog-quickcheck + , liqwid-plutarch-extra + , plutarch + , plutarch-context-builder + , plutarch-extra + , plutarch-quickcheck + , plutarch-unit + , plutus-core + , plutus-ledger-api + , plutus-tx + , tasty + , tasty-hedgehog + , tasty-hunit + , text + library import: lang, dependencies exposed-modules: @@ -141,3 +161,11 @@ executable yield-farming , yield-farming hs-source-dirs: app + +test-suite yield-farming-test + import: lang, test-dependencies + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: Spec.YieldFarmingSpec + build-depends: yield-farming