Add bad actions back in for escrow

IntersectMBO · Jun 20, 2022 · a78f41d · a78f41d
1 parent c14a619
commit a78f41d
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 24 deletions.
diff --git a/plutus-use-cases/test/Spec/Escrow.hs b/plutus-use-cases/test/Spec/Escrow.hs
@@ -1,11 +1,12 @@
-{-# LANGUAGE DataKinds          #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleInstances  #-}
-{-# LANGUAGE GADTs              #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE TypeApplications   #-}
-{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE StandaloneDeriving  #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeApplications    #-}
+{-# LANGUAGE TypeFamilies        #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 module Spec.Escrow( tests
                   , redeemTrace
@@ -66,7 +67,7 @@ instance ContractModel EscrowModel where
   data Action EscrowModel = Pay Wallet Integer
                           | Redeem Wallet
                           | Refund Wallet
-                          -- | BadRefund Wallet Wallet
+                          | BadRefund Wallet Wallet
                           deriving (Eq, Show, Data)
 
   data ContractInstanceKey EscrowModel w s e params where
@@ -95,7 +96,7 @@ instance ContractModel EscrowModel where
       testContract = selectList [ void $ payEp modelParams
                                 , void $ redeemEp modelParams
                                 , void $ refundEp modelParams
-                                --, void $ badRefundEp modelParams
+                                , void $ badRefundEp modelParams
                                 ] >> testContract
 
   nextState a = void $ case a of
@@ -116,8 +117,8 @@ instance ContractModel EscrowModel where
       contributions %= Map.delete w
       deposit w v
       wait 1
-    -- BadRefund _ _ -> do
-    --   wait 2
+    BadRefund _ _ -> do
+      wait 2
 
   precondition s a = case a of
     Redeem _ -> (s ^. contractState . contributions . to fold) `geq` (s ^. contractState . targets . to fold)
@@ -126,8 +127,8 @@ instance ContractModel EscrowModel where
              && Nothing /= (s ^. contractState . contributions . at w)
     Pay _ v -> s ^. currentSlot + 1 < s ^. contractState . refundSlot
             && Ada.adaValueOf (fromInteger v) `geq` Ada.toValue minAdaTxOut
-    -- BadRefund w w' -> s ^. currentSlot < s ^. contractState . refundSlot - 2  -- why -2?
-    --                || w /= w'
+    BadRefund w w' -> s ^. currentSlot < s ^. contractState . refundSlot - 2  -- why -2?
+                   || w /= w'
 
   perform h _ _ a = case a of
     Pay w v        -> do
@@ -139,13 +140,13 @@ instance ContractModel EscrowModel where
     Refund w       -> do
       Trace.callEndpoint @"refund-escrow" (h $ WalletKey w) ()
       delay 1
-    -- BadRefund w w' -> do
-    --   Trace.callEndpoint @"badrefund-escrow" (h $ WalletKey w) (mockWalletPaymentPubKeyHash w')
-    --   delay 2
+    BadRefund w w' -> do
+      Trace.callEndpoint @"badrefund-escrow" (h $ WalletKey w) (mockWalletPaymentPubKeyHash w')
+      delay 2
 
   arbitraryAction s = frequency $ [ (prefer beforeRefund,  Pay <$> QC.elements testWallets <*> choose @Integer (10, 30))
-                                  , (prefer beforeRefund,  Redeem <$> QC.elements testWallets) ] ++
-                                  -- , (prefer afterRefund,   BadRefund <$> QC.elements testWallets <*> QC.elements testWallets) ] ++
+                                  , (prefer beforeRefund,  Redeem <$> QC.elements testWallets)
+                                  , (prefer afterRefund,   BadRefund <$> QC.elements testWallets <*> QC.elements testWallets) ] ++
                                   [ (prefer afterRefund,   Refund <$> QC.elements (s ^. contractState . contributions . to Map.keys))
                                   | Prelude.not . null $ s ^. contractState . contributions . to Map.keys ]
                   where
@@ -155,7 +156,7 @@ instance ContractModel EscrowModel where
                     prefer b = if b then 10 else 1
 
   monitoring _ (Redeem _) = classify True "Contains Redeem"
-  --monitoring (_,_) (BadRefund w w') = tabulate "Bad refund attempts" [if w==w' then "early refund" else "steal refund"]
+  monitoring (_,_) (BadRefund w w') = tabulate "Bad refund attempts" [if w==w' then "early refund" else "steal refund"]
   monitoring (s,s') _ = classify (redeemable s' && Prelude.not (redeemable s)) "Redeemable"
     where redeemable s = precondition s (Redeem undefined)
 

diff --git a/plutus-use-cases/test/Spec/Escrow/Endpoints.hs b/plutus-use-cases/test/Spec/Escrow/Endpoints.hs
@@ -29,9 +29,8 @@ import Prelude (Semigroup (..))
 
 import Plutus.Contracts.Escrow
 
-type EscrowTestSchema = {-Endpoint "badrefund-escrow" PaymentPubKeyHash .\/ -} EscrowSchema
+type EscrowTestSchema = Endpoint "badrefund-escrow" PaymentPubKeyHash .\/ EscrowSchema
 
-{-
 -- | 'badRefund' with an endpoint.
 badRefundEp ::
     forall w s.
@@ -58,5 +57,3 @@ badRefund inst pk = do
                            ) tx'
     handleError (\err -> logError $ "Caught error: " ++ unpack err) $
       adjustUnbalancedTx utx >>= void . submitUnbalancedTx
-
--}