Implement background sync

Reviewed-on: #77

app/Main.hs

@@ -18,7 +18,7 @@ import System.IO
 import Text.Read (readMaybe)
 import ZcashHaskell.Types
 import Zenith.CLI
-import Zenith.Core (clearSync, testSend, testSync)
+import Zenith.Core (clearSync, testSync)
 import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
 import Zenith.Utils
 import Zenith.Zcashd
@@ -223,7 +223,6 @@ main = do
         "cli" -> runZenithCLI myConfig
         "sync" -> testSync myConfig
         "rescan" -> clearSync myConfig
-        "testsend" -> testSend
         _ -> printUsage
     else printUsage
 

app/ZenScan.hs

@@ -2,6 +2,7 @@
 
 module ZenScan where
 
+import Control.Monad.Logger (runNoLoggingT)
 import Data.Configurator
 import Zenith.Scanner (scanZebra)
 
@@ -11,4 +12,4 @@ main = do
   dbFilePath <- require config "dbFilePath"
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
-  scanZebra 2762066 zebraHost zebraPort dbFilePath
+  runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath

src/Zenith/CLI.hs

@@ -55,7 +55,7 @@ import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (catch, throw, throwIO, try)
 import Control.Monad (forever, void)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger (runFileLoggingT)
+import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
 import Data.Aeson
 import Data.Maybe
 import qualified Data.Text as T
@@ -63,11 +63,13 @@ import qualified Data.Text.Encoding as E
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import qualified Data.Vector as Vec
 import Database.Persist
+import Database.Persist.Sqlite
 import qualified Graphics.Vty as V
 import qualified Graphics.Vty.CrossPlatform as VC
 import Lens.Micro ((&), (.~), (^.), set)
 import Lens.Micro.Mtl
 import Lens.Micro.TH
+import System.Hclip
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
@@ -116,8 +118,9 @@ data DisplayType
   | SyncDisplay
   | BlankDisplay
 
-data Tick =
+data Tick
-  Tick
+  = TickVal !Float
+  | TickMsg !String
 
 data State = State
   { _network :: !ZcashNet
@@ -140,6 +143,7 @@ data State = State
   , _balance :: !Integer
   , _barValue :: !Float
   , _eventDispatch :: !(BC.BChan Tick)
+  , _timer :: !Int
   }
 
 makeLenses ''State
@@ -185,6 +189,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
            , capCommand "A" "ccounts"
            , capCommand "V" "iew address"
            , capCommand "Q" "uit"
+           , str $ show (st ^. timer)
            ])
     listBox :: Show e => String -> L.List Name e -> Widget Name
     listBox titleLabel l =
@@ -218,7 +223,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
             (B.borderWithLabel (str titleLabel) $
              hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
         , str " "
-        , C.hCenter $ str "Use arrows to select"
+        , C.hCenter
+            (hBox
+               [ capCommand "↑↓ " "move"
+               , capCommand "↲ " "select"
+               , capCommand "Tab " "->"
+               ])
         ]
     listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
     listTxBox titleLabel tx =
@@ -228,7 +238,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
             (B.borderWithLabel (str titleLabel) $
              hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
         , str " "
-        , C.hCenter $ str "Use arrows to select"
+        , C.hCenter
+            (hBox
+               [ capCommand "↑↓ " "move"
+               , capCommand "T" "x Display"
+               , capCommand "Tab " "<-"
+               ])
         ]
     helpDialog :: State -> Widget Name
     helpDialog st =
@@ -337,7 +352,15 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                     t_rec =<<
                     (isValidUnifiedAddress .
                      E.encodeUtf8 . getUA . walletAddressUAddress)
-                      (entityVal a)))
+                      (entityVal a)) <=>
+                 C.hCenter
+                   (hBox
+                      [ str "Copy: "
+                      , capCommand "U" "nified"
+                      , capCommand "S" "apling"
+                      , capCommand "T" "ransparent"
+                      ]) <=>
+                 C.hCenter xCommand)
             Nothing -> emptyWidget
         PhraseDisplay ->
           case L.listSelectedElement $ st ^. wallets of
@@ -481,60 +504,49 @@ barToDoAttr = A.attrName "remaining"
 validBarValue :: Float -> Float
 validBarValue = clamp 0 1
 
-scanZebra :: Int -> BT.EventM Name State ()
+scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
-scanZebra b = do
+scanZebra dbP zHost zPort b eChan = do
-  s <- BT.get
+  _ <- liftIO $ initDb dbP
-  _ <- liftIO $ initDb $ s ^. dbPath
+  bStatus <- liftIO $ checkBlockChain zHost zPort
-  bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort)
+  pool <- runNoLoggingT $ initPool dbP
-  dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath
+  dbBlock <- runNoLoggingT $ getMaxBlock pool
   let sb = max dbBlock b
   if sb > zgb_blocks bStatus || sb < 1
     then do
-      BT.modify $ set msg "Invalid starting block for scan"
+      liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
-      BT.modify $ set displayBox MsgDisplay
     else do
       let bList = [(sb + 1) .. (zgb_blocks bStatus)]
       let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
-      mapM_ (processBlock step) bList
+      mapM_ (processBlock pool step) bList
   where
-    processBlock :: Float -> Int -> BT.EventM Name State ()
+    processBlock :: ConnectionPool -> Float -> Int -> IO ()
-    processBlock step bl = do
+    processBlock pool step bl = do
-      s <- BT.get
       r <-
         liftIO $
         makeZebraCall
-          (s ^. zebraHost)
+          zHost
-          (s ^. zebraPort)
+          zPort
           "getblock"
           [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
       case r of
         Left e1 -> do
-          BT.modify $ set msg e1
+          liftIO $ BC.writeBChan eChan $ TickMsg e1
-          BT.modify $ set displayBox MsgDisplay
         Right blk -> do
           r2 <-
             liftIO $
             makeZebraCall
-              (s ^. zebraHost)
+              zHost
-              (s ^. zebraPort)
+              zPort
               "getblock"
               [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
           case r2 of
             Left e2 -> do
-              BT.modify $ set msg e2
+              liftIO $ BC.writeBChan eChan $ TickMsg e2
-              BT.modify $ set displayBox MsgDisplay
             Right hb -> do
               let blockTime = getBlockTime hb
-              liftIO $
+              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
-                mapM_
-                  (processTx
-                     (s ^. zebraHost)
-                     (s ^. zebraPort)
-                     blockTime
-                     (s ^. dbPath)) $
                 bl_txs $ addTime blk blockTime
-              BT.modify $ set barValue $ validBarValue (s ^. barValue + step)
+              liftIO $ BC.writeBChan eChan $ TickVal step
-              BT.modify $ set displayBox SyncDisplay
     addTime :: BlockResponse -> Int -> BlockResponse
     addTime bl t =
       BlockResponse
@@ -544,14 +556,69 @@ scanZebra b = do
         (bl_txs bl)
 
 appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
-appEvent (BT.AppEvent Tick) = do
+appEvent (BT.AppEvent t) = do
   s <- BT.get
-  case s ^. displayBox of
+  pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
-    SyncDisplay -> do
+  case t of
-      if s ^. barValue == 1.0
+    TickMsg m -> do
-        then BT.modify $ set displayBox BlankDisplay
+      BT.modify $ set msg m
-        else BT.modify $ set displayBox SyncDisplay
+      BT.modify $ set displayBox MsgDisplay
-    _ -> return ()
+    TickVal v -> do
+      case s ^. displayBox of
+        AddrDisplay -> return ()
+        MsgDisplay -> return ()
+        PhraseDisplay -> return ()
+        TxDisplay -> return ()
+        SyncDisplay -> do
+          if s ^. barValue == 1.0
+            then do
+              selWallet <-
+                do case L.listSelectedElement $ s ^. wallets of
+                     Nothing -> do
+                       let fWall =
+                             L.listSelectedElement $
+                             L.listMoveToBeginning $ s ^. wallets
+                       case fWall of
+                         Nothing -> throw $ userError "Failed to select wallet"
+                         Just (_j, w1) -> return w1
+                     Just (_k, w) -> return w
+              _ <-
+                liftIO $
+                syncWallet
+                  (Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
+                  selWallet
+              BT.modify $ set displayBox BlankDisplay
+              BT.modify $ set barValue 0.0
+              updatedState <- BT.get
+              ns <- liftIO $ refreshWallet updatedState
+              BT.put ns
+            else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
+        BlankDisplay -> do
+          case s ^. dialogBox of
+            AName -> return ()
+            AdName -> return ()
+            WName -> return ()
+            WSelect -> return ()
+            ASelect -> return ()
+            Blank -> do
+              if s ^. timer == 90
+                then do
+                  BT.modify $ set barValue 0.0
+                  BT.modify $ set displayBox SyncDisplay
+                  sBlock <- liftIO $ getMinBirthdayHeight pool
+                  _ <-
+                    liftIO $
+                    forkIO $
+                    scanZebra
+                      (s ^. dbPath)
+                      (s ^. zebraHost)
+                      (s ^. zebraPort)
+                      sBlock
+                      (s ^. eventDispatch)
+                  BT.modify $ set timer 0
+                  return ()
+                else do
+                  BT.modify $ set timer $ 1 + s ^. timer
 appEvent (BT.VtyEvent e) = do
   r <- F.focusGetCurrent <$> use focusRing
   s <- BT.get
@@ -565,33 +632,47 @@ appEvent (BT.VtyEvent e) = do
                _ev -> return ()
            else do
              case s ^. displayBox of
-               AddrDisplay -> BT.modify $ set displayBox BlankDisplay
+               AddrDisplay -> do
+                 case e of
+                   V.EvKey (V.KChar 'x') [] ->
+                     BT.modify $ set displayBox BlankDisplay
+                   V.EvKey (V.KChar 'u') [] -> do
+                     case L.listSelectedElement $ s ^. addresses of
+                       Just (_, a) -> do
+                         liftIO $
+                           setClipboard $
+                           T.unpack $
+                           getUA $ walletAddressUAddress $ entityVal a
+                       Nothing -> return ()
+                   V.EvKey (V.KChar 's') [] -> do
+                     case L.listSelectedElement $ s ^. addresses of
+                       Just (_, a) -> do
+                         liftIO $
+                           setClipboard $
+                           maybe "None" T.unpack $
+                           getSaplingFromUA $
+                           E.encodeUtf8 $
+                           getUA $ walletAddressUAddress $ entityVal a
+                       Nothing -> return ()
+                   V.EvKey (V.KChar 't') [] -> do
+                     case L.listSelectedElement $ s ^. addresses of
+                       Just (_, a) -> do
+                         liftIO $
+                           setClipboard $
+                           T.unpack $
+                           maybe
+                             "None"
+                             (encodeTransparentReceiver (s ^. network)) $
+                           t_rec =<<
+                           (isValidUnifiedAddress .
+                            E.encodeUtf8 . getUA . walletAddressUAddress)
+                             (entityVal a)
+                       Nothing -> return ()
+                   _ev -> return ()
                MsgDisplay -> BT.modify $ set displayBox BlankDisplay
                PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
                TxDisplay -> BT.modify $ set displayBox BlankDisplay
-               SyncDisplay -> do
+               SyncDisplay -> BT.modify $ set displayBox BlankDisplay
-                 if s ^. barValue == 1.0
-                   then BT.modify $ set displayBox BlankDisplay
-                   else do
-                     sBlock <- liftIO $ getMinBirthdayHeight $ s ^. dbPath
-                     selWallet <-
-                       do case L.listSelectedElement $ s ^. wallets of
-                            Nothing -> do
-                              let fWall =
-                                    L.listSelectedElement $
-                                    L.listMoveToBeginning $ s ^. wallets
-                              case fWall of
-                                Nothing ->
-                                  throw $ userError "Failed to select wallet"
-                                Just (_j, w1) -> return w1
-                            Just (_k, w) -> return w
-                     scanZebra sBlock
-                     liftIO $
-                       runFileLoggingT "zenith.log" $
-                       syncWallet
-                         (Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
-                         selWallet
-                     BT.modify $ set displayBox SyncDisplay
                BlankDisplay -> do
                  case s ^. dialogBox of
                    WName -> do
@@ -693,9 +774,6 @@ appEvent (BT.VtyEvent e) = do
                          BT.modify $ set displayBox TxDisplay
                        V.EvKey (V.KChar 'a') [] ->
                          BT.modify $ set dialogBox ASelect
-                       V.EvKey (V.KChar 's') [] -> do
-                         BT.modify $ set barValue 0.0
-                         BT.modify $ set displayBox SyncDisplay
                        ev ->
                          case r of
                            Just AList ->
@@ -740,6 +818,7 @@ runZenithCLI config = do
   let host = c_zebraHost config
   let port = c_zebraPort config
   let dbFilePath = c_dbPath config
+  pool <- runNoLoggingT $ initPool dbFilePath
   w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
   case w of
     Right zebra -> do
@@ -750,18 +829,18 @@ runZenithCLI config = do
         Left e1 -> throwIO e1
         Right chainInfo -> do
           initDb dbFilePath
-          walList <- getWallets dbFilePath $ zgb_net chainInfo
+          walList <- getWallets pool $ zgb_net chainInfo
           accList <-
             if not (null walList)
-              then getAccounts dbFilePath $ entityKey $ head walList
+              then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
               else return []
           addrList <-
             if not (null accList)
-              then getAddresses dbFilePath $ entityKey $ head accList
+              then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
               else return []
           txList <-
             if not (null addrList)
-              then getUserTx dbFilePath $ entityKey $ head addrList
+              then getUserTx pool $ entityKey $ head addrList
               else return []
           let block =
                 if not (null walList)
@@ -769,9 +848,14 @@ runZenithCLI config = do
                   else 0
           bal <-
             if not (null accList)
-              then getBalance dbFilePath $ entityKey $ head accList
+              then getBalance pool $ entityKey $ head accList
               else return 0
           eventChan <- BC.newBChan 10
+          _ <-
+            forkIO $
+            forever $ do
+              BC.writeBChan eventChan (TickVal 0.0)
+              threadDelay 1000000
           let buildVty = VC.mkVty V.defaultConfig
           initialVty <- buildVty
           void $
@@ -800,6 +884,7 @@ runZenithCLI config = do
               bal
               1.0
               eventChan
+              0
     Left e -> do
       print $
         "No Zebra node available on port " <>
@@ -807,34 +892,38 @@ runZenithCLI config = do
 
 refreshWallet :: State -> IO State
 refreshWallet s = do
-  selWallet <-
+  pool <- runNoLoggingT $ initPool $ s ^. dbPath
+  walList <- getWallets pool $ s ^. network
+  (ix, selWallet) <-
     do case L.listSelectedElement $ s ^. wallets of
          Nothing -> do
            let fWall =
                  L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets
            case fWall of
              Nothing -> throw $ userError "Failed to select wallet"
-             Just (_j, w1) -> return w1
+             Just (j, w1) -> return (j, w1)
-         Just (_k, w) -> return w
+         Just (k, w) -> return (k, w)
-  aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
+  aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
   let bl = zcashWalletLastSync $ entityVal selWallet
   addrL <-
     if not (null aL)
-      then getAddresses (s ^. dbPath) $ entityKey $ head aL
+      then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
       else return []
   bal <-
     if not (null aL)
-      then getBalance (s ^. dbPath) $ entityKey $ head aL
+      then getBalance pool $ entityKey $ head aL
       else return 0
   txL <-
     if not (null addrL)
-      then getUserTx (s ^. dbPath) $ entityKey $ head addrL
+      then getUserTx pool $ entityKey $ head addrL
       else return []
+  let wL = L.listReplace (Vec.fromList walList) (Just ix) (s ^. wallets)
   let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
   let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
   let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
   return $
-    (s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~
+    s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
+    addresses .~
     addrL' &
     transactions .~
     txL' &
@@ -845,16 +934,15 @@ refreshWallet s = do
 addNewWallet :: T.Text -> State -> IO State
 addNewWallet n s = do
   sP <- generateWalletSeedPhrase
+  pool <- runNoLoggingT $ initPool $ s ^. dbPath
   let bH = s ^. startBlock
   let netName = s ^. network
-  r <-
+  r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
-    saveWallet (s ^. dbPath) $
-    ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
   case r of
     Nothing -> do
       return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
     Just _ -> do
-      wL <- getWallets (s ^. dbPath) netName
+      wL <- getWallets pool netName
       let aL =
             L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
             L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
@@ -862,6 +950,7 @@ addNewWallet n s = do
 
 addNewAccount :: T.Text -> State -> IO State
 addNewAccount n s = do
+  pool <- runNoLoggingT $ initPool $ s ^. dbPath
   selWallet <-
     do case L.listSelectedElement $ s ^. wallets of
          Nothing -> do
@@ -871,19 +960,19 @@ addNewAccount n s = do
              Nothing -> throw $ userError "Failed to select wallet"
              Just (_j, w1) -> return w1
          Just (_k, w) -> return w
-  aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
+  aL' <- getMaxAccount pool (entityKey selWallet)
   zA <-
     try $ createZcashAccount n (aL' + 1) selWallet :: IO
       (Either IOError ZcashAccount)
   case zA of
     Left e -> return $ s & msg .~ ("Error: " ++ show e)
     Right zA' -> do
-      r <- saveAccount (s ^. dbPath) zA'
+      r <- saveAccount pool zA'
       case r of
         Nothing ->
           return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
         Just x -> do
-          aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
+          aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet)
           let nL =
                 L.listMoveToElement x $
                 L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
@@ -892,6 +981,7 @@ addNewAccount n s = do
 
 refreshAccount :: State -> IO State
 refreshAccount s = do
+  pool <- runNoLoggingT $ initPool $ s ^. dbPath
   selAccount <-
     do case L.listSelectedElement $ s ^. accounts of
          Nothing -> do
@@ -901,8 +991,8 @@ refreshAccount s = do
              Nothing -> throw $ userError "Failed to select account"
              Just (_j, w1) -> return w1
          Just (_k, w) -> return w
-  aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
+  aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
-  bal <- getBalance (s ^. dbPath) $ entityKey selAccount
+  bal <- getBalance pool $ entityKey selAccount
   let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
   selAddress <-
     do case L.listSelectedElement aL' of
@@ -916,7 +1006,7 @@ refreshAccount s = do
       s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
       T.unpack (zcashAccountName $ entityVal selAccount)
     Just (_i, a) -> do
-      tList <- getUserTx (s ^. dbPath) $ entityKey a
+      tList <- getUserTx pool $ entityKey a
       let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
       return $
         s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
@@ -925,6 +1015,7 @@ refreshAccount s = do
 
 refreshTxs :: State -> IO State
 refreshTxs s = do
+  pool <- runNoLoggingT $ initPool $ s ^. dbPath
   selAddress <-
     do case L.listSelectedElement $ s ^. addresses of
          Nothing -> do
@@ -935,12 +1026,13 @@ refreshTxs s = do
   case selAddress of
     Nothing -> return s
     Just (_i, a) -> do
-      tList <- getUserTx (s ^. dbPath) $ entityKey a
+      tList <- getUserTx pool $ entityKey a
       let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
       return $ s & transactions .~ tL'
 
 addNewAddress :: T.Text -> Scope -> State -> IO State
 addNewAddress n scope s = do
+  pool <- runNoLoggingT $ initPool $ s ^. dbPath
   selAccount <-
     do case L.listSelectedElement $ s ^. accounts of
          Nothing -> do
@@ -950,19 +1042,19 @@ addNewAddress n scope s = do
              Nothing -> throw $ userError "Failed to select account"
              Just (_j, a1) -> return a1
          Just (_k, a) -> return a
-  maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope
+  maxAddr <- getMaxAddress pool (entityKey selAccount) scope
   uA <-
     try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
       (Either IOError WalletAddress)
   case uA of
     Left e -> return $ s & msg .~ ("Error: " ++ show e)
     Right uA' -> do
-      nAddr <- saveAddress (s ^. dbPath) uA'
+      nAddr <- saveAddress pool uA'
       case nAddr of
         Nothing ->
           return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
         Just x -> do
-          addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
+          addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
           let nL =
                 L.listMoveToElement x $
                 L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)

src/Zenith/Core.hs

@@ -9,9 +9,11 @@ import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger
   ( LoggingT
   , MonadLoggerIO
+  , NoLoggingT
   , logInfoN
   , logWarnN
   , runFileLoggingT
+  , runNoLoggingT
   , runStdoutLoggingT
   )
 import Crypto.Secp256k1 (SecKey(..))
@@ -31,6 +33,7 @@ import Database.Persist
 import Database.Persist.Sqlite
 import GHC.Float.RealFracMethods (floorFloatInteger)
 import Haskoin.Crypto.Keys (XPrvKey(..))
+import Lens.Micro ((&), (.~), (^.), set)
 import Network.HTTP.Client
 import ZcashHaskell.Keys
 import ZcashHaskell.Orchard
@@ -230,22 +233,24 @@ findSaplingOutputs config b znet za = do
   let zebraHost = c_zebraHost config
   let zebraPort = c_zebraPort config
   let zn = getNet znet
-  tList <- getShieldedOutputs dbPath b
+  pool <- runNoLoggingT $ initPool dbPath
+  tList <- getShieldedOutputs pool b
   trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
   let sT = SaplingCommitmentTree $ ztiSapling trees
-  decryptNotes sT zn tList
+  decryptNotes sT zn pool tList
-  sapNotes <- getWalletSapNotes dbPath (entityKey za)
+  sapNotes <- getWalletSapNotes pool (entityKey za)
-  findSapSpends dbPath (entityKey za) sapNotes
+  findSapSpends pool (entityKey za) sapNotes
   where
     sk :: SaplingSpendingKeyDB
     sk = zcashAccountSapSpendKey $ entityVal za
     decryptNotes ::
          SaplingCommitmentTree
       -> ZcashNet
+      -> ConnectionPool
       -> [(Entity ZcashTransaction, Entity ShieldOutput)]
       -> IO ()
-    decryptNotes _ _ [] = return ()
+    decryptNotes _ _ _ [] = return ()
-    decryptNotes st n ((zt, o):txs) = do
+    decryptNotes st n pool ((zt, o):txs) = do
       let updatedTree =
             updateSaplingCommitmentTree
               st
@@ -262,15 +267,11 @@ findSaplingOutputs config b znet za = do
                 Nothing -> do
                   case decodeShOut Internal n nP o of
                     Nothing -> do
-                      decryptNotes uT n txs
+                      decryptNotes uT n pool txs
                     Just dn1 -> do
-                      wId <-
+                      wId <- saveWalletTransaction pool (entityKey za) zt
-                        saveWalletTransaction
-                          (c_dbPath config)
-                          (entityKey za)
-                          zt
                       saveWalletSapNote
-                        (c_dbPath config)
+                        pool
                         wId
                         nP
                         (fromJust noteWitness)
@@ -278,12 +279,11 @@ findSaplingOutputs config b znet za = do
                         (entityKey za)
                         (entityKey o)
                         dn1
-                      decryptNotes uT n txs
+                      decryptNotes uT n pool txs
                 Just dn0 -> do
-                  wId <-
+                  wId <- saveWalletTransaction pool (entityKey za) zt
-                    saveWalletTransaction (c_dbPath config) (entityKey za) zt
                   saveWalletSapNote
-                    (c_dbPath config)
+                    pool
                     wId
                     nP
                     (fromJust noteWitness)
@@ -291,7 +291,7 @@ findSaplingOutputs config b znet za = do
                     (entityKey za)
                     (entityKey o)
                     dn0
-                  decryptNotes uT n txs
+                  decryptNotes uT n pool txs
     decodeShOut ::
          Scope
       -> ZcashNet
@@ -324,20 +324,22 @@ findOrchardActions config b znet za = do
   let zebraHost = c_zebraHost config
   let zebraPort = c_zebraPort config
   let zn = getNet znet
-  tList <- getOrchardActions dbPath b
+  pool <- runNoLoggingT $ initPool dbPath
+  tList <- getOrchardActions pool b
   trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
   let sT = OrchardCommitmentTree $ ztiOrchard trees
-  decryptNotes sT zn tList
+  decryptNotes sT zn pool tList
-  orchNotes <- getWalletOrchNotes dbPath (entityKey za)
+  orchNotes <- getWalletOrchNotes pool (entityKey za)
-  findOrchSpends dbPath (entityKey za) orchNotes
+  findOrchSpends pool (entityKey za) orchNotes
   where
     decryptNotes ::
          OrchardCommitmentTree
       -> ZcashNet
+      -> ConnectionPool
       -> [(Entity ZcashTransaction, Entity OrchAction)]
       -> IO ()
-    decryptNotes _ _ [] = return ()
+    decryptNotes _ _ _ [] = return ()
-    decryptNotes ot n ((zt, o):txs) = do
+    decryptNotes ot n pool ((zt, o):txs) = do
       let updatedTree =
             updateOrchardCommitmentTree
               ot
@@ -353,15 +355,11 @@ findOrchardActions config b znet za = do
               case decodeOrchAction External nP o of
                 Nothing ->
                   case decodeOrchAction Internal nP o of
-                    Nothing -> decryptNotes uT n txs
+                    Nothing -> decryptNotes uT n pool txs
                     Just dn1 -> do
-                      wId <-
+                      wId <- saveWalletTransaction pool (entityKey za) zt
-                        saveWalletTransaction
-                          (c_dbPath config)
-                          (entityKey za)
-                          zt
                       saveWalletOrchNote
-                        (c_dbPath config)
+                        pool
                         wId
                         nP
                         (fromJust noteWitness)
@@ -369,12 +367,11 @@ findOrchardActions config b znet za = do
                         (entityKey za)
                         (entityKey o)
                         dn1
-                      decryptNotes uT n txs
+                      decryptNotes uT n pool txs
                 Just dn -> do
-                  wId <-
+                  wId <- saveWalletTransaction pool (entityKey za) zt
-                    saveWalletTransaction (c_dbPath config) (entityKey za) zt
                   saveWalletOrchNote
-                    (c_dbPath config)
+                    pool
                     wId
                     nP
                     (fromJust noteWitness)
@@ -382,7 +379,7 @@ findOrchardActions config b znet za = do
                     (entityKey za)
                     (entityKey o)
                     dn
-                  decryptNotes uT n txs
+                  decryptNotes uT n pool txs
     sk :: OrchardSpendingKeyDB
     sk = zcashAccountOrchSpendKey $ entityVal za
     decodeOrchAction ::
@@ -399,56 +396,41 @@ findOrchardActions config b znet za = do
         (getHex $ orchActionCv $ entityVal o)
         (getHex $ orchActionAuth $ entityVal o)
 
-updateSaplingWitnesses :: T.Text -> LoggingT IO ()
+updateSaplingWitnesses :: ConnectionPool -> IO ()
-updateSaplingWitnesses dbPath = do
+updateSaplingWitnesses pool = do
-  sapNotes <- liftIO $ getUnspentSapNotes dbPath
+  sapNotes <- getUnspentSapNotes pool
-  pool <- createSqlitePool dbPath 5
   maxId <- liftIO $ getMaxSaplingNote pool
-  mapM_ (updateOneNote pool maxId) sapNotes
+  mapM_ (updateOneNote maxId) sapNotes
   where
-    updateOneNote ::
+    updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
-         Pool SqlBackend
+    updateOneNote maxId n = do
-      -> ShieldOutputId
-      -> Entity WalletSapNote
-      -> LoggingT IO ()
-    updateOneNote pool maxId n = do
       let noteSync = walletSapNoteWitPos $ entityVal n
-      if noteSync < maxId
+      when (noteSync < maxId) $ do
-        then do
+        cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
-          cmus <-
+        let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
-            liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
+        let newWitness =
-          let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
+              updateSaplingWitness
-          let newWitness =
+                (SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
-                updateSaplingWitness
+                cmuList
-                  (SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
+        liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
-                  cmuList
-          liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
-        else logInfoN "Witness up to date"
 
-updateOrchardWitnesses :: T.Text -> LoggingT IO ()
+updateOrchardWitnesses :: ConnectionPool -> IO ()
-updateOrchardWitnesses dbPath = do
+updateOrchardWitnesses pool = do
-  orchNotes <- liftIO $ getUnspentOrchNotes dbPath
+  orchNotes <- getUnspentOrchNotes pool
-  pool <- createSqlitePool dbPath 5
+  maxId <- getMaxOrchardNote pool
-  maxId <- liftIO $ getMaxOrchardNote pool
+  mapM_ (updateOneNote maxId) orchNotes
-  mapM_ (updateOneNote pool maxId) orchNotes
   where
-    updateOneNote ::
+    updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
-         Pool SqlBackend
+    updateOneNote maxId n = do
-      -> OrchActionId
-      -> Entity WalletOrchNote
-      -> LoggingT IO ()
-    updateOneNote pool maxId n = do
       let noteSync = walletOrchNoteWitPos $ entityVal n
-      if noteSync < maxId
+      when (noteSync < maxId) $ do
-        then do
+        cmxs <- liftIO $ getOrchardCmxs pool noteSync
-          cmxs <- liftIO $ getOrchardCmxs pool noteSync
+        let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
-          let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
+        let newWitness =
-          let newWitness =
+              updateOrchardWitness
-                updateOrchardWitness
+                (OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
-                  (OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
+                cmxList
-                  cmxList
+        liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
-          liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
-        else logInfoN "Witness up to date"
 
 -- | Calculate fee per ZIP-317
 calculateTxFee ::
@@ -474,7 +456,7 @@ calculateTxFee (t, s, o) i =
 
 -- | Prepare a transaction for sending
 prepareTx ::
-     T.Text
+     ConnectionPool
   -> T.Text
   -> Int
   -> ZcashNet
@@ -484,8 +466,8 @@ prepareTx ::
   -> UnifiedAddress
   -> T.Text
   -> IO (Either TxError HexString)
-prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
+prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
-  accRead <- getAccountById dbPath za
+  accRead <- getAccountById pool za
   let recipient =
         case o_rec ua of
           Nothing ->
@@ -521,11 +503,11 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
       print $ BS.length outParams
       print "Read Sapling params"
       let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
-      firstPass <- selectUnspentNotes dbPath za zats
+      firstPass <- selectUnspentNotes pool za zats
       let fee = calculateTxFee firstPass 3
       print "calculated fee"
       print fee
-      (tList, sList, oList) <- selectUnspentNotes dbPath za (zats + fee)
+      (tList, sList, oList) <- selectUnspentNotes pool za (zats + fee)
       print "selected notes"
       print tList
       print sList
@@ -564,7 +546,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
       -> Integer
       -> IO [OutgoingNote]
     makeOutgoing acc (k, recvr) zats chg = do
-      chgAddr <- getInternalAddresses dbPath $ entityKey acc
+      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
       let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
       let chgRcvr =
             fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
@@ -604,7 +586,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
       -> IO [TransparentTxSpend]
     prepTSpends sk notes = do
       forM notes $ \n -> do
-        tAddRead <- getAddressById dbPath $ walletTrNoteAddress $ entityVal n
+        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
         print n
         case tAddRead of
           Nothing -> throwIO $ userError "Couldn't read t-address"
@@ -614,7 +596,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
                 (walletAddressIndex $ entityVal tAdd)
                 (getScope $ walletAddressScope $ entityVal tAdd)
                 sk
-            mReverseTxId <- getWalletTxId dbPath $ walletTrNoteTx $ entityVal n
+            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
             case mReverseTxId of
               Nothing -> throwIO $ userError "failed to get tx ID"
               Just (ESQ.Value reverseTxId) -> do
@@ -679,22 +661,24 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
 syncWallet ::
      Config -- ^ configuration parameters
   -> Entity ZcashWallet
-  -> LoggingT IO ()
+  -> IO ()
 syncWallet config w = do
+  startTime <- liftIO getCurrentTime
   let walletDb = c_dbPath config
-  accs <- liftIO $ getAccounts walletDb $ entityKey w
+  pool <- runNoLoggingT $ initPool walletDb
-  addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs
+  accs <- runNoLoggingT $ getAccounts pool $ entityKey w
+  addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
   intAddrs <-
-    liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
+    concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
-  chainTip <- liftIO $ getMaxBlock walletDb
+  chainTip <- runNoLoggingT $ getMaxBlock pool
   let lastBlock = zcashWalletLastSync $ entityVal w
   let startBlock =
         if lastBlock > 0
           then lastBlock
           else zcashWalletBirthdayHeight $ entityVal w
-  mapM_ (liftIO . findTransparentNotes walletDb startBlock) addrs
+  mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
-  mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs
+  mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
-  mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs
+  mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
   sapNotes <-
     liftIO $
     mapM
@@ -705,52 +689,52 @@ syncWallet config w = do
     mapM
       (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
       accs
-  _ <- updateSaplingWitnesses walletDb
+  _ <- updateSaplingWitnesses pool
-  _ <- updateOrchardWitnesses walletDb
+  _ <- updateOrchardWitnesses pool
-  _ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w)
+  _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
-  _ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs
+  mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
-  logInfoN "Synced wallet"
 
 testSync :: Config -> IO ()
 testSync config = do
   let dbPath = c_dbPath config
   _ <- initDb dbPath
-  w <- getWallets dbPath TestNet
+  pool <- runNoLoggingT $ initPool dbPath
-  r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w
+  w <- getWallets pool TestNet
+  r <- mapM (syncWallet config) w
   liftIO $ print r
+  {-let uaRead =-}
+        {-isValidUnifiedAddress-}
+          {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
+  {-case uaRead of-}
+    {-Nothing -> print "wrong address"-}
+    {-Just ua -> do-}
+      {-startTime <- getCurrentTime-}
+      {-print startTime-}
+      {-tx <--}
+        {-prepareTx-}
+          {-"zenith.db"-}
+          {-"127.0.0.1"-}
+          {-18232-}
+          {-TestNet-}
+          {-(toSqlKey 1)-}
+          {-2820897-}
+          {-0.04-}
+          {-ua-}
+          {-"sent with Zenith, test"-}
+      {-print tx-}
+      {-endTime <- getCurrentTime-}
+      {-print endTime-}
 
-testSend :: IO ()
+{-testSend :: IO ()-}
-testSend = do
+{-testSend = do-}
-  let uaRead =
-        isValidUnifiedAddress
-          "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-  case uaRead of
-    Nothing -> print "wrong address"
-    Just ua -> do
-      startTime <- getCurrentTime
-      print startTime
-      tx <-
-        prepareTx
-          "zenith.db"
-          "127.0.0.1"
-          18232
-          TestNet
-          (toSqlKey 1)
-          2820897
-          0.04
-          ua
-          "sent with Zenith, test"
-      print tx
-      endTime <- getCurrentTime
-      print endTime
-
 clearSync :: Config -> IO ()
 clearSync config = do
   let dbPath = c_dbPath config
+  pool <- runNoLoggingT $ initPool dbPath
   _ <- initDb dbPath
-  _ <- clearWalletTransactions dbPath
+  _ <- clearWalletTransactions pool
-  w <- getWallets dbPath TestNet
+  w <- getWallets pool TestNet
-  liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w
+  liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
-  w' <- liftIO $ getWallets dbPath TestNet
+  w' <- liftIO $ getWallets pool TestNet
-  r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
+  r <- mapM (syncWallet config) w'
   liftIO $ print r

src/Zenith/Scanner.hs

@@ -3,11 +3,23 @@
 module Zenith.Scanner where
 
 import Control.Exception (throwIO, try)
+import qualified Control.Monad.Catch as CM (try)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Logger
+  ( LoggingT
+  , NoLoggingT
+  , logErrorN
+  , logInfoN
+  , runNoLoggingT
+  )
 import Data.Aeson
 import Data.HexString
 import Data.Maybe
 import qualified Data.Text as T
+import Data.Time (getCurrentTime)
+import Database.Persist.Sqlite
 import GHC.Utils.Monad (concatMapM)
+import Lens.Micro ((&), (.~), (^.), set)
 import System.Console.AsciiProgress
 import ZcashHaskell.Types
   ( BlockResponse(..)
@@ -30,64 +42,77 @@ scanZebra ::
   -> T.Text -- ^ Host
   -> Int -- ^ Port
   -> T.Text -- ^ Path to database file
-  -> IO ()
+  -> NoLoggingT IO ()
 scanZebra b host port dbFilePath = do
-  _ <- initDb dbFilePath
+  _ <- liftIO $ initDb dbFilePath
+  startTime <- liftIO getCurrentTime
+  logInfoN $ "Started sync: " <> T.pack (show startTime)
   bc <-
-    try $ checkBlockChain host port :: IO
+    liftIO $ try $ checkBlockChain host port :: NoLoggingT
+      IO
       (Either IOError ZebraGetBlockChainInfo)
   case bc of
-    Left e -> print e
+    Left e -> logErrorN $ T.pack (show e)
     Right bStatus -> do
-      dbBlock <- getMaxBlock dbFilePath
+      let dbInfo =
+            mkSqliteConnectionInfo dbFilePath & extraPragmas .~
+            ["read_uncommited = true"]
+      pool <- createSqlitePoolFromInfo dbInfo 5
+      dbBlock <- getMaxBlock pool
       let sb = max dbBlock b
       if sb > zgb_blocks bStatus || sb < 1
-        then throwIO $ userError "Invalid starting block for scan"
+        then liftIO $ throwIO $ userError "Invalid starting block for scan"
         else do
-          print $
+          liftIO $
+            print $
             "Scanning from " ++
             show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
           let bList = [(sb + 1) .. (zgb_blocks bStatus)]
           displayConsoleRegions $ do
-            pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
+            pg <-
+              liftIO $
+              newProgressBar def {pgTotal = fromIntegral $ length bList}
             txList <-
-              try $ mapM_ (processBlock host port dbFilePath pg) bList :: IO
+              CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
+                IO
                 (Either IOError ())
             case txList of
-              Left e1 -> print e1
+              Left e1 -> logErrorN $ T.pack (show e1)
-              Right txList' -> print txList'
+              Right txList' -> logInfoN "Finished scan"
 
 -- | Function to process a raw block and extract the transaction information
 processBlock ::
      T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
-  -> T.Text -- ^ DB file path
+  -> ConnectionPool -- ^ DB file path
   -> ProgressBar -- ^ Progress bar
   -> Int -- ^ The block number to process
-  -> IO ()
+  -> NoLoggingT IO ()
-processBlock host port dbFp pg b = do
+processBlock host port pool pg b = do
   r <-
+    liftIO $
     makeZebraCall
       host
       port
       "getblock"
       [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
   case r of
-    Left e -> throwIO $ userError e
+    Left e -> liftIO $ throwIO $ userError e
     Right blk -> do
       r2 <-
+        liftIO $
         makeZebraCall
           host
           port
           "getblock"
           [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
       case r2 of
-        Left e2 -> throwIO $ userError e2
+        Left e2 -> liftIO $ throwIO $ userError e2
         Right hb -> do
           let blockTime = getBlockTime hb
-          mapM_ (processTx host port blockTime dbFp) $
+          mapM_ (processTx host port blockTime pool) $
             bl_txs $ addTime blk blockTime
-          tick pg
+          liftIO $ tick pg
   where
     addTime :: BlockResponse -> Int -> BlockResponse
     addTime bl t =
@@ -102,24 +127,25 @@ processTx ::
      T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
   -> Int -- ^ Block time
-  -> T.Text -- ^ DB file path
+  -> ConnectionPool -- ^ DB file path
   -> HexString -- ^ transaction id
-  -> IO ()
+  -> NoLoggingT IO ()
-processTx host port bt dbFp t = do
+processTx host port bt pool t = do
   r <-
+    liftIO $
     makeZebraCall
       host
       port
       "getrawtransaction"
       [Data.Aeson.String $ toText t, jsonNumber 1]
   case r of
-    Left e -> throwIO $ userError e
+    Left e -> liftIO $ throwIO $ userError e
     Right rawTx -> do
       case readZebraTransaction (ztr_hex rawTx) of
         Nothing -> return ()
         Just rzt -> do
           _ <-
-            saveTransaction dbFp bt $
+            saveTransaction pool bt $
             Transaction
               t
               (ztr_blockheight rawTx)

zenith.cabal

@@ -46,6 +46,7 @@ library
     , bytestring
     , esqueleto
     , resource-pool
+    , exceptions
     , monad-logger
     , vty-crossplatform
     , secp256k1-haskell
@@ -61,6 +62,7 @@ library
     , microlens-th
     , mtl
     , persistent
+    , Hclip
     , persistent-sqlite
     , persistent-template
     , process
@@ -105,6 +107,7 @@ executable zenscan
   build-depends:
       base >=4.12 && <5
     , configurator
+    , monad-logger
     , zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010