Skip to content

Commit

Permalink
style: correct formatting
Browse files Browse the repository at this point in the history
  • Loading branch information
@nikhils9
nikhils9 committed Nov 29, 2023
1 parent 039010e commit ecb9962
Showing 1 changed file with 52 additions and 48 deletions.
100 changes: 52 additions & 48 deletions src/YieldFarming.hs
View file
Original file line number Diff line number Diff line change
@@ -1,21 +1,22 @@
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# LANGUAGE ViewPatterns #-}

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

module YieldFarming (pvalidateYieldFarmW) where

module YieldFarming (pvalidateYieldFarmW) where
import Plutarch.Api.V2
import Plutarch.Api.V1 (PCredential (PPubKeyCredential, PScriptCredential))
import Plutarch.DataRepr
import Plutarch.Api.V1.Value
import Plutarch.Api.V1.Value
import Plutarch.Api.V2
import Plutarch.Bool
import Plutarch.DataRepr
import Plutarch.Extra.ScriptContext (pfromPDatum, ptryFromInlineDatum)
import Plutarch.Prelude
import Plutarch.Extra.ScriptContext (ptryFromInlineDatum, pfromPDatum)
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont
--import qualified PlutusTx
import "liqwid-plutarch-extra" Plutarch.Extra.TermCont

-- import qualified PlutusTx
import Plutarch.Unsafe (punsafeCoerce)

pcountOfUniqueTokens ::
Expand All @@ -30,52 +31,56 @@ pcountOfUniqueTokens = phoistAcyclic $
in pmatch val $ \(PValue val') ->
pmatch val' $ \(PMap csPairs) -> pfoldl # plam (\acc x -> acc + (tokensLength # x)) # 0 # csPairs

data PYieldFarmDatum (s :: S) = PYieldFarmDatum
(Term s
(PDataRecord
'[ "owner" ':= PAddress
, "lpCS" ':= PCurrencySymbol
, "lpTN" ':= PTokenName
]
))
data PYieldFarmDatum (s :: S)
= PYieldFarmDatum
( Term
s
( PDataRecord
'[ "owner" ':= PAddress
, "lpCS" ':= PCurrencySymbol
, "lpTN" ':= PTokenName
]
)
)
deriving stock (Generic)
deriving anyclass (PlutusType, PIsData, PDataFields)

instance DerivePlutusType PYieldFarmDatum where
type DPTStrat _ = PlutusTypeData
instance DerivePlutusType PYieldFarmDatum where
type DPTStrat _ = PlutusTypeData

instance PTryFrom PData PYieldFarmDatum
instance PTryFrom PData PYieldFarmDatum

data PYieldFarmRedeemer (s :: S) =
PTerminate (Term s (PDataRecord '[]))
| PHarvestRewards (Term s (PDataRecord '[ "ownIndex" ':= PInteger ]))
| PAddRewards (Term s (PDataRecord '[ "ownIndex" ':= PInteger, "authIndex" ':= PInteger ]))
data PYieldFarmRedeemer (s :: S)
= PTerminate (Term s (PDataRecord '[]))
| PHarvestRewards (Term s (PDataRecord '["ownIndex" ':= PInteger]))
| PAddRewards (Term s (PDataRecord '["ownIndex" ':= PInteger, "authIndex" ':= PInteger]))
deriving stock (Generic)
deriving anyclass (PlutusType, PIsData)

instance DerivePlutusType PYieldFarmRedeemer where
type DPTStrat _ = PlutusTypeData
instance DerivePlutusType PYieldFarmRedeemer where
type DPTStrat _ = PlutusTypeData

instance PTryFrom PData PYieldFarmRedeemer
instance PTryFrom PData PYieldFarmRedeemer

ptryOwnInput :: (PIsListLike list PTxInInfo) => Term s (list PTxInInfo :--> PTxOutRef :--> PTxOut)
ptryOwnInput = phoistAcyclic $
plam $ \inputs ownRef ->
precList (\self x xs ->
pletFields @'["outRef", "resolved"] x $ \txInFields ->
pif (ownRef #== txInFields.outRef) txInFields.resolved (self # xs)
)
precList
( \self x xs ->
pletFields @'["outRef", "resolved"] x $ \txInFields ->
pif (ownRef #== txInFields.outRef) txInFields.resolved (self # xs)
)
(const perror)
# inputs

-- pelimList Arguments:
-- 1. function that returns something, runs when not empty
-- 2. nilCase -> what happens when list is empty
-- 3. list to recurse on
-- 2. nilCase -> what happens when list is empty
-- 3. list to recurse on
pheadSingleton :: (PListLike list, PElemConstraint list a) => Term s (list a :--> a)
pheadSingleton = phoistAcyclic $
plam $ \xs ->
pelimList (\x xs -> (pelimList (\_ _ -> perror) x xs)) perror xs
pelimList (\x xs -> (pelimList (\_ _ -> perror) x xs)) perror xs

pterminateYieldFarming :: Term s (PYieldFarmDatum :--> PScriptContext :--> PBool)
pterminateYieldFarming = phoistAcyclic $ plam $ \datum ctx -> unTermCont $ do
Expand All @@ -91,10 +96,10 @@ pharvestYieldFarm = phoistAcyclic $ plam $ \ownIndex oldDatum ctx ->
ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
txInfo <- pletFieldsC @'["inputs", "outputs", "signatories"] ctxF.txInfo
PSpending ((pfield @"_0" #) -> ownRef) <- pmatchC ctxF.purpose

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

Expand All @@ -105,7 +110,6 @@ pharvestYieldFarm = phoistAcyclic $ plam $ \ownIndex oldDatum ctx ->
correctOutput = ownOutput.address #== ownInput.address #&& ownOutput.datum #== ownInput.datum
pure (signedByOwner #&& correctOutput)


paddYieldFarmRewards ::
Term s (PCurrencySymbol :--> PTokenName :--> PInteger :--> PInteger :--> PScriptContext :--> PBool)
paddYieldFarmRewards = phoistAcyclic $ plam $ \batcherCS batcherTN ownIndex authTokenIndex ctx -> unTermCont $ do
Expand All @@ -115,23 +119,23 @@ paddYieldFarmRewards = phoistAcyclic $ plam $ \batcherCS batcherTN ownIndex auth
txInputs <- pletC txInfo.inputs

indexedInput <- pletFieldsC @'["outRef", "resolved"] (pelemAt @PBuiltinList # ownIndex # txInputs)

PSpending ((pfield @"_0" #) -> ownRef) <- pmatchC ctxF.purpose

ownInput <- pletFieldsC @'["datum", "value", "address"] indexedInput.resolved
ownOutput <- pletFieldsC @'["datum", "value", "address"] (pelemAt # ownIndex # pfromData txInfo.outputs)
let correctIdx = ownRef #== indexedInput.outRef

let correctIdx = ownRef #== indexedInput.outRef
correctOutput = ownInput.datum #== ownOutput.datum #&& pfromData ownInput.value #< pfromData ownOutput.value #&& ownInput.address #== ownOutput.address #&& (pcountOfUniqueTokens # ownOutput.value) #<= 5
hasAuth = pvalueOf # (pfield @"value" # (pfield @"resolved" # (pelemAt @PBuiltinList # authTokenIndex # txInputs))) # batcherCS # batcherTN #== 1

pure (correctIdx #&& hasAuth #&& correctOutput)

pvalidateYieldFarm :: Term s (PCurrencySymbol :--> PTokenName :--> PYieldFarmDatum :--> PYieldFarmRedeemer :--> PScriptContext :--> PBool)
pvalidateYieldFarm = phoistAcyclic $ plam $ \batcherCS batcherTN datum redeemer ctx -> pmatch redeemer $ \case
PTerminate _ -> pterminateYieldFarming # datum # ctx
PAddRewards red -> pletFields @'["ownIndex", "authIndex"] red $ \redF ->
paddYieldFarmRewards # batcherCS # batcherTN # redF.ownIndex # redF.authIndex # ctx
PTerminate _ -> pterminateYieldFarming # datum # ctx
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)
Expand All @@ -140,4 +144,4 @@ pvalidateYieldFarmW = phoistAcyclic $ plam $ \batcherCS batcherTN datum redeemer
dat = punsafeCoerce datum
red :: Term _ PYieldFarmRedeemer
red = punsafeCoerce redeemer
in pif (pvalidateYieldFarm # pfromData batcherCS # pfromData batcherTN # dat # red # ctx) (popaque $ pconstant ()) perror
in pif (pvalidateYieldFarm # pfromData batcherCS # pfromData batcherTN # dat # red # ctx) (popaque $ pconstant ()) perror

0 comments on commit ecb9962

Please sign in to comment.