Fix minting policy in tutorial and for state machine thread tokens in…

… light of https://www.tweag.io/blog/2022-03-25-minswap-lp-vulnerability

* Added currentValueOf function in `Ledger.Value`

* Modified the StateMachine thread token

Co-authored-by: David Eichmann <EichmannD@gmail.com>

plutus-contract/src/Plutus/Contract/StateMachine/ThreadToken.hs

@@ -76,10 +76,24 @@ curPolicy outRef = mkMintingPolicyScript $
 threadTokenValue :: CurrencySymbol -> ValidatorHash -> Value
 threadTokenValue currency (ValidatorHash vHash) = Value.singleton currency (TokenName vHash) 1
 
+-- | Check exactly `n` thread tokens and no other tokens with the given
+-- @CurrencySymbol@ are in the given @Value@.
 {-# INLINABLE checkThreadTokenInner #-}
-checkThreadTokenInner :: CurrencySymbol -> ValidatorHash -> Value -> Integer -> Bool
-checkThreadTokenInner currency (ValidatorHash vHash) vl i =
-    Value.valueOf vl currency (TokenName vHash) == i
+checkThreadTokenInner ::
+    -- | The currency symbol of the thread token.
+    CurrencySymbol ->
+    -- | The hash of the (state machine) validator script using this thread
+    -- token. This is used as the @TokenName@ of the thread token.
+    ValidatorHash ->
+    -- | The value to check.
+    Value ->
+    -- | The expected number of thread tokens in the given value, `n`.
+    Integer ->
+    -- | True if and only if exactly `n` thread tokens (and no other tokens)
+    -- with the given @CurrencySymbol@ are in the given @Value@.
+    Bool
+checkThreadTokenInner currency (ValidatorHash vHash) value n =
+    Value.currencyValueOf value currency == Value.singleton currency (TokenName vHash) n
 
 {-# INLINABLE checkThreadToken #-}
 checkThreadToken :: Maybe ThreadToken -> ValidatorHash -> Value -> Integer -> Bool

plutus-ledger/src/Ledger/Value.hs

@@ -5,11 +5,13 @@ module Ledger.Value
   , noAdaValue
   , adaOnlyValue
   , isAdaOnlyValue
+  , currencyValueOf
   ) where
 
 import Ledger.Ada qualified as Ada
 import Plutus.V1.Ledger.Value as Export
-import PlutusTx.Prelude (Bool, Eq (..), (-))
+import PlutusTx.AssocMap qualified as Map
+import PlutusTx.Prelude (Bool, Eq ((==)), Maybe (Just, Nothing), mempty, (-))
 
 {-# INLINABLE noAdaValue #-}
 -- | Value without any Ada.
@@ -24,3 +26,12 @@ adaOnlyValue v = Ada.toValue (Ada.fromValue v)
 {-# INLINABLE isAdaOnlyValue #-}
 isAdaOnlyValue :: Value -> Bool
 isAdaOnlyValue v = adaOnlyValue v == v
+
+{-# INLINABLE currencyValueOf #-}
+-- | Get the quantities of just the given 'CurrencySymbol' in the 'Value'. This
+-- is useful when implementing minting policies as they are responsible for
+-- checking all minted/burnt tokens of their own 'CurrencySymbol'.
+currencyValueOf :: Value -> CurrencySymbol -> Value
+currencyValueOf (Value m) c = case Map.lookup c m of
+    Nothing -> mempty
+    Just t  -> Value (Map.singleton c t)

plutus-use-cases/test/Spec/renderGuess.txt

@@ -550,7 +550,7 @@ Balances Carried Forward:
     Ada:      Lovelace:  100000000
 
 ==== Slot #1, Tx #0 ====
-TxId:       411a7fdd3b09e06b400565f672734c320610bde421aa726b6c59518ff79501bc
+TxId:       554791af2ac99e9cc552ca9ba54986fb7a1b54ca0576859d2311b143d07d097c
 Fee:        Ada:      Lovelace:  178173
 Mint:       -
 Inputs:
@@ -573,7 +573,7 @@ Inputs:
 
 Outputs:
   ---- Output 0 ----
-  Destination:  Script: b5a7dcffb6a357dfdf4230be9537a035ce738c2cf35e398cbc1e2921
+  Destination:  Script: dc457d55084bd23618630162337ac43b48ac340b96052d67061f8f36
   Value:
     Ada:      Lovelace:  8000000
 
@@ -624,6 +624,6 @@ Balances Carried Forward:
   Value:
     Ada:      Lovelace:  100000000
 
-  Script: b5a7dcffb6a357dfdf4230be9537a035ce738c2cf35e398cbc1e2921
+  Script: dc457d55084bd23618630162337ac43b48ac340b96052d67061f8f36
   Value:
     Ada:      Lovelace:  8000000