Merge branch 'develop' into rory/fix-overlay-again

Plutonomicon · Aug 10, 2022 · 08f5c1e · 08f5c1e
2 parents a738f90 + 6cdbad6
commit 08f5c1e
Show file tree

Hide file tree

Showing 9 changed files with 86 additions and 86 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -95,6 +95,8 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)
 See https://github.com/cardano-foundation/CIPs/issues/303 for motivation
 - `ogmios-datum-cache` now works on `x86_64-darwin`
 - `TypedValidator` interface ([#808](https://github.com/Plutonomicon/cardano-transaction-lib/issues/808))
+- `Contract.Address.getWalletCollateral` now works with `KeyWallet`.
+- Removed unwanted error messages in case `WebSocket` listeners get cancelled ([#827](https://github.com/Plutonomicon/cardano-transaction-lib/issues/827))
 
 ## [2.0.0-alpha] - 2022-07-05
 

diff --git a/src/BalanceTx/BalanceTx.purs b/src/BalanceTx/BalanceTx.purs
@@ -36,9 +36,7 @@ module BalanceTx
   , GetPublicKeyTransactionInputError(CannotConvertScriptOutputToTxInput)
   , GetWalletAddressError(CouldNotGetWalletAddress)
   , GetWalletCollateralError
-      ( CannotRequestCollateralForWallet
-      , CouldNotGetCollateral
-      , WalletNotSpecified
+      ( CouldNotGetCollateral
       )
   , TxInputLockedError(TxInputLockedError)
   , ImpossibleError(Impossible)
@@ -106,7 +104,7 @@ import Data.Lens.Setter ((.~), set, (?~), (%~))
 import Data.List ((:), List(Nil), partition)
 import Data.Log.Tag (tag)
 import Data.Map (fromFoldable, lookup, toUnfoldable, union) as Map
-import Data.Maybe (fromMaybe, maybe, isJust, Maybe(Just, Nothing))
+import Data.Maybe (Maybe(Nothing, Just), fromMaybe, maybe)
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Set (Set)
 import Data.Set as Set
@@ -119,11 +117,10 @@ import QueryM (ClientError, QueryM)
 import QueryM
   ( calculateMinFee
   , getWalletAddress
-  , getWalletCollateral
   , evaluateTxOgmios
   ) as QueryM
 import QueryM.Ogmios (TxEvaluationR(TxEvaluationR)) as Ogmios
-import QueryM.Utxos (utxosAt, filterLockedUtxos)
+import QueryM.Utxos (utxosAt, filterLockedUtxos, getWalletCollateral)
 import ReindexRedeemers (ReindexErrors, reindexSpentScriptRedeemers')
 import Serialization (convertTransaction, toBytes) as Serialization
 import Serialization.Address (Address, addressPaymentCred, withStakeCredential)
@@ -133,7 +130,6 @@ import Types.ScriptLookups (UnattachedUnbalancedTx(UnattachedUnbalancedTx))
 import Types.Transaction (TransactionInput)
 import Types.UnbalancedTransaction (UnbalancedTx(UnbalancedTx), _transaction)
 import Untagged.Union (asOneOf)
-import Wallet (Wallet(KeyWallet), cip30Wallet)
 
 -- This module replicates functionality from
 -- https://github.com/mlabs-haskell/bot-plutus-interface/blob/master/src/BotPlutusInterface/PreBalance.hs
@@ -168,10 +164,7 @@ derive instance Generic GetWalletAddressError _
 instance Show GetWalletAddressError where
   show = genericShow
 
-data GetWalletCollateralError
-  = CannotRequestCollateralForWallet ImpossibleError
-  | CouldNotGetCollateral
-  | WalletNotSpecified
+data GetWalletCollateralError = CouldNotGetCollateral
 
 derive instance Generic GetWalletCollateralError _
 
@@ -446,28 +439,10 @@ _redeemersTxIns = lens' \(UnattachedUnbalancedTx rec@{ redeemersTxIns }) ->
 
 setCollateral
   :: Transaction
-  -> Utxos
   -> QueryM (Either GetWalletCollateralError Transaction)
-setCollateral transaction utxos = runExceptT do
-  wallet <-
-    ExceptT $ asks (_.runtime >>> _.wallet) <#> note WalletNotSpecified
-  collateral <- ExceptT $ selectCollateral wallet
-  -- TODO: https://github.com/Plutonomicon/cardano-transaction-lib/pull/707
+setCollateral transaction = runExceptT do
+  collateral <- ExceptT $ getWalletCollateral <#> note CouldNotGetCollateral
   pure $ addTxCollateral collateral transaction
-  where
-  selectCollateral
-    :: Wallet
-    -> QueryM (Either GetWalletCollateralError (Array TransactionUnspentOutput))
-  selectCollateral (KeyWallet keyWallet) =
-    -- TODO: Combine with getWalletCollateral and supply with fee estimate
-    -- https://github.com/Plutonomicon/cardano-transaction-lib/issues/510
-    (unwrap keyWallet).selectCollateral <$> filterLockedUtxos utxos
-      <#> note CouldNotGetCollateral <<< map Array.singleton
-  selectCollateral wallet
-    | isJust (cip30Wallet wallet) =
-        QueryM.getWalletCollateral <#> note CouldNotGetCollateral
-    | otherwise =
-        pure $ Left $ CannotRequestCollateralForWallet Impossible
 
 addTxCollateral :: Array TransactionUnspentOutput -> Transaction -> Transaction
 addTxCollateral utxos transaction =
@@ -508,7 +483,7 @@ balanceTxWithAddress
       if Array.null (unattachedTx ^. _redeemersTxIns)
       -- Don't set collateral if tx doesn't contain phase-2 scripts:
       then pure unbalancedTx'
-      else ExceptT $ setCollateral unbalancedTx' utxos
+      else ExceptT $ setCollateral unbalancedTx'
         <#> lmap GetWalletCollateralError'
 
     let

diff --git a/src/Contract/Address.purs b/src/Contract/Address.purs
@@ -64,11 +64,11 @@ import Plutus.Types.Address
 import Plutus.Types.TransactionUnspentOutput (TransactionUnspentOutput)
 import QueryM
   ( getWalletAddress
-  , getWalletCollateral
   , ownPaymentPubKeyHash
   , ownPubKeyHash
   , ownStakePubKeyHash
   ) as QueryM
+import QueryM.Utxos (getWalletCollateral) as QueryM
 import Scripts
   ( typedValidatorBaseAddress
   , typedValidatorEnterpriseAddress

diff --git a/src/JsWebSocket.js b/src/JsWebSocket.js
@@ -37,11 +37,9 @@ exports._mkWebSocket = logger => url => () => {
 
 exports._onWsConnect = ws => fn => () => ws.addEventListener("open", fn);
 
-exports._onWsError = ws => logger => fn => () => {
+exports._onWsError = ws => fn => () => {
   const listener = function (event) {
-    const str = event.toString();
-    logger(`WebSocket error: ${str}`)();
-    fn(str)();
+    fn(event.toString())();
   };
   ws.addEventListener("error", listener);
   return listener;

diff --git a/src/JsWebSocket.purs b/src/JsWebSocket.purs
@@ -43,7 +43,6 @@ foreign import _onWsMessage
 
 foreign import _onWsError
   :: JsWebSocket
-  -> (String -> Effect Unit) -- logger
   -> (String -> Effect Unit) -- handler
   -> Effect ListenerRef
 

diff --git a/src/QueryM.purs b/src/QueryM.purs
@@ -33,7 +33,6 @@ module QueryM
   , getDatumsByHashes
   , getProtocolParametersAff
   , getWalletAddress
-  , getWalletCollateral
   , liftQueryM
   , listeners
   , postAeson
@@ -61,6 +60,7 @@ module QueryM
   , submitTxOgmios
   , underlyingWebSocket
   , withQueryRuntime
+  , callCip30Wallet
   ) where
 
 import Prelude
@@ -82,7 +82,6 @@ import Affjax.ResponseFormat as Affjax.ResponseFormat
 import Affjax.StatusCode as Affjax.StatusCode
 import Cardano.Types.Transaction (Transaction(Transaction))
 import Cardano.Types.Transaction as Transaction
-import Cardano.Types.TransactionUnspentOutput (TransactionUnspentOutput)
 import Cardano.Types.Value (Coin)
 import Control.Monad.Error.Class
   ( class MonadError
@@ -95,7 +94,6 @@ import Control.Monad.Reader.Trans (ReaderT, asks, runReaderT, withReaderT)
 import Control.Monad.Rec.Class (class MonadRec)
 import Control.Parallel (parallel, sequential)
 import Data.Array (length)
-import Data.Array as Array
 import Data.Bifunctor (lmap)
 import Data.BigInt (BigInt)
 import Data.BigInt as BigInt
@@ -109,7 +107,7 @@ import Data.Map as Map
 import Data.Maybe (Maybe(Just, Nothing), fromMaybe, maybe)
 import Data.MediaType.Common (applicationJSON)
 import Data.Newtype (class Newtype, unwrap, wrap)
-import Data.Traversable (for, for_, traverse, traverse_)
+import Data.Traversable (for, traverse, traverse_)
 import Data.Tuple.Nested ((/\), type (/\))
 import Data.UInt (UInt)
 import Data.UInt as UInt
@@ -125,7 +123,7 @@ import Effect.Aff
   )
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
-import Effect.Exception (Error, error, message, throw)
+import Effect.Exception (Error, error, message)
 import Effect.Ref (Ref)
 import Effect.Ref as Ref
 import Foreign.Object as Object
@@ -432,28 +430,6 @@ getWalletAddress = do
     Gero gero -> callCip30Wallet gero _.getWalletAddress
     KeyWallet kw -> Just <$> (unwrap kw).address networkId
 
-getWalletCollateral :: QueryM (Maybe (Array TransactionUnspentOutput))
-getWalletCollateral = do
-  mbCollateralUTxOs <- withMWalletAff case _ of
-    Nami nami -> callCip30Wallet nami _.getCollateral
-    Gero gero -> callCip30Wallet gero _.getCollateral
-    KeyWallet _ -> liftEffect $ throw "Not implemented"
-  for_ mbCollateralUTxOs \collateralUTxOs -> do
-    pparams <- asks $ _.runtime >>> _.pparams
-    let
-      tooManyCollateralUTxOs =
-        fromMaybe false do
-          maxCollateralInputs <- (unwrap pparams).maxCollateralInputs
-          pure $ UInt.fromInt (Array.length collateralUTxOs) >
-            maxCollateralInputs
-    when tooManyCollateralUTxOs do
-      liftEffect $ throw tooManyCollateralUTxOsError
-  pure mbCollateralUTxOs
-  where
-  tooManyCollateralUTxOsError =
-    "Wallet returned too many UTxOs as collateral. This is likely a bug in \
-    \the wallet."
-
 signTransaction
   :: Transaction.Transaction -> QueryM (Maybe Transaction.Transaction)
 signTransaction tx = withMWalletAff case _ of
@@ -712,7 +688,7 @@ mkOgmiosWebSocket' lvl serverCfg continue = do
           errMessage
       _wsClose ws
       continue $ Left $ error errMessage
-  firstConnectionErrorRef <- _onWsError ws (logger Error) onFirstConnectionError
+  firstConnectionErrorRef <- _onWsError ws onFirstConnectionError
   hasConnectedOnceRef <- Ref.new false
   _onWsConnect ws $ Ref.read hasConnectedOnceRef >>= case _ of
     true -> do
@@ -728,7 +704,7 @@ mkOgmiosWebSocket' lvl serverCfg continue = do
         _wsReconnect ws
       _onWsMessage ws (logger Debug) $ defaultMessageListener lvl
         messageDispatch
-      void $ _onWsError ws (logger Error) $ \err -> do
+      void $ _onWsError ws \err -> do
         logString lvl Debug $
           "Ogmios WebSocket error (" <> err <> "). Reconnecting..."
         launchAff_ do
@@ -791,7 +767,7 @@ mkDatumCacheWebSocket' lvl serverCfg continue = do
           <> "Terminating. Error: "
           <> errMessage
       continue $ Left $ error errMessage
-  firstConnectionErrorRef <- _onWsError ws (logger Error) onFirstConnectionError
+  firstConnectionErrorRef <- _onWsError ws onFirstConnectionError
   hasConnectedOnceRef <- Ref.new false
   _onWsConnect ws $ Ref.read hasConnectedOnceRef >>= case _ of
     true -> do
@@ -809,7 +785,7 @@ mkDatumCacheWebSocket' lvl serverCfg continue = do
         _wsReconnect ws
       _onWsMessage ws (logger Debug) $ defaultMessageListener lvl
         messageDispatch
-      void $ _onWsError ws (logger Error) $ \err -> do
+      void $ _onWsError ws \err -> do
         logger Debug $
           "Ogmios Datum Cache WebSocket error (" <> err <>
             "). Reconnecting..."
@@ -972,7 +948,9 @@ mkRequestAff listeners' webSocket logLevel jsonWspCall getLs inp = do
       _ <- respLs.addMessageListener id
         ( \result -> do
             respLs.removeMessageListener id
-            cont (lmap dispatchErrorToError result)
+            case result of
+              Left (ListenerCancelled _) -> pure unit
+              _ -> cont (lmap dispatchErrorToError result)
         )
       respLs.addRequest id sBody
       _wsSend webSocket (logString logLevel Debug) sBody
@@ -992,21 +970,22 @@ data DispatchError
   -- message
   | FaultError Aeson
   -- The listener that was added for this message has been cancelled
-  | ListenerCancelled
+  | ListenerCancelled ListenerId
 
 instance Show DispatchError where
   show (JsError err) = "(JsError (message " <> show (message err) <> "))"
   show (JsonError jsonErr) = "(JsonError " <> show jsonErr <> ")"
   show (FaultError aeson) = "(FaultError " <> show aeson <> ")"
-  show ListenerCancelled = "ListenerCancelled"
+  show (ListenerCancelled listenerId) =
+    "(ListenerCancelled " <> show listenerId <> ")"
 
 dispatchErrorToError :: DispatchError -> Error
 dispatchErrorToError (JsError err) = err
 dispatchErrorToError (JsonError err) = error $ show err
 dispatchErrorToError (FaultError err) =
   error $ "Server responded with `fault`: " <> stringifyAeson err
-dispatchErrorToError ListenerCancelled =
-  error $ "Listener cancelled"
+dispatchErrorToError (ListenerCancelled listenerId) =
+  error $ "Listener cancelled (" <> listenerId <> ")"
 
 -- A function which accepts some unparsed Json, and checks it against one or
 -- more possible types to perform an appropriate effect (such as supplying the
@@ -1097,8 +1076,7 @@ queryDispatch ref str = do
     Right reflection -> do
       -- Get callback action
       withAction reflection case _ of
-        Nothing -> Left $ JsError $ error $
-          "Request Id " <> reflection <> " has been cancelled"
+        Nothing -> Left (ListenerCancelled reflection)
         Just action -> do
           -- Parse response
           Right $ action $

diff --git a/src/QueryM/Utxos.purs b/src/QueryM/Utxos.purs
@@ -4,29 +4,33 @@ module QueryM.Utxos
   , getUtxo
   , getWalletBalance
   , utxosAt
+  , getWalletCollateral
   ) where
 
 import Prelude
 
 import Address (addressToOgmiosAddress)
 import Cardano.Types.Transaction (TransactionOutput, UtxoM(UtxoM), Utxos)
+import Cardano.Types.TransactionUnspentOutput (TransactionUnspentOutput)
 import Cardano.Types.Value (Value)
 import Control.Monad.Reader (withReaderT)
 import Control.Monad.Reader.Trans (ReaderT, asks)
+import Data.Array as Array
 import Data.Bifunctor (bimap)
 import Data.Bitraversable (bisequence)
 import Data.Foldable (fold, foldr)
 import Data.Map as Map
-import Data.Maybe (Maybe, maybe)
+import Data.Maybe (Maybe(Nothing), fromMaybe, maybe)
 import Data.Newtype (unwrap, wrap, over)
-import Data.Traversable (for, sequence, traverse)
+import Data.Traversable (for, for_, sequence, traverse)
 import Data.Tuple.Nested (type (/\))
+import Data.UInt as UInt
 import Effect.Aff (Aff)
 import Effect.Aff.Class (liftAff)
 import Effect.Class (liftEffect)
 import Effect.Exception (throw)
 import Helpers as Helpers
-import QueryM (QueryM, getWalletAddress, getWalletCollateral, mkOgmiosRequest)
+import QueryM (QueryM, callCip30Wallet, getWalletAddress, mkOgmiosRequest)
 import QueryM.Ogmios as Ogmios
 import Serialization.Address (Address)
 import TxOutput (ogmiosTxOutToTransactionOutput, txOutRefToTransactionInput)
@@ -44,9 +48,10 @@ import Wallet (Wallet(Gero, Nami, KeyWallet))
 utxosAt
   :: Address
   -> QueryM (Maybe UtxoM)
-utxosAt = mkUtxoQuery
-  <<< mkOgmiosRequest Ogmios.queryUtxosAtCall _.utxo
-  <<< addressToOgmiosAddress
+utxosAt address =
+  mkUtxoQuery
+    <<< mkOgmiosRequest Ogmios.queryUtxosAtCall _.utxo
+    $ addressToOgmiosAddress address
 
 -- | Queries for UTxO given a transaction input.
 getUtxo
@@ -137,3 +142,31 @@ getWalletBalance = do
         utxosAt address <#> map
           -- Combine `Value`s
           (fold <<< map _.amount <<< map unwrap <<< Map.values <<< unwrap)
+
+getWalletCollateral :: QueryM (Maybe (Array TransactionUnspentOutput))
+getWalletCollateral = do
+  mbCollateralUTxOs <- asks (_.runtime >>> _.wallet) >>= maybe (pure Nothing)
+    case _ of
+      Nami nami -> liftAff $ callCip30Wallet nami _.getCollateral
+      Gero gero -> liftAff $ callCip30Wallet gero _.getCollateral
+      KeyWallet kw -> do
+        networkId <- asks $ _.config >>> _.networkId
+        addr <- liftAff $ (unwrap kw).address networkId
+        utxos <- utxosAt addr <#> map unwrap >>> fromMaybe Map.empty
+          >>= filterLockedUtxos
+        pure $ Array.singleton <$> (unwrap kw).selectCollateral utxos
+  for_ mbCollateralUTxOs \collateralUTxOs -> do
+    pparams <- asks $ _.runtime >>> _.pparams
+    let
+      tooManyCollateralUTxOs =
+        fromMaybe false do
+          maxCollateralInputs <- (unwrap pparams).maxCollateralInputs
+          pure $ UInt.fromInt (Array.length collateralUTxOs) >
+            maxCollateralInputs
+    when tooManyCollateralUTxOs do
+      liftEffect $ throw tooManyCollateralUTxOsError
+  pure mbCollateralUTxOs
+  where
+  tooManyCollateralUTxOsError =
+    "Wallet returned too many UTxOs as collateral. This is likely a bug in \
+    \the wallet."