app/Main.hs

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

app/ZenScan.hs

@@ -2,7 +2,6 @@
 
 module ZenScan where
 
-import Control.Monad.Logger (runNoLoggingT)
 import Data.Configurator
 import Zenith.Scanner (scanZebra)
 
@@ -12,4 +11,4 @@ main = do
   dbFilePath <- require config "dbFilePath"
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
-  runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath
+  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 (LoggingT, runFileLoggingT, runNoLoggingT)
+import Control.Monad.Logger (runFileLoggingT)
 import Data.Aeson
 import Data.Maybe
 import qualified Data.Text as T
@@ -63,13 +63,11 @@ 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)
@@ -118,9 +116,8 @@ data DisplayType
   | SyncDisplay
   | BlankDisplay
 
-data Tick
+data Tick =
-  = TickVal !Float
+  Tick
-  | TickMsg !String
 
 data State = State
   { _network :: !ZcashNet
@@ -143,7 +140,6 @@ data State = State
   , _balance :: !Integer
   , _barValue :: !Float
   , _eventDispatch :: !(BC.BChan Tick)
-  , _timer :: !Int
   }
 
 makeLenses ''State
@@ -189,7 +185,6 @@ 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 =
@@ -223,12 +218,7 @@ 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
+        , C.hCenter $ str "Use arrows to select"
-            (hBox
-               [ capCommand "↑↓ " "move"
-               , capCommand "↲ " "select"
-               , capCommand "Tab " "->"
-               ])
         ]
     listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
     listTxBox titleLabel tx =
@@ -238,12 +228,7 @@ 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
+        , C.hCenter $ str "Use arrows to select"
-            (hBox
-               [ capCommand "↑↓ " "move"
-               , capCommand "T" "x Display"
-               , capCommand "Tab " "<-"
-               ])
         ]
     helpDialog :: State -> Widget Name
     helpDialog st =
@@ -352,15 +337,7 @@ 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
@@ -504,49 +481,60 @@ barToDoAttr = A.attrName "remaining"
 validBarValue :: Float -> Float
 validBarValue = clamp 0 1
 
-scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
+scanZebra :: Int -> BT.EventM Name State ()
-scanZebra dbP zHost zPort b eChan = do
+scanZebra b = do
-  _ <- liftIO $ initDb dbP
+  s <- BT.get
-  bStatus <- liftIO $ checkBlockChain zHost zPort
+  _ <- liftIO $ initDb $ s ^. dbPath
-  pool <- runNoLoggingT $ initPool dbP
+  bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort)
-  dbBlock <- runNoLoggingT $ getMaxBlock pool
+  dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath
   let sb = max dbBlock b
   if sb > zgb_blocks bStatus || sb < 1
     then do
-      liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
+      BT.modify $ set msg "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 pool step) bList
+      mapM_ (processBlock step) bList
   where
-    processBlock :: ConnectionPool -> Float -> Int -> IO ()
+    processBlock :: Float -> Int -> BT.EventM Name State ()
-    processBlock pool step bl = do
+    processBlock step bl = do
+      s <- BT.get
       r <-
         liftIO $
         makeZebraCall
-          zHost
+          (s ^. zebraHost)
-          zPort
+          (s ^. zebraPort)
           "getblock"
           [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
       case r of
         Left e1 -> do
-          liftIO $ BC.writeBChan eChan $ TickMsg e1
+          BT.modify $ set msg e1
+          BT.modify $ set displayBox MsgDisplay
         Right blk -> do
           r2 <-
             liftIO $
             makeZebraCall
-              zHost
+              (s ^. zebraHost)
-              zPort
+              (s ^. zebraPort)
               "getblock"
               [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
           case r2 of
             Left e2 -> do
-              liftIO $ BC.writeBChan eChan $ TickMsg e2
+              BT.modify $ set msg e2
+              BT.modify $ set displayBox MsgDisplay
             Right hb -> do
               let blockTime = getBlockTime hb
-              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
+              liftIO $
+                mapM_
+                  (processTx
+                     (s ^. zebraHost)
+                     (s ^. zebraPort)
+                     blockTime
+                     (s ^. dbPath)) $
                 bl_txs $ addTime blk blockTime
-              liftIO $ BC.writeBChan eChan $ TickVal step
+              BT.modify $ set barValue $ validBarValue (s ^. barValue + step)
+              BT.modify $ set displayBox SyncDisplay
     addTime :: BlockResponse -> Int -> BlockResponse
     addTime bl t =
       BlockResponse
@@ -556,69 +544,14 @@ scanZebra dbP zHost zPort b eChan = do
         (bl_txs bl)
 
 appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
-appEvent (BT.AppEvent t) = do
+appEvent (BT.AppEvent Tick) = do
   s <- BT.get
-  pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
-  case t of
-    TickMsg m -> do
-      BT.modify $ set msg m
-      BT.modify $ set displayBox MsgDisplay
-    TickVal v -> do
   case s ^. displayBox of
-        AddrDisplay -> return ()
-        MsgDisplay -> return ()
-        PhraseDisplay -> return ()
-        TxDisplay -> return ()
     SyncDisplay -> do
       if s ^. barValue == 1.0
-            then do
+        then BT.modify $ set displayBox BlankDisplay
-              selWallet <-
+        else BT.modify $ set displayBox SyncDisplay
-                do case L.listSelectedElement $ s ^. wallets of
+    _ -> return ()
-                     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
@@ -632,47 +565,33 @@ appEvent (BT.VtyEvent e) = do
                _ev -> return ()
            else do
              case s ^. displayBox of
-               AddrDisplay -> do
+               AddrDisplay -> BT.modify $ set displayBox BlankDisplay
-                 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 -> BT.modify $ set displayBox BlankDisplay
+               SyncDisplay -> do
+                 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
@@ -774,6 +693,9 @@ 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 ->
@@ -818,7 +740,6 @@ 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
@@ -829,18 +750,18 @@ runZenithCLI config = do
         Left e1 -> throwIO e1
         Right chainInfo -> do
           initDb dbFilePath
-          walList <- getWallets pool $ zgb_net chainInfo
+          walList <- getWallets dbFilePath $ zgb_net chainInfo
           accList <-
             if not (null walList)
-              then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
+              then getAccounts dbFilePath $ entityKey $ head walList
               else return []
           addrList <-
             if not (null accList)
-              then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
+              then getAddresses dbFilePath $ entityKey $ head accList
               else return []
           txList <-
             if not (null addrList)
-              then getUserTx pool $ entityKey $ head addrList
+              then getUserTx dbFilePath $ entityKey $ head addrList
               else return []
           let block =
                 if not (null walList)
@@ -848,14 +769,9 @@ runZenithCLI config = do
                   else 0
           bal <-
             if not (null accList)
-              then getBalance pool $ entityKey $ head accList
+              then getBalance dbFilePath $ 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 $
@@ -884,7 +800,6 @@ runZenithCLI config = do
               bal
               1.0
               eventChan
-              0
     Left e -> do
       print $
         "No Zebra node available on port " <>
@@ -892,38 +807,34 @@ runZenithCLI config = do
 
 refreshWallet :: State -> IO State
 refreshWallet s = do
-  pool <- runNoLoggingT $ initPool $ s ^. dbPath
+  selWallet <-
-  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 (j, w1)
+             Just (_j, w1) -> return w1
-         Just (k, w) -> return (k, w)
+         Just (_k, w) -> return w
-  aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
+  aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
   let bl = zcashWalletLastSync $ entityVal selWallet
   addrL <-
     if not (null aL)
-      then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
+      then getAddresses (s ^. dbPath) $ entityKey $ head aL
       else return []
   bal <-
     if not (null aL)
-      then getBalance pool $ entityKey $ head aL
+      then getBalance (s ^. dbPath) $ entityKey $ head aL
       else return 0
   txL <-
     if not (null addrL)
-      then getUserTx pool $ entityKey $ head addrL
+      then getUserTx (s ^. dbPath) $ 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 & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
+    (s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~
-    addresses .~
     addrL' &
     transactions .~
     txL' &
@@ -934,15 +845,16 @@ 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 <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
+  r <-
+    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 pool netName
+      wL <- getWallets (s ^. dbPath) netName
       let aL =
             L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
             L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
@@ -950,7 +862,6 @@ 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
@@ -960,19 +871,19 @@ addNewAccount n s = do
              Nothing -> throw $ userError "Failed to select wallet"
              Just (_j, w1) -> return w1
          Just (_k, w) -> return w
-  aL' <- getMaxAccount pool (entityKey selWallet)
+  aL' <- getMaxAccount (s ^. dbPath) (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 pool zA'
+      r <- saveAccount (s ^. dbPath) zA'
       case r of
         Nothing ->
           return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
         Just x -> do
-          aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet)
+          aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
           let nL =
                 L.listMoveToElement x $
                 L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
@@ -981,7 +892,6 @@ 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
@@ -991,8 +901,8 @@ refreshAccount s = do
              Nothing -> throw $ userError "Failed to select account"
              Just (_j, w1) -> return w1
          Just (_k, w) -> return w
-  aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
+  aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
-  bal <- getBalance pool $ entityKey selAccount
+  bal <- getBalance (s ^. dbPath) $ entityKey selAccount
   let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
   selAddress <-
     do case L.listSelectedElement aL' of
@@ -1006,7 +916,7 @@ refreshAccount s = do
       s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
       T.unpack (zcashAccountName $ entityVal selAccount)
     Just (_i, a) -> do
-      tList <- getUserTx pool $ entityKey a
+      tList <- getUserTx (s ^. dbPath) $ entityKey a
       let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
       return $
         s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
@@ -1015,7 +925,6 @@ 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
@@ -1026,13 +935,12 @@ refreshTxs s = do
   case selAddress of
     Nothing -> return s
     Just (_i, a) -> do
-      tList <- getUserTx pool $ entityKey a
+      tList <- getUserTx (s ^. dbPath) $ 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
@@ -1042,19 +950,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 pool (entityKey selAccount) scope
+  maxAddr <- getMaxAddress (s ^. dbPath) (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 pool uA'
+      nAddr <- saveAddress (s ^. dbPath) uA'
       case nAddr of
         Nothing ->
           return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
         Just x -> do
-          addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
+          addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
           let nL =
                 L.listMoveToElement x $
                 L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)

src/Zenith/Core.hs

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

src/Zenith/DB.hs

@@ -21,7 +21,6 @@ module Zenith.DB where
 import Control.Exception (throwIO)
 import Control.Monad (forM_, when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
-import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
 import Data.Bifunctor (bimap)
 import qualified Data.ByteString as BS
 import Data.HexString
@@ -41,7 +40,6 @@ import Haskoin.Transaction.Common
   , TxOut(..)
   , txHashToHex
   )
-import qualified Lens.Micro as ML ((&), (.~), (^.))
 import ZcashHaskell.Orchard (isValidUnifiedAddress)
 import ZcashHaskell.Sapling (decodeSaplingOutputEsk)
 import ZcashHaskell.Types
@@ -253,11 +251,6 @@ initDb ::
 initDb dbName = do
   PS.runSqlite dbName $ do runMigration migrateAll
 
-initPool :: T.Text -> NoLoggingT IO ConnectionPool
-initPool dbPath = do
-  let dbInfo = PS.mkSqliteConnectionInfo dbPath
-  PS.createSqlitePoolFromInfo dbInfo 5
-
 -- | Upgrade the database
 upgradeDb ::
      T.Text -- ^ database path
@@ -266,11 +259,9 @@ upgradeDb dbName = do
   PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
 
 -- | Get existing wallets from database
-getWallets :: ConnectionPool -> ZcashNet -> IO [Entity ZcashWallet]
+getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
-getWallets pool n =
+getWallets dbFp n =
-  runNoLoggingT $
+  PS.runSqlite dbFp $
-  PS.retryOnBusy $
-  flip PS.runSqlPool pool $ do
   select $ do
     wallets <- from $ table @ZcashWallet
     where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
@@ -278,42 +269,34 @@ getWallets pool n =
 
 -- | Save a new wallet to the database
 saveWallet ::
-     ConnectionPool -- ^ The database path to use
+     T.Text -- ^ The database path to use
   -> ZcashWallet -- ^ The wallet to add to the database
   -> IO (Maybe (Entity ZcashWallet))
-saveWallet pool w =
+saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
-  runNoLoggingT $
-  PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
 
 -- | Update the last sync block for the wallet
-updateWalletSync :: ConnectionPool -> Int -> ZcashWalletId -> IO ()
+updateWalletSync :: T.Text -> Int -> ZcashWalletId -> IO ()
-updateWalletSync pool b i = do
+updateWalletSync dbPath b i = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     update $ \w -> do
       set w [ZcashWalletLastSync =. val b]
       where_ $ w ^. ZcashWalletId ==. val i
 
 -- | Returns a list of accounts associated with the given wallet
 getAccounts ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashWalletId -- ^ The wallet ID to check
-  -> NoLoggingT IO [Entity ZcashAccount]
+  -> IO [Entity ZcashAccount]
-getAccounts pool w =
+getAccounts dbFp w =
-  PS.retryOnBusy $
+  PS.runSqlite dbFp $
-  flip PS.runSqlPool pool $ do
   select $ do
     accs <- from $ table @ZcashAccount
     where_ (accs ^. ZcashAccountWalletId ==. val w)
     pure accs
 
-getAccountById ::
+getAccountById :: T.Text -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount))
-     ConnectionPool -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount))
+getAccountById dbPath za = do
-getAccountById pool za = do
+  PS.runSqlite dbPath $
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       accs <- from $ table @ZcashAccount
       where_ (accs ^. ZcashAccountId ==. val za)
@@ -321,14 +304,12 @@ getAccountById pool za = do
 
 -- | Returns the largest account index for the given wallet
 getMaxAccount ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashWalletId -- ^ The wallet ID to check
   -> IO Int
-getMaxAccount pool w = do
+getMaxAccount dbFp w = do
   a <-
-    runNoLoggingT $
+    PS.runSqlite dbFp $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       accs <- from $ table @ZcashAccount
       where_ (accs ^. ZcashAccountWalletId ==. val w)
@@ -340,21 +321,18 @@ getMaxAccount pool w = do
 
 -- | Save a new account to the database
 saveAccount ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashAccount -- ^ The account to add to the database
   -> IO (Maybe (Entity ZcashAccount))
-saveAccount pool a =
+saveAccount dbFp a = PS.runSqlite dbFp $ insertUniqueEntity a
-  runNoLoggingT $
-  PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity a
 
 -- | Returns the largest block in storage
 getMaxBlock ::
-     Pool SqlBackend -- ^ The database pool
+     T.Text -- ^ The database path
-  -> NoLoggingT IO Int
+  -> IO Int
-getMaxBlock pool = do
+getMaxBlock dbPath = do
   b <-
-    PS.retryOnBusy $
+    PS.runSqlite dbPath $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       txs <- from $ table @ZcashTransaction
       where_ (txs ^. ZcashTransactionBlock >. val 0)
@@ -366,24 +344,20 @@ getMaxBlock pool = do
 
 -- | Returns a list of addresses associated with the given account
 getAddresses ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashAccountId -- ^ The account ID to check
-  -> NoLoggingT IO [Entity WalletAddress]
+  -> IO [Entity WalletAddress]
-getAddresses pool a =
+getAddresses dbFp a =
-  PS.retryOnBusy $
+  PS.runSqlite dbFp $
-  flip PS.runSqlPool pool $ do
   select $ do
     addrs <- from $ table @WalletAddress
     where_ (addrs ^. WalletAddressAccId ==. val a)
     where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
     pure addrs
 
-getAddressById ::
+getAddressById :: T.Text -> WalletAddressId -> IO (Maybe (Entity WalletAddress))
-     ConnectionPool -> WalletAddressId -> IO (Maybe (Entity WalletAddress))
+getAddressById dbPath a = do
-getAddressById pool a = do
+  PS.runSqlite dbPath $
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       addr <- from $ table @WalletAddress
       where_ (addr ^. WalletAddressId ==. val a)
@@ -391,12 +365,11 @@ getAddressById pool a = do
 
 -- | Returns a list of change addresses associated with the given account
 getInternalAddresses ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashAccountId -- ^ The account ID to check
-  -> NoLoggingT IO [Entity WalletAddress]
+  -> IO [Entity WalletAddress]
-getInternalAddresses pool a =
+getInternalAddresses dbFp a =
-  PS.retryOnBusy $
+  PS.runSqlite dbFp $
-  flip PS.runSqlPool pool $ do
   select $ do
     addrs <- from $ table @WalletAddress
     where_ (addrs ^. WalletAddressAccId ==. val a)
@@ -405,25 +378,23 @@ getInternalAddresses pool a =
 
 -- | Returns a list of addressess associated with the given wallet
 getWalletAddresses ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashWalletId -- ^ the wallet to search
-  -> NoLoggingT IO [Entity WalletAddress]
+  -> IO [Entity WalletAddress]
-getWalletAddresses pool w = do
+getWalletAddresses dbFp w = do
-  accs <- getAccounts pool w
+  accs <- getAccounts dbFp w
-  addrs <- mapM (getAddresses pool . entityKey) accs
+  addrs <- mapM (getAddresses dbFp . entityKey) accs
   return $ concat addrs
 
 -- | Returns the largest address index for the given account
 getMaxAddress ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> ZcashAccountId -- ^ The account ID to check
   -> Scope -- ^ The scope of the address
   -> IO Int
-getMaxAddress pool aw s = do
+getMaxAddress dbFp aw s = do
   a <-
-    runNoLoggingT $
+    PS.runSqlite dbFp $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       addrs <- from $ table @WalletAddress
       where_ $ addrs ^. WalletAddressAccId ==. val aw
@@ -436,22 +407,19 @@ getMaxAddress pool aw s = do
 
 -- | Save a new address to the database
 saveAddress ::
-     ConnectionPool -- ^ the database path
+     T.Text -- ^ the database path
   -> WalletAddress -- ^ The wallet to add to the database
   -> IO (Maybe (Entity WalletAddress))
-saveAddress pool w =
+saveAddress dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
-  runNoLoggingT $
-  PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
 
 -- | Save a transaction to the data model
 saveTransaction ::
-     ConnectionPool -- ^ the database path
+     T.Text -- ^ the database path
   -> Int -- ^ block time
   -> Transaction -- ^ The transaction to save
-  -> NoLoggingT IO (Key ZcashTransaction)
+  -> IO (Key ZcashTransaction)
-saveTransaction pool t wt =
+saveTransaction dbFp t wt =
-  PS.retryOnBusy $
+  PS.runSqlite dbFp $ do
-  flip PS.runSqlPool pool $ do
     let ix = [0 ..]
     w <-
       insert $
@@ -532,13 +500,11 @@ saveTransaction pool t wt =
 
 -- | Get the transactions from a particular block forward
 getZcashTransactions ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> Int -- ^ Block
   -> IO [Entity ZcashTransaction]
-getZcashTransactions pool b =
+getZcashTransactions dbFp b =
-  runNoLoggingT $
+  PS.runSqlite dbFp $
-  PS.retryOnBusy $
-  flip PS.runSqlPool pool $ do
   select $ do
     txs <- from $ table @ZcashTransaction
     where_ $ txs ^. ZcashTransactionBlock >. val b
@@ -548,13 +514,11 @@ getZcashTransactions pool b =
 -- * Wallet
 -- | Get the block of the last transaction known to the wallet
 getMaxWalletBlock ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> IO Int
-getMaxWalletBlock pool = do
+getMaxWalletBlock dbPath = do
   b <-
-    runNoLoggingT $
+    PS.runSqlite dbPath $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       txs <- from $ table @WalletTransaction
       where_ $ txs ^. WalletTransactionBlock >. val 0
@@ -564,12 +528,10 @@ getMaxWalletBlock pool = do
     Nothing -> return $ -1
     Just x -> return $ walletTransactionBlock $ entityVal x
 
-getMinBirthdayHeight :: ConnectionPool -> IO Int
+getMinBirthdayHeight :: T.Text -> IO Int
-getMinBirthdayHeight pool = do
+getMinBirthdayHeight dbPath = do
   b <-
-    runNoLoggingT $
+    PS.runSqlite dbPath $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       w <- from $ table @ZcashWallet
       where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
@@ -581,15 +543,13 @@ getMinBirthdayHeight pool = do
 
 -- | Save a @WalletTransaction@
 saveWalletTransaction ::
-     ConnectionPool
+     T.Text
   -> ZcashAccountId
   -> Entity ZcashTransaction
   -> IO WalletTransactionId
-saveWalletTransaction pool za zt = do
+saveWalletTransaction dbPath za zt = do
   let zT' = entityVal zt
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     t <-
       upsert
         (WalletTransaction
@@ -603,7 +563,7 @@ saveWalletTransaction pool za zt = do
 
 -- | Save a @WalletSapNote@
 saveWalletSapNote ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> WalletTransactionId -- ^ The index for the transaction that contains the note
   -> Integer -- ^ note position
   -> SaplingWitness -- ^ the Sapling incremental witness
@@ -612,10 +572,8 @@ saveWalletSapNote ::
   -> ShieldOutputId
   -> DecodedNote -- The decoded Sapling note
   -> IO ()
-saveWalletSapNote pool wId pos wit ch za zt dn = do
+saveWalletSapNote dbPath wId pos wit ch za zt dn = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     _ <-
       upsert
         (WalletSapNote
@@ -636,7 +594,7 @@ saveWalletSapNote pool wId pos wit ch za zt dn = do
 
 -- | Save a @WalletOrchNote@
 saveWalletOrchNote ::
-     ConnectionPool
+     T.Text
   -> WalletTransactionId
   -> Integer
   -> OrchardWitness
@@ -645,10 +603,8 @@ saveWalletOrchNote ::
   -> OrchActionId
   -> DecodedNote
   -> IO ()
-saveWalletOrchNote pool wId pos wit ch za zt dn = do
+saveWalletOrchNote dbPath wId pos wit ch za zt dn = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     _ <-
       upsert
         (WalletOrchNote
@@ -670,11 +626,11 @@ saveWalletOrchNote pool wId pos wit ch za zt dn = do
 
 -- | Find the Transparent Notes that match the given transparent receiver
 findTransparentNotes ::
-     ConnectionPool -- ^ The database path
+     T.Text -- ^ The database path
   -> Int -- ^ Starting block
   -> Entity WalletAddress
   -> IO ()
-findTransparentNotes pool b t = do
+findTransparentNotes dbPath b t = do
   let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
   case tReceiver of
     Just tR -> do
@@ -685,9 +641,7 @@ findTransparentNotes pool b t = do
               , BS.pack [0x88, 0xAC]
               ]
       tN <-
-        runNoLoggingT $
+        PS.runSqlite dbPath $
-        PS.retryOnBusy $
-        flip PS.runSqlPool pool $ do
         select $ do
           (txs :& tNotes) <-
             from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
@@ -698,7 +652,7 @@ findTransparentNotes pool b t = do
           pure (txs, tNotes)
       mapM_
         (saveWalletTrNote
-           pool
+           dbPath
            (getScope $ walletAddressScope $ entityVal t)
            (walletAddressAccId $ entityVal t)
            (entityKey t))
@@ -707,17 +661,15 @@ findTransparentNotes pool b t = do
 
 -- | Add the transparent notes to the wallet
 saveWalletTrNote ::
-     ConnectionPool -- ^ the database path
+     T.Text -- ^ the database path
   -> Scope
   -> ZcashAccountId
   -> WalletAddressId
   -> (Entity ZcashTransaction, Entity TransparentNote)
   -> IO ()
-saveWalletTrNote pool ch za wa (zt, tn) = do
+saveWalletTrNote dbPath ch za wa (zt, tn) = do
   let zT' = entityVal zt
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     t <-
       upsert
         (WalletTransaction
@@ -739,19 +691,16 @@ saveWalletTrNote pool ch za wa (zt, tn) = do
         (fromIntegral $ transparentNotePosition $ entityVal tn)
 
 -- | Save a Sapling note to the wallet database
-saveSapNote :: ConnectionPool -> WalletSapNote -> IO ()
+saveSapNote :: T.Text -> WalletSapNote -> IO ()
-saveSapNote pool wsn =
+saveSapNote dbPath wsn = PS.runSqlite dbPath $ do insert_ wsn
-  runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insert_ wsn
 
 -- | Get the shielded outputs from the given blockheight
 getShieldedOutputs ::
-     ConnectionPool -- ^ database path
+     T.Text -- ^ database path
   -> Int -- ^ block
   -> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
-getShieldedOutputs pool b =
+getShieldedOutputs dbPath b =
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-  PS.retryOnBusy $
-  flip PS.runSqlPool pool $ do
     select $ do
       (txs :& sOutputs) <-
         from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
@@ -766,13 +715,11 @@ getShieldedOutputs pool b =
 
 -- | Get the Orchard actions from the given blockheight forward
 getOrchardActions ::
-     ConnectionPool -- ^ database path
+     T.Text -- ^ database path
   -> Int -- ^ block
   -> IO [(Entity ZcashTransaction, Entity OrchAction)]
-getOrchardActions pool b =
+getOrchardActions dbPath b =
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-  PS.retryOnBusy $
-  flip PS.runSqlPool pool $ do
     select $ do
       (txs :& oActions) <-
         from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
@@ -785,12 +732,12 @@ getOrchardActions pool b =
 
 -- | Get the transactions belonging to the given address
 getWalletTransactions ::
-     ConnectionPool -- ^ database path
+     T.Text -- ^ database path
   -> Entity WalletAddress
-  -> NoLoggingT IO ()
+  -> IO ()
-getWalletTransactions pool w = do
+getWalletTransactions dbPath w = do
   let w' = entityVal w
-  chgAddr <- getInternalAddresses pool $ walletAddressAccId $ entityVal w
+  chgAddr <- getInternalAddresses dbPath $ walletAddressAccId $ entityVal w
   let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
   let csReceiver = s_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
   let coReceiver = o_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
@@ -807,8 +754,7 @@ getWalletTransactions pool w = do
                 , (toBytes . tr_bytes) tR
                 , BS.pack [0x88, 0xAC]
                 ]
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-          flip PS.runSqlPool pool $ do
           select $ do
             tnotes <- from $ table @WalletTrNote
             where_ (tnotes ^. WalletTrNoteScript ==. val s)
@@ -823,15 +769,13 @@ getWalletTransactions pool w = do
                 , (toBytes . tr_bytes) tR
                 , BS.pack [0x88, 0xAC]
                 ]
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-          flip PS.runSqlPool pool $ do
           select $ do
             tnotes <- from $ table @WalletTrNote
             where_ (tnotes ^. WalletTrNoteScript ==. val s1)
             pure tnotes
   trSpends <-
-    PS.retryOnBusy $
+    PS.runSqlite dbPath $ do
-    flip PS.runSqlPool pool $ do
       select $ do
         trSpends <- from $ table @WalletTrSpend
         where_
@@ -842,8 +786,7 @@ getWalletTransactions pool w = do
     case sReceiver of
       Nothing -> return []
       Just sR -> do
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-          flip PS.runSqlPool pool $ do
           select $ do
             snotes <- from $ table @WalletSapNote
             where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
@@ -852,8 +795,7 @@ getWalletTransactions pool w = do
     case csReceiver of
       Nothing -> return []
       Just sR -> do
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-          flip PS.runSqlPool pool $ do
           select $ do
             snotes <- from $ table @WalletSapNote
             where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
@@ -863,8 +805,7 @@ getWalletTransactions pool w = do
     case oReceiver of
       Nothing -> return []
       Just oR -> do
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-          flip PS.runSqlPool pool $ do
           select $ do
             onotes <- from $ table @WalletOrchNote
             where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
@@ -873,14 +814,12 @@ getWalletTransactions pool w = do
     case coReceiver of
       Nothing -> return []
       Just oR -> do
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-          flip PS.runSqlPool pool $ do
           select $ do
             onotes <- from $ table @WalletOrchNote
             where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
             pure onotes
   orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
-  clearUserTx (entityKey w)
   mapM_ addTr trNotes
   mapM_ addTr trChgNotes
   mapM_ addSap sapNotes
@@ -891,68 +830,56 @@ getWalletTransactions pool w = do
   mapM_ subSSpend $ catMaybes sapSpends
   mapM_ subOSpend $ catMaybes orchSpends
   where
-    clearUserTx :: WalletAddressId -> NoLoggingT IO ()
+    getSapSpends :: WalletSapNoteId -> IO (Maybe (Entity WalletSapSpend))
-    clearUserTx waId = do
-      PS.retryOnBusy $
-        flip PS.runSqlPool pool $ do
-          delete $ do
-            u <- from $ table @UserTx
-            where_ (u ^. UserTxAddress ==. val waId)
-            return ()
-    getSapSpends ::
-         WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
     getSapSpends n = do
-      PS.retryOnBusy $
+      PS.runSqlite dbPath $ do
-        flip PS.runSqlPool pool $ do
         selectOne $ do
           sapSpends <- from $ table @WalletSapSpend
           where_ (sapSpends ^. WalletSapSpendNote ==. val n)
           pure sapSpends
-    getOrchSpends ::
+    getOrchSpends :: WalletOrchNoteId -> IO (Maybe (Entity WalletOrchSpend))
-         WalletOrchNoteId -> NoLoggingT IO (Maybe (Entity WalletOrchSpend))
     getOrchSpends n = do
-      PS.retryOnBusy $
+      PS.runSqlite dbPath $ do
-        flip PS.runSqlPool pool $ do
         selectOne $ do
           orchSpends <- from $ table @WalletOrchSpend
           where_ (orchSpends ^. WalletOrchSpendNote ==. val n)
           pure orchSpends
-    addTr :: Entity WalletTrNote -> NoLoggingT IO ()
+    addTr :: Entity WalletTrNote -> IO ()
     addTr n =
       upsertUserTx
         (walletTrNoteTx $ entityVal n)
         (entityKey w)
         (fromIntegral $ walletTrNoteValue $ entityVal n)
         ""
-    addSap :: Entity WalletSapNote -> NoLoggingT IO ()
+    addSap :: Entity WalletSapNote -> IO ()
     addSap n =
       upsertUserTx
         (walletSapNoteTx $ entityVal n)
         (entityKey w)
         (fromIntegral $ walletSapNoteValue $ entityVal n)
         (walletSapNoteMemo $ entityVal n)
-    addOrch :: Entity WalletOrchNote -> NoLoggingT IO ()
+    addOrch :: Entity WalletOrchNote -> IO ()
     addOrch n =
       upsertUserTx
         (walletOrchNoteTx $ entityVal n)
         (entityKey w)
         (fromIntegral $ walletOrchNoteValue $ entityVal n)
         (walletOrchNoteMemo $ entityVal n)
-    subTSpend :: Entity WalletTrSpend -> NoLoggingT IO ()
+    subTSpend :: Entity WalletTrSpend -> IO ()
     subTSpend n =
       upsertUserTx
         (walletTrSpendTx $ entityVal n)
         (entityKey w)
         (-(fromIntegral $ walletTrSpendValue $ entityVal n))
         ""
-    subSSpend :: Entity WalletSapSpend -> NoLoggingT IO ()
+    subSSpend :: Entity WalletSapSpend -> IO ()
     subSSpend n =
       upsertUserTx
         (walletSapSpendTx $ entityVal n)
         (entityKey w)
         (-(fromIntegral $ walletSapSpendValue $ entityVal n))
         ""
-    subOSpend :: Entity WalletOrchSpend -> NoLoggingT IO ()
+    subOSpend :: Entity WalletOrchSpend -> IO ()
     subOSpend n =
       upsertUserTx
         (walletOrchSpendTx $ entityVal n)
@@ -960,22 +887,16 @@ getWalletTransactions pool w = do
         (-(fromIntegral $ walletOrchSpendValue $ entityVal n))
         ""
     upsertUserTx ::
-         WalletTransactionId
+         WalletTransactionId -> WalletAddressId -> Int -> T.Text -> IO ()
-      -> WalletAddressId
-      -> Int
-      -> T.Text
-      -> NoLoggingT IO ()
     upsertUserTx tId wId amt memo = do
       tr <-
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-        flip PS.runSqlPool pool $ do
           select $ do
             tx <- from $ table @WalletTransaction
             where_ (tx ^. WalletTransactionId ==. val tId)
             pure tx
       existingUtx <-
-        PS.retryOnBusy $
+        PS.runSqlite dbPath $ do
-        flip PS.runSqlPool pool $ do
           selectOne $ do
             ut <- from $ table @UserTx
             where_
@@ -986,8 +907,7 @@ getWalletTransactions pool w = do
       case existingUtx of
         Nothing -> do
           _ <-
-            PS.retryOnBusy $
+            PS.runSqlite dbPath $ do
-            flip PS.runSqlPool pool $ do
               upsert
                 (UserTx
                    (walletTransactionTxId $ entityVal $ head tr)
@@ -999,8 +919,7 @@ getWalletTransactions pool w = do
           return ()
         Just uTx -> do
           _ <-
-            PS.retryOnBusy $
+            PS.runSqlite dbPath $ do
-            flip PS.runSqlPool pool $ do
               update $ \t -> do
                 set
                   t
@@ -1011,40 +930,33 @@ getWalletTransactions pool w = do
                 where_ (t ^. UserTxId ==. val (entityKey uTx))
           return ()
 
-getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx]
+getUserTx :: T.Text -> WalletAddressId -> IO [Entity UserTx]
-getUserTx pool aId = do
+getUserTx dbPath aId = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       uTxs <- from $ table @UserTx
       where_ (uTxs ^. UserTxAddress ==. val aId)
-        orderBy [asc $ uTxs ^. UserTxTime]
       return uTxs
 
 -- | Get wallet transparent notes by account
-getWalletTrNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
+getWalletTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
-getWalletTrNotes pool za = do
+getWalletTrNotes dbPath za = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n <- from $ table @WalletTrNote
       where_ (n ^. WalletTrNoteAccId ==. val za)
       pure n
 
 -- | find Transparent spends
-findTransparentSpends :: ConnectionPool -> ZcashAccountId -> IO ()
+findTransparentSpends :: T.Text -> ZcashAccountId -> IO ()
-findTransparentSpends pool za = do
+findTransparentSpends dbPath za = do
-  notes <- getWalletTrNotes pool za
+  notes <- getWalletTrNotes dbPath za
   mapM_ findOneTrSpend notes
   where
     findOneTrSpend :: Entity WalletTrNote -> IO ()
     findOneTrSpend n = do
       mReverseTxId <-
-        runNoLoggingT $
+        PS.runSqlite dbPath $ do
-        PS.retryOnBusy $
-        flip PS.runSqlPool pool $ do
           selectOne $ do
             wtx <- from $ table @WalletTransaction
             where_
@@ -1057,9 +969,7 @@ findTransparentSpends pool za = do
                 HexStringDB $
                 HexString $ BS.reverse $ toBytes $ getHex reverseTxId
           s <-
-            runNoLoggingT $
+            PS.runSqlite dbPath $ do
-            PS.retryOnBusy $
-            flip PS.runSqlPool pool $ do
               select $ do
                 (tx :& trSpends) <-
                   from $
@@ -1075,9 +985,7 @@ findTransparentSpends pool za = do
           if null s
             then return ()
             else do
-              runNoLoggingT $
+              PS.runSqlite dbPath $ do
-                PS.retryOnBusy $
-                flip PS.runSqlPool pool $ do
                 _ <-
                   update $ \w -> do
                     set w [WalletTrNoteSpent =. val True]
@@ -1090,26 +998,20 @@ findTransparentSpends pool za = do
                     za
                     (walletTrNoteValue $ entityVal n)
 
-getWalletSapNotes ::
+getWalletSapNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
-     ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
+getWalletSapNotes dbPath za = do
-getWalletSapNotes pool za = do
+  PS.runSqlite dbPath $ do
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n <- from $ table @WalletSapNote
       where_ (n ^. WalletSapNoteAccId ==. val za)
       pure n
 
 -- | Sapling DAG-aware spend tracking
-findSapSpends ::
+findSapSpends :: T.Text -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
-     ConnectionPool -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
 findSapSpends _ _ [] = return ()
-findSapSpends pool za (n:notes) = do
+findSapSpends dbPath za (n:notes) = do
   s <-
-    runNoLoggingT $
+    PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
       select $ do
         (tx :& sapSpends) <-
           from $ table @ZcashTransaction `innerJoin` table @ShieldSpend `on`
@@ -1120,11 +1022,9 @@ findSapSpends pool za (n:notes) = do
            val (walletSapNoteNullifier (entityVal n)))
         pure (tx, sapSpends)
   if null s
-    then findSapSpends pool za notes
+    then findSapSpends dbPath za notes
     else do
-      runNoLoggingT $
+      PS.runSqlite dbPath $ do
-        PS.retryOnBusy $
-        flip PS.runSqlPool pool $ do
         _ <-
           update $ \w -> do
             set w [WalletSapNoteSpent =. val True]
@@ -1136,24 +1036,19 @@ findSapSpends pool za (n:notes) = do
             (entityKey n)
             za
             (walletSapNoteValue $ entityVal n)
-      findSapSpends pool za notes
+      findSapSpends dbPath za notes
 
-getWalletOrchNotes ::
+getWalletOrchNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
-     ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
+getWalletOrchNotes dbPath za = do
-getWalletOrchNotes pool za = do
+  PS.runSqlite dbPath $ do
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n <- from $ table @WalletOrchNote
       where_ (n ^. WalletOrchNoteAccId ==. val za)
       pure n
 
-getUnspentSapNotes :: ConnectionPool -> IO [Entity WalletSapNote]
+getUnspentSapNotes :: T.Text -> IO [Entity WalletSapNote]
-getUnspentSapNotes pool = do
+getUnspentSapNotes dbPath = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n <- from $ table @WalletSapNote
       where_ (n ^. WalletSapNoteSpent ==. val False)
@@ -1198,11 +1093,9 @@ updateSapNoteRecord pool n w o = do
         ]
       where_ (x ^. WalletSapNoteId ==. val n)
 
-getUnspentOrchNotes :: ConnectionPool -> IO [Entity WalletOrchNote]
+getUnspentOrchNotes :: T.Text -> IO [Entity WalletOrchNote]
-getUnspentOrchNotes pool = do
+getUnspentOrchNotes dbPath = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n <- from $ table @WalletOrchNote
       where_ (n ^. WalletOrchNoteSpent ==. val False)
@@ -1247,14 +1140,11 @@ updateOrchNoteRecord pool n w o = do
         ]
       where_ (x ^. WalletOrchNoteId ==. val n)
 
-findOrchSpends ::
+findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
-     ConnectionPool -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
 findOrchSpends _ _ [] = return ()
-findOrchSpends pool za (n:notes) = do
+findOrchSpends dbPath za (n:notes) = do
   s <-
-    runNoLoggingT $
+    PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
       select $ do
         (tx :& orchSpends) <-
           from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
@@ -1265,11 +1155,9 @@ findOrchSpends pool za (n:notes) = do
            val (walletOrchNoteNullifier (entityVal n)))
         pure (tx, orchSpends)
   if null s
-    then findOrchSpends pool za notes
+    then findOrchSpends dbPath za notes
     else do
-      runNoLoggingT $
+      PS.runSqlite dbPath $ do
-        PS.retryOnBusy $
-        flip PS.runSqlPool pool $ do
         _ <-
           update $ \w -> do
             set w [WalletOrchNoteSpent =. val True]
@@ -1281,7 +1169,7 @@ findOrchSpends pool za (n:notes) = do
             (entityKey n)
             za
             (walletOrchNoteValue $ entityVal n)
-      findOrchSpends pool za notes
+      findOrchSpends dbPath za notes
 
 upsertWalTx ::
      MonadIO m
@@ -1298,24 +1186,22 @@ upsertWalTx zt za =
        (zcashTransactionTime zt))
     []
 
-getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
+getBalance :: T.Text -> ZcashAccountId -> IO Integer
-getBalance pool za = do
+getBalance dbPath za = do
-  trNotes <- getWalletUnspentTrNotes pool za
+  trNotes <- getWalletUnspentTrNotes dbPath za
   let tAmts = map (walletTrNoteValue . entityVal) trNotes
   let tBal = sum tAmts
-  sapNotes <- getWalletUnspentSapNotes pool za
+  sapNotes <- getWalletUnspentSapNotes dbPath za
   let sAmts = map (walletSapNoteValue . entityVal) sapNotes
   let sBal = sum sAmts
-  orchNotes <- getWalletUnspentOrchNotes pool za
+  orchNotes <- getWalletUnspentOrchNotes dbPath za
   let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
   let oBal = sum oAmts
   return . fromIntegral $ tBal + sBal + oBal
 
-clearWalletTransactions :: ConnectionPool -> IO ()
+clearWalletTransactions :: T.Text -> IO ()
-clearWalletTransactions pool = do
+clearWalletTransactions dbPath = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     delete $ do
       _ <- from $ table @WalletOrchSpend
       return ()
@@ -1341,12 +1227,9 @@ clearWalletTransactions pool = do
       _ <- from $ table @UserTx
       return ()
 
-getWalletUnspentTrNotes ::
+getWalletUnspentTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
-     ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
+getWalletUnspentTrNotes dbPath za = do
-getWalletUnspentTrNotes pool za = do
+  PS.runSqlite dbPath $ do
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n <- from $ table @WalletTrNote
       where_ (n ^. WalletTrNoteAccId ==. val za)
@@ -1354,11 +1237,9 @@ getWalletUnspentTrNotes pool za = do
       pure n
 
 getWalletUnspentSapNotes ::
-     ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
+     T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
-getWalletUnspentSapNotes pool za = do
+getWalletUnspentSapNotes dbPath za = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n1 <- from $ table @WalletSapNote
       where_ (n1 ^. WalletSapNoteAccId ==. val za)
@@ -1366,11 +1247,9 @@ getWalletUnspentSapNotes pool za = do
       pure n1
 
 getWalletUnspentOrchNotes ::
-     ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
+     T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
-getWalletUnspentOrchNotes pool za = do
+getWalletUnspentOrchNotes dbPath za = do
-  runNoLoggingT $
+  PS.runSqlite dbPath $ do
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     select $ do
       n2 <- from $ table @WalletOrchNote
       where_ (n2 ^. WalletOrchNoteAccId ==. val za)
@@ -1378,20 +1257,20 @@ getWalletUnspentOrchNotes pool za = do
       pure n2
 
 selectUnspentNotes ::
-     ConnectionPool
+     T.Text
   -> ZcashAccountId
   -> Integer
   -> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-selectUnspentNotes pool za amt = do
+selectUnspentNotes dbPath za amt = do
-  trNotes <- getWalletUnspentTrNotes pool za
+  trNotes <- getWalletUnspentTrNotes dbPath za
   let (a1, tList) = checkTransparent (fromIntegral amt) trNotes
   if a1 > 0
     then do
-      sapNotes <- getWalletUnspentSapNotes pool za
+      sapNotes <- getWalletUnspentSapNotes dbPath za
       let (a2, sList) = checkSapling a1 sapNotes
       if a2 > 0
         then do
-          orchNotes <- getWalletUnspentOrchNotes pool za
+          orchNotes <- getWalletUnspentOrchNotes dbPath za
           let (a3, oList) = checkOrchard a2 orchNotes
           if a3 > 0
             then throwIO $ userError "Not enough funds"
@@ -1425,12 +1304,9 @@ selectUnspentNotes pool za amt = do
              , n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
         else (0, [n])
 
-getWalletTxId ::
+getWalletTxId :: T.Text -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
-     ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
+getWalletTxId dbPath wId = do
-getWalletTxId pool wId = do
+  PS.runSqlite dbPath $ do
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
     selectOne $ do
       wtx <- from $ table @WalletTransaction
       where_ (wtx ^. WalletTransactionId ==. val wId)

src/Zenith/Scanner.hs

@@ -3,23 +3,11 @@
 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(..)
@@ -42,77 +30,64 @@ scanZebra ::
   -> T.Text -- ^ Host
   -> Int -- ^ Port
   -> T.Text -- ^ Path to database file
-  -> NoLoggingT IO ()
+  -> IO ()
 scanZebra b host port dbFilePath = do
-  _ <- liftIO $ initDb dbFilePath
+  _ <- initDb dbFilePath
-  startTime <- liftIO getCurrentTime
-  logInfoN $ "Started sync: " <> T.pack (show startTime)
   bc <-
-    liftIO $ try $ checkBlockChain host port :: NoLoggingT
+    try $ checkBlockChain host port :: IO
-      IO
       (Either IOError ZebraGetBlockChainInfo)
   case bc of
-    Left e -> logErrorN $ T.pack (show e)
+    Left e -> print e
     Right bStatus -> do
-      let dbInfo =
+      dbBlock <- getMaxBlock dbFilePath
-            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 liftIO $ throwIO $ userError "Invalid starting block for scan"
+        then throwIO $ userError "Invalid starting block for scan"
         else do
-          liftIO $
           print $
             "Scanning from " ++
             show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
           let bList = [(sb + 1) .. (zgb_blocks bStatus)]
           displayConsoleRegions $ do
-            pg <-
+            pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
-              liftIO $
-              newProgressBar def {pgTotal = fromIntegral $ length bList}
             txList <-
-              CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
+              try $ mapM_ (processBlock host port dbFilePath pg) bList :: IO
-                IO
                 (Either IOError ())
             case txList of
-              Left e1 -> logErrorN $ T.pack (show e1)
+              Left e1 -> print e1
-              Right txList' -> logInfoN "Finished scan"
+              Right txList' -> print txList'
 
 -- | Function to process a raw block and extract the transaction information
 processBlock ::
      T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
-  -> ConnectionPool -- ^ DB file path
+  -> T.Text -- ^ DB file path
   -> ProgressBar -- ^ Progress bar
   -> Int -- ^ The block number to process
-  -> NoLoggingT IO ()
+  -> IO ()
-processBlock host port pool pg b = do
+processBlock host port dbFp pg b = do
   r <-
-    liftIO $
     makeZebraCall
       host
       port
       "getblock"
       [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
   case r of
-    Left e -> liftIO $ throwIO $ userError e
+    Left e -> 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 -> liftIO $ throwIO $ userError e2
+        Left e2 -> throwIO $ userError e2
         Right hb -> do
           let blockTime = getBlockTime hb
-          mapM_ (processTx host port blockTime pool) $
+          mapM_ (processTx host port blockTime dbFp) $
             bl_txs $ addTime blk blockTime
-          liftIO $ tick pg
+          tick pg
   where
     addTime :: BlockResponse -> Int -> BlockResponse
     addTime bl t =
@@ -127,25 +102,24 @@ processTx ::
      T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
   -> Int -- ^ Block time
-  -> ConnectionPool -- ^ DB file path
+  -> T.Text -- ^ DB file path
   -> HexString -- ^ transaction id
-  -> NoLoggingT IO ()
+  -> IO ()
-processTx host port bt pool t = do
+processTx host port bt dbFp t = do
   r <-
-    liftIO $
     makeZebraCall
       host
       port
       "getrawtransaction"
       [Data.Aeson.String $ toText t, jsonNumber 1]
   case r of
-    Left e -> liftIO $ throwIO $ userError e
+    Left e -> throwIO $ userError e
     Right rawTx -> do
       case readZebraTransaction (ztr_hex rawTx) of
         Nothing -> return ()
         Just rzt -> do
           _ <-
-            saveTransaction pool bt $
+            saveTransaction dbFp bt $
             Transaction
               t
               (ztr_blockheight rawTx)

zenith.cabal

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