Reuse more of the typed wallet API

IntersectMBO · Aug 15, 2019 · 50e99e9 · 50e99e9
1 parent 09251e0
commit 50e99e9
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 24 deletions.
diff --git a/plutus-contract/src/Language/Plutus/Contract/Typed/Tx.hs b/plutus-contract/src/Language/Plutus/Contract/Typed/Tx.hs
@@ -3,22 +3,18 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeApplications      #-}
 -- | Functions for working with the contract interface using typed transactions.
 module Language.Plutus.Contract.Typed.Tx where
 
-import           Control.Lens                (at, (^.))
-import           Data.Either                 (rights)
-import qualified Data.Map                    as Map
-import           Data.Maybe                  (fromMaybe)
-
 import qualified Language.Plutus.Contract.Tx as Contract
 import qualified Language.PlutusTx           as PlutusTx
 import           Ledger                      (TxOut, TxOutRef)
 import qualified Ledger                      as L
 import           Ledger.AddressMap           (AddressMap)
 import qualified Ledger.Typed.Tx             as Typed
 
+import qualified Wallet.Typed.API            as Typed
+
 -- | Given the pay to script address of the 'ValidatorScript', collect from it
 --   all the outputs that match a predicate, using the 'RedeemerScript'.
 collectFromScriptFilter ::
@@ -29,25 +25,10 @@ collectFromScriptFilter ::
     -> Typed.ScriptInstance a
     -> PlutusTx.CompiledCode (Typed.RedeemerType a)
     -> Contract.UnbalancedTx
-collectFromScriptFilter flt am ct@(Typed.Validator vls) red =
-    let adr     = L.scriptAddress $ L.ValidatorScript $ L.fromCompiledCode vls
-        utxo :: Map.Map TxOutRef TxOut
-        utxo    = fromMaybe Map.empty $ am ^. at adr
-        ourUtxo :: [(TxOutRef, TxOut)]
-        ourUtxo = Map.toList $ Map.filterWithKey flt utxo
-        refs :: [TxOutRef]
-        refs = fst <$> ourUtxo
-        -- We just throw away any outputs at this script address that don't typecheck.
-        -- TODO: we should log this, it would make debugging much easier
-        typedRefs :: [Typed.TypedScriptTxOutRef a]
-        typedRefs = rights $ Typed.typeScriptTxOutRef @a (\ref -> Map.lookup ref utxo) ct <$> refs
-        typedIns :: [Typed.TypedScriptTxIn '[] a]
-        typedIns = Typed.makeTypedScriptTxIn @a @'[] ct red <$> typedRefs
-        -- We need to add many txins and we've done as much checking as we care to, so we switch to TypedTxSomeIns
-        fullTx :: Typed.TypedTxSomeIns '[]
-        fullTx = Typed.addManyTypedTxIns typedIns Typed.baseTx
+collectFromScriptFilter flt am si red =
+    let typed = Typed.collectFromScriptFilter flt am si red
         untypedTx :: L.Tx
         -- Need to match to get the existential type out
-        untypedTx = case fullTx of
+        untypedTx = case typed of
             (Typed.TypedTxSomeIns tx) -> Typed.toUntypedTx tx
     in Contract.fromLedgerTx untypedTx
diff --git a/plutus-wallet-api/src/Wallet/Typed/API.hs b/plutus-wallet-api/src/Wallet/Typed/API.hs
@@ -12,6 +12,8 @@
 module Wallet.Typed.API where
 
 import qualified Language.PlutusTx    as PlutusTx
+import qualified Ledger               as L
+import           Ledger.AddressMap
 import           Ledger.Tx
 import qualified Ledger.Typed.Tx      as Typed
 import           Ledger.Value
@@ -98,3 +100,30 @@ spendScriptOutputs ct red = do
         typedIns = (\(ref, v) -> (Typed.makeTypedScriptTxIn @a @outs ct red ref, v)) <$> typedRefs
 
     pure typedIns
+
+-- | Given the pay to script address of the 'ValidatorScript', collect from it
+--   all the outputs that match a predicate, using the 'RedeemerScript'.
+collectFromScriptFilter ::
+    forall a
+    . (PlutusTx.Typeable (Typed.DataType a))
+    => (TxOutRef -> TxOut -> Bool)
+    -> AddressMap
+    -> Typed.ScriptInstance a
+    -> PlutusTx.CompiledCode (Typed.RedeemerType a)
+    -> Typed.TypedTxSomeIns '[]
+collectFromScriptFilter flt am si@(Typed.Validator vls) red =
+    let adr     = L.scriptAddress $ L.ValidatorScript $ L.fromCompiledCode vls
+        utxo :: Map.Map TxOutRef TxOut
+        utxo    = fromMaybe Map.empty $ am ^. at adr
+        ourUtxo :: [(TxOutRef, TxOut)]
+        ourUtxo = Map.toList $ Map.filterWithKey flt utxo
+        refs :: [TxOutRef]
+        refs = fst <$> ourUtxo
+        -- We just throw away any outputs at this script address that don't typecheck.
+        -- TODO: we should log this, it would make debugging much easier
+        typedRefs :: [Typed.TypedScriptTxOutRef a]
+        typedRefs = rights $ Typed.typeScriptTxOutRef @a (\ref -> Map.lookup ref utxo) si <$> refs
+        typedIns :: [Typed.TypedScriptTxIn '[] a]
+        typedIns = Typed.makeTypedScriptTxIn @a @'[] si red <$> typedRefs
+    -- We need to add many txins and we've done as much checking as we care to, so we switch to TypedTxSomeIns
+    in Typed.addManyTypedTxIns typedIns Typed.baseTx