WIP Fixing wallet

IntersectMBO · Apr 6, 2021 · bf020da · bf020da
1 parent ca53301
commit bf020da
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 9 deletions.
diff --git a/plutus-pab/src/Cardano/Wallet/Mock.hs b/plutus-pab/src/Cardano/Wallet/Mock.hs
@@ -21,6 +21,7 @@ import qualified Cardano.Protocol.Socket.Client   as Client
 import           Cardano.Wallet.Types             (MultiWalletEffect (..), WalletEffects, WalletMsg (..), Wallets)
 import           Control.Concurrent               (MVar)
 import           Control.Concurrent.MVar          (putMVar, takeMVar)
+import           Control.Lens                     (at, (.~))
 import           Control.Monad.Error              (MonadError)
 import qualified Control.Monad.Except             as MonadError
 import           Control.Monad.Freer
@@ -88,7 +89,8 @@ newKeyPair = do
     pure (pubKey, privateKey)
 
 -- | Handle multiple wallets using existing @Wallet.handleWallet@ handler
-handleMultiWallet :: forall m effs. ( Member NodeClientEffect effs
+handleMultiWallet :: forall m effs.
+    ( Member NodeClientEffect effs
     , Member ChainIndexEffect effs
     , Member (State Wallets) effs
     , Member (Error WAPI.WalletAPIError) effs
@@ -99,11 +101,11 @@ handleMultiWallet = do
         MultiWallet wallet action -> do
             wallets <- get @Wallets
             case Map.lookup wallet wallets of
-                Just privateKey -> do
-                    let walletState = WalletState privateKey emptyNodeClientState mempty (defaultSigningProcess wallet)
-                    evalState walletState $ action
-                        & raiseEnd
-                        & interpret Wallet.handleWallet
+                Just walletState -> do
+                    -- let walletState = WalletState privateKey emptyNodeClientState mempty (defaultSigningProcess wallet)
+                    (x, newState) <- runState walletState $ action & raiseEnd & interpret Wallet.handleWallet
+                    put @Wallets (wallets & at wallet .~ Just newState)
+                    pure x
                 Nothing -> throwError $ WAPI.OtherError "Wallet not found"
         CreateWallet -> do
             wallets <- get @Wallets

diff --git a/plutus-pab/src/Cardano/Wallet/Server.hs b/plutus-pab/src/Cardano/Wallet/Server.hs
@@ -33,7 +33,9 @@ import           Data.Coerce                      (coerce)
 import           Data.Function                    ((&))
 import qualified Data.Map.Strict                  as Map
 import           Data.Proxy                       (Proxy (Proxy))
+import           Ledger.Blockchain                (Block)
 import qualified Ledger.Crypto                    as Crypto
+import           Ledger.Slot                      (Slot)
 import           Ledger.Tx                        (TxOut (txOutValue), TxOutTx (txOutTxOut))
 import           Network.HTTP.Client              (defaultManagerSettings, newManager)
 import qualified Network.Wai.Handler.Warp         as Warp
@@ -64,10 +66,10 @@ app trace clientHandler chainIndexEnv mVarState =
 
 main :: Trace IO WalletMsg -> WalletConfig -> FilePath -> ChainIndexUrl -> Availability -> IO ()
 main trace WalletConfig { baseUrl, wallet } serverSocket (ChainIndexUrl chainUrl) availability = LM.runLogEffects trace $ do
-    clientHandler <- liftIO $ Client.runClientNode serverSocket (\_ _ -> pure ())
     chainIndexEnv <- buildEnv chainUrl defaultManagerSettings
     let knownWallets = Map.fromList $ zip (fmap Wallet.Wallet [1..10]) Crypto.knownPrivateKeys
     mVarState <- liftIO $ newMVar knownWallets
+    clientHandler <- liftIO $ Client.runClientNode serverSocket (\_ _ -> pure ())
     runClient chainIndexEnv
     logInfo $ StartingWallet (Port servicePort)
     liftIO $ Warp.runSettings warpSettings $ app trace clientHandler chainIndexEnv mVarState

diff --git a/plutus-pab/src/Cardano/Wallet/Types.hs b/plutus-pab/src/Cardano/Wallet/Types.hs
@@ -54,10 +54,10 @@ import           Servant.Client                     (BaseUrl, ClientError)
 import           Servant.Client.Internal.HttpClient (ClientEnv)
 import           Wallet.Effects                     (ChainIndexEffect, NodeClientEffect, WalletEffect)
 import           Wallet.Emulator.Error              (WalletAPIError)
-import           Wallet.Emulator.Wallet             (Wallet)
+import           Wallet.Emulator.Wallet             (Wallet, WalletState)
 
 
-type Wallets = Map Wallet PrivateKey
+type Wallets = Map Wallet WalletState
 
 data MultiWalletEffect r where
     CreateWallet :: MultiWalletEffect Wallet