bye Tweak/Labels

Author: mmontin

cooked-validators.cabal

@@ -79,7 +79,6 @@ library
       Cooked.Tweak.Guard
       Cooked.Tweak.Inputs
       Cooked.Tweak.Insertion
-      Cooked.Tweak.Labels
       Cooked.Tweak.Mint
       Cooked.Tweak.Modification
       Cooked.Tweak.Outputs

src/Cooked/Tweak.hs

@@ -6,7 +6,6 @@ module Cooked.Tweak (module X) where
 import Cooked.Tweak.Common as X
 import Cooked.Tweak.Inputs as X
 import Cooked.Tweak.Insertion as X
-import Cooked.Tweak.Labels as X
 import Cooked.Tweak.Mint as X
 import Cooked.Tweak.Modification as X
 import Cooked.Tweak.Outputs as X

src/Cooked/Tweak/Guard.hs

@@ -3,12 +3,15 @@ module Cooked.Tweak.Guard
     assertPredTweak,
     guardTweak,
     guardPredTweak,
+    labelled,
+    labelled',
   )
 where
 
 import Control.Monad
 import Cooked.Skeleton
 import Cooked.Tweak.Common
+import Data.Text (Text)
 import Optics.Core
 import Polysemy
 import Polysemy.NonDet
@@ -47,3 +50,48 @@ guardPredTweak ::
   (a -> Bool) ->
   Sem effs ()
 guardPredTweak optic p = assertPredTweak optic p >>= guard
+
+-- | Apply a tweak to a given transaction if it has a specific label. Fails if
+-- it does not.
+--
+-- >
+-- > someEndpoint = do
+-- >   ...
+-- >   validateTxSkel' txSkelTemplate
+-- >      { txSkelLabels =
+-- >         [ TxSkelLabel "InitialMinting"
+-- >         , TxSkelLabel "AuctionWorkflow"
+-- >         , TxSkelLabel SomeLabelType]
+-- >      }
+-- >
+-- > someTest = someEndpoint & eveywhere (labelled SomeLabelType someTweak)
+-- > anotherTest = someEndpoint & somewhere (labelled SomeLabelType someTweak)
+labelled ::
+  ( LabelConstrs lbl,
+    Members '[Tweak, NonDet] effs
+  ) =>
+  lbl ->
+  Sem effs a ->
+  Sem effs a
+labelled lbl = (guardTweak (txSkelLabelsL % at (TxSkelLabel lbl) % _Just) >>)
+
+-- | `labelled` specialised to Text labels
+--
+-- >
+-- > someEndpoint = do
+-- >   ...
+-- >   validateTxSkel' txSkelTemplate
+-- >      { txSkelLabels =
+-- >         [ TxSkelLabel "InitialMinting"
+-- >         , TxSkelLabel "AuctionWorkflow"
+-- >         , TxSkelLabel "Spending"
+-- >         , TxSkelLabel SomeLabelType]
+-- >      }
+-- >
+-- > someTest = someEndpoint & somewhere (labelled' "Spending" doubleSatAttack)
+labelled' ::
+  (Members '[Tweak, NonDet] effs) =>
+  Text ->
+  Sem effs a ->
+  Sem effs a
+labelled' = labelled

src/Cooked/Tweak/Insertion.hs

@@ -83,7 +83,7 @@ insertInTweak ::
   a ->
   Sem effs ()
 insertInTweak (castOptic @A_Traversal -> optic) a = do
-  guardTweak $ optic % contains a % filtered not
+  guardTweak $ optic % at a % _Nothing
   setTweak (optic % contains a) True
 
 -- * Inserting elements in maps

src/Cooked/Tweak/Labels.hs

@@ -2,6 +2,7 @@ module Spec.Tweak.Labels where
 
 import Control.Monad
 import Cooked
+import Cooked.Tweak.Guard
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Optics.Core
@@ -34,7 +35,7 @@ payments = do
 labelAmountTweak :: StagedTweak ()
 labelAmountTweak = do
   [target] <- viewAllTweak (txSkelOutputsL % _head % txSkelOutValueL % valueLovelaceL)
-  addLabelTweak $ Api.getLovelace target
+  insertInTweak txSkelLabelsL $ TxSkelLabel $ Api.getLovelace target
 
 labelNameTweak :: StagedTweak ()
 labelNameTweak = do
@@ -47,8 +48,8 @@ labelNameTweak = do
           % userTypedPubKeyAT @Wallet
       )
   case target of
-    [t] | t == alice -> addLabelTweak @Text "Alice"
-    [t] | t == bob -> addLabelTweak @Text "Bob"
+    [t] | t == alice -> insertInTweak txSkelLabelsL $ TxSkelLabel @Text "Alice"
+    [t] | t == bob -> insertInTweak txSkelLabelsL $ TxSkelLabel @Text "Bob"
     _ -> mzero
 
 labelNames :: StagedMockChain ()