feat: pass router fee to the custom validator

Anastasia-Labs · Jul 24, 2024 · c9bb22f · c9bb22f
1 parent 4bd1d9d
commit c9bb22f
Show file tree

Hide file tree

Showing 7 changed files with 31 additions and 19 deletions.
diff --git a/compiled/smartHandleSimple.json b/compiled/smartHandleSimple.json
diff --git a/compiled/smartHandleStake.json b/compiled/smartHandleStake.json
diff --git a/src/Constants.hs b/src/Constants.hs
@@ -3,8 +3,12 @@ module Constants where
 import Plutarch.Api.V1.Value (AmountGuarantees (..), KeyGuarantees (..), PValue, padaSymbol, padaToken, psingleton)
 import Plutarch.Prelude (PInteger, Term, (#))
 
-routerFeeAsNegativeLovelace :: Term s PInteger
-routerFeeAsNegativeLovelace = -1_000_000
+routerFeeForSimpleRoutes :: Term s PInteger
+routerFeeForSimpleRoutes = 1_000_000
+
+negativeRouterFeeForSimpleRoutes :: Term s PInteger
+negativeRouterFeeForSimpleRoutes = -1_000_000
 
 routerFeeAsNegativeValue :: Term s (PValue 'Sorted 'NonZero)
-routerFeeAsNegativeValue = psingleton # padaSymbol # padaToken # routerFeeAsNegativeLovelace
+routerFeeAsNegativeValue =
+  psingleton # padaSymbol # padaToken # negativeRouterFeeForSimpleRoutes
diff --git a/src/SingleValidator.hs b/src/SingleValidator.hs
@@ -13,7 +13,7 @@ import Plutarch.Prelude
 import Plutarch.Unsafe (punsafeCoerce)
 import "liqwid-plutarch-extra" Plutarch.Extra.ScriptContext ()
 
-import Constants (routerFeeAsNegativeLovelace)
+import Constants (negativeRouterFeeForSimpleRoutes, routerFeeForSimpleRoutes)
 import Utils (PCustomValidator, pand'List, pconvertChecked, pconvertUnsafe, presolveDatum, psignedByOwner, pvalueHasChangedByLovelaces)
 
 pcountInputsAtScript :: Term s (PScriptHash :--> PBuiltinList PTxInInfo :--> PInteger)
@@ -219,17 +219,17 @@ prouter = phoistAcyclic $ plam $ \validateFn routeAddress dat ownIndex routerInd
         , pmatch dat $ \case
             PSimple ((pfield @"owner" #) -> owner) ->
               pand'List
-                [ validateFn # pcon (PDJust $ pdcons # pdata owner # pdnil) # punsafeCoerce (pconstant ()) # outputDatum # forRoute # ctx
-                , ptraceIfFalse "Incorrect Route Output Value" (pvalueHasChangedByLovelaces # ownInputF.value # routerOutputF.value # routerFeeAsNegativeLovelace)
+                [ validateFn # pcon (PDJust $ pdcons # pdata owner # pdnil) # routerFeeForSimpleRoutes # punsafeCoerce (pconstant ()) # outputDatum # forRoute # ctx
+                , ptraceIfFalse "Incorrect Route Output Value" (pvalueHasChangedByLovelaces # ownInputF.value # routerOutputF.value # negativeRouterFeeForSimpleRoutes)
                 ]
             PAdvanced dat' -> P.do
               datF <- pletFields @'["mOwner", "routerFee", "reclaimRouterFee", "extraInfo"] dat'
-              let routerFee = pif forRoute (pnegate # datF.routerFee) (pnegate # datF.reclaimRouterFee)
+              let routerFee = pif forRoute datF.routerFee datF.reclaimRouterFee
               pand'List
-                [ validateFn # datF.mOwner # datF.extraInfo # outputDatum # forRoute # ctx
+                [ validateFn # datF.mOwner # routerFee # datF.extraInfo # outputDatum # forRoute # ctx
                 , ptraceIfFalse
                     "Incorrect Route Output Value"
-                    (pvalueHasChangedByLovelaces # ownInputF.value # routerOutputF.value # routerFee)
+                    (pvalueHasChangedByLovelaces # ownInputF.value # routerOutputF.value # (pnegate # routerFee))
                 ]
         ]
     )

diff --git a/src/Specialized/Minswap.hs b/src/Specialized/Minswap.hs
@@ -164,7 +164,7 @@ minSwapAddress =
    in pconstant orderAddr
 
 validateFn :: Term s PCustomValidator
-validateFn = plam $ \mOwner extraInfoData outputDatum _ _ -> P.do
+validateFn = plam $ \mOwner _routingFee extraInfoData outputDatum _forRoute _ctx -> P.do
   let extraInfo = pconvertUnsafe @PMinswapRequestInfo extraInfoData
       outDatum = pconvertChecked @PMinswapRequestDatum (pto outputDatum)
   extraInfoF <- pletFields @'["desiredAssetSymbol", "desiredAssetTokenName", "receiverDatumHash", "minimumReceive"] extraInfo

diff --git a/src/StakingValidator.hs b/src/StakingValidator.hs
@@ -26,7 +26,7 @@ import "liqwid-plutarch-extra" Plutarch.Extra.ScriptContext (pfromPDatum, ptryFr
 import "liqwid-plutarch-extra" Plutarch.Extra.TermCont
 
 import BatchValidator (PSmartRedeemer (..))
-import Constants (routerFeeAsNegativeLovelace)
+import Constants (negativeRouterFeeForSimpleRoutes, routerFeeForSimpleRoutes)
 import Plutarch.Builtin (PIsData (pdataImpl), ppairDataBuiltin)
 import SingleValidator (PSmartHandleDatum (..))
 import Utils
@@ -118,15 +118,15 @@ psmartHandleSuccessor validateFn datums ctx routeAddress smartInputRouteFlagPair
         , pmatch smartInputDatum $ \case
             PSimple ((pfield @"owner" #) -> owner) ->
               pand'List
-                [ validateFn # pcon (PDJust $ pdcons # pdata owner # pdnil) # punsafeCoerce (pconstant ()) # routeOutputDatum # pcon PTrue # ctx
-                , ptraceIfFalse "Incorrect Route Output Value" (pvalueHasChangedByLovelaces # smartInputF.value # routeOutputF.value # routerFeeAsNegativeLovelace)
+                [ validateFn # pcon (PDJust $ pdcons # pdata owner # pdnil) # routerFeeForSimpleRoutes # punsafeCoerce (pconstant ()) # routeOutputDatum # pcon PTrue # ctx
+                , ptraceIfFalse "Incorrect Route Output Value" (pvalueHasChangedByLovelaces # smartInputF.value # routeOutputF.value # negativeRouterFeeForSimpleRoutes)
                 ]
             PAdvanced dat' -> P.do
               datF <- pletFields @'["mOwner", "routerFee", "reclaimRouterFee", "extraInfo"] dat'
-              let routerFee = pif forRoute (pnegate # datF.routerFee) (pnegate # datF.reclaimRouterFee)
+              let routerFee = pif forRoute datF.routerFee datF.reclaimRouterFee
               pand'List
-                [ validateFn # datF.mOwner # datF.extraInfo # routeOutputDatum # forRoute # ctx
-                , ptraceIfFalse "Incorrect Route Output Value" (pvalueHasChangedByLovelaces # smartInputF.value # routeOutputF.value # routerFee)
+                [ validateFn # datF.mOwner # routerFee # datF.extraInfo # routeOutputDatum # forRoute # ctx
+                , ptraceIfFalse "Incorrect Route Output Value" (pvalueHasChangedByLovelaces # smartInputF.value # routeOutputF.value # (pnegate # routerFee))
                 ]
         ]
     )

diff --git a/src/Utils.hs b/src/Utils.hs
@@ -14,7 +14,15 @@ import Plutarch.Unsafe (punsafeCoerce)
 import "liqwid-plutarch-extra" Plutarch.Extra.List (plookupAssoc)
 import "liqwid-plutarch-extra" Plutarch.Extra.TermCont
 
-type PCustomValidator = PMaybeData PAddress :--> PData :--> PDatum :--> PBool :--> PScriptContext :--> PBool
+type PCustomValidator =
+  ( PMaybeData PAddress -- possible owner
+      :--> PInteger -- routing fee
+      :--> PData -- extraInfo from the `Advanced` datum
+      :--> PDatum -- routing address output datum (resolved hash, or inline)
+      :--> PBool -- routing flag (`True` for routing, `False` for reclaiming)
+      :--> PScriptContext -- script context
+      :--> PBool
+  )
 
 data PAssetClass (s :: S) = PAssetClass (Term s (PDataRecord '["cs" ':= PCurrencySymbol, "tn" ':= PTokenName]))
   deriving stock (Generic)