diff --git a/use-case-2/backend/src/Backend.hs b/use-case-2/backend/src/Backend.hs index c3ee31426..2d2d320ac 100644 --- a/use-case-2/backend/src/Backend.hs +++ b/use-case-2/backend/src/Backend.hs @@ -268,7 +268,7 @@ curl \ executeSwap :: Manager -> Pool Pg.Connection -> String - -> (Coin AssetClass , Amount Integer) + -> (Coin AssetClass, Amount Integer) -> (Coin AssetClass, Amount Integer) -> IO (Either String Aeson.Value) executeSwap httpManager pool contractId (coinA, amountA) (coinB, amountB) = do diff --git a/use-case-2/frontend/src/Frontend/Pool.hs b/use-case-2/frontend/src/Frontend/Pool.hs index 071317d43..b13d119fd 100644 --- a/use-case-2/frontend/src/Frontend/Pool.hs +++ b/use-case-2/frontend/src/Frontend/Pool.hs @@ -21,6 +21,7 @@ import Control.Category import Control.Applicative import Control.Lens import Control.Monad +import Control.Monad.Fix import Control.Monad.IO.Class (MonadIO) import qualified Data.Aeson as Aeson import Data.Aeson.Lens @@ -384,7 +385,11 @@ poolDashboard wid = do viewPooledTokens :: ( MonadQuery t (Vessel Q (Const SelectedCount)) m + , MonadHold t m + , MonadFix m , Reflex t ) => m (Dynamic t (Maybe (Maybe [PooledToken]))) -viewPooledTokens = (fmap.fmap.fmap) (getFirst . runIdentity) $ queryViewMorphism 1 $ constDyn $ vessel Q_PooledTokens . identityV +viewPooledTokens = do + v <- (fmap.fmap.fmap) (getFirst . runIdentity) $ queryViewMorphism 1 $ constDyn $ vessel Q_PooledTokens . identityV + holdUniqDyn v diff --git a/use-case-2/frontend/src/Frontend/Swap.hs b/use-case-2/frontend/src/Frontend/Swap.hs index e108998a0..56d4fb04b 100644 --- a/use-case-2/frontend/src/Frontend/Swap.hs +++ b/use-case-2/frontend/src/Frontend/Swap.hs @@ -21,6 +21,7 @@ import Control.Category import Control.Applicative import Control.Lens import Control.Monad +import Control.Monad.Fix import Control.Monad.IO.Class (MonadIO) import qualified Data.Aeson as Aeson import Data.Aeson.Lens @@ -138,12 +139,12 @@ selectCoins wid pabEV = do let ffor4 a b c d f = liftA3 f a b c <*> d pooledTokenToCoin pt = Coin $ AssetClass (CurrencySymbol (_pooledToken_symbol pt), TokenName (_pooledToken_name pt)) toAmount amt = Amount $ (read (T.unpack amt) :: Integer) - requestLoad = ((\w c1 c2 a1 a2 -> Api_Swap w c1 c2 a1 a2) + requestLoad = Api_Swap <$> (constDyn $ ContractInstanceId wid) <*> (pooledTokenToCoin <$> selectionA) <*> (pooledTokenToCoin <$> selectionB) <*> (toAmount <$> amountA) - <*> (toAmount <$> amountB)) + <*> (toAmount <$> amountB) -- This response returns transaction fee information, it does not return the swap response -- TODO still, do *something* with it, to handle failure cases? _responseVal <- requesting $ tagPromptlyDyn requestLoad swap @@ -214,8 +215,9 @@ transactionDetails pabEV formDyn = do -> tknameA == (_pooledToken_name selA) && tknameB == (_pooledToken_name selB)) poolMap let amtA' :: Integer = fromMaybe 0 $ readMay $ T.unpack amtA amtB' :: Integer = fromMaybe 0 $ readMay $ T.unpack amtB - (swapAmount, estimatedTkName) = if amtA' == 0 then (amtB',coinAName) else (amtA',coinBName) - Just (findSwapA coinAPoolAmount coinBPoolAmount swapAmount, estimatedTkName) + Just $ if amtA' == 0 + then (findSwapA coinBPoolAmount coinAPoolAmount amtB', coinAName) + else (findSwapA coinAPoolAmount coinBPoolAmount amtA', coinBName) _ -> Nothing txFeeEstimateResp <- requesting $ fmap (\sca -> Api_EstimateTransactionFee sca) $ SmartContractAction_Swap <$ updated formDyn widgetHold_ blank $ ffor (fmapMaybe id $ updated swapEstimate) $ \(estimate, eTokenName) -> @@ -231,10 +233,14 @@ transactionDetails pabEV formDyn = do viewPooledTokens :: ( MonadQuery t (Vessel Q (Const SelectedCount)) m + , MonadHold t m + , MonadFix m , Reflex t ) => m (Dynamic t (Maybe (Maybe [PooledToken]))) -viewPooledTokens = (fmap.fmap.fmap) (getFirst . runIdentity) $ queryViewMorphism 1 $ constDyn $ vessel Q_PooledTokens . identityV +viewPooledTokens = do + v <- (fmap.fmap.fmap) (getFirst . runIdentity) $ queryViewMorphism 1 $ constDyn $ vessel Q_PooledTokens . identityV + holdUniqDyn v -- | Nothing is returned, because this is just a command to tell the backend to -- poll the PAB for new data to *push* to our live queries. @@ -250,3 +256,4 @@ pollRefreshPoolBalance wid = do -- recurring event used to poll for pool balance pollingEvent <- tickLossyFromPostBuildTime 10 requesting_ $ (Api_CallPools (ContractInstanceId wid)) <$ (leftmost [pb, () <$ pollingEvent]) +