CHANGELOG.md

@@ -24,8 +24,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 ### Changed
 
 - Detection of changes in database schema for automatic re-scan
-- Block tracking for chain re-org detection
-- Refactored `ZcashPool`
 
 ## [0.6.0.0-beta]
 

app/Main.hs

@@ -230,7 +230,6 @@ main = do
         "gui" -> runZenithGUI myConfig
         "tui" -> runZenithTUI myConfig
         "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
-        "resync" -> clearSync myConfig
         _ -> printUsage
     else printUsage
 

src/Zenith/CLI.hs

@@ -62,14 +62,9 @@ import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.ProgressBar as P
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (throw, throwIO, try)
-import Control.Monad (forever, unless, void, when)
+import Control.Monad (forever, void, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger
+import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
-  ( LoggingT
-  , logDebugN
-  , runFileLoggingT
-  , runNoLoggingT
-  )
 import Data.Aeson
 import Data.HexString (HexString(..), toText)
 import Data.Maybe
@@ -94,10 +89,9 @@ import ZcashHaskell.Types
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
-import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
+import Zenith.Scanner (processTx, rescanZebra, updateConfs)
 import Zenith.Types
   ( Config(..)
-  , HexStringDB(..)
   , PhraseDB(..)
   , UnifiedAddressDB(..)
   , ZcashNetDB(..)
@@ -108,7 +102,7 @@ import Zenith.Utils
   , displayZec
   , isRecipientValid
   , jsonNumber
-  , parseAddressUA
+  , parseAddress
   , showAddress
   , validBarValue
   )
@@ -618,16 +612,16 @@ mkInputForm =
 mkSendForm :: Integer -> SendInput -> Form SendInput e Name
 mkSendForm bal =
   newForm
-    [ label "Privacy Level :" @@=
+    [ label "To:     " @@= editTextField sendTo RecField (Just 1)
-       radioField policyField [ (Full, PrivacyFullField, "Full")
-                         , (Medium, PrivacyMediumField, "Medium")
-                         , (Low, PrivacyLowField, "Low")
-                         , (None, PrivacyNoneField, "None")
-                         ]
-    , label "To:     " @@= editTextField sendTo RecField (Just 1)
     , label "Amount: " @@=
       editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
     , label "Memo:   " @@= editTextField sendMemo MemoField (Just 1)
+    , label "Privacy Level :" @@=
+       radioField policyField [ (None, PrivacyNoneField, "None")
+                         , (Low, PrivacyLowField, "Low")
+                         , (Medium, PrivacyMediumField, "Medium")
+                         , (Full, PrivacyFullField, "Full")
+                         ]
     ]
   where
     isAmountValid :: Integer -> Float -> Bool
@@ -737,42 +731,31 @@ abMBarAttr :: A.AttrName
 abMBarAttr = A.attrName "menubar"
 
 scanZebra ::
-     T.Text
+     T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
-  -> T.Text
-  -> Int
-  -> Int
-  -> BC.BChan Tick
-  -> ZcashNet
-  -> LoggingT IO ()
 scanZebra dbP zHost zPort b eChan znet = do
   bStatus <- liftIO $ checkBlockChain zHost zPort
-  pool <- liftIO $ runNoLoggingT $ initPool dbP
+  pool <- runNoLoggingT $ initPool dbP
-  dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet
+  dbBlock <- getMaxBlock pool $ ZcashNetDB znet
-  chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1
+  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
-  logDebugN $
-    "dbBlock: " <>
-    T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
-  let sb = max dbBlock b
-  if sb > zgb_blocks bStatus || sb < 1
-    then do
-      liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
-    else do
-      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-      if not (null bList)
-        then do
-          let step =
-                (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
-          mapM_ (liftIO . processBlock pool step) bList
-        else liftIO $ BC.writeBChan eChan $ TickVal 1.0
-  confUp <-
-    liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
-      IO
-      (Either IOError ())
   case confUp of
     Left _e0 ->
       liftIO $
       BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
-    Right _ -> return ()
+    Right _ -> do
+      let sb = max dbBlock b
+      if sb > zgb_blocks bStatus || sb < 1
+        then do
+          liftIO $
+            BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
+        else do
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+          if not (null bList)
+            then do
+              let step =
+                    (1.0 :: Float) /
+                    fromIntegral (zgb_blocks bStatus - (sb + 1))
+              mapM_ (processBlock pool step) bList
+            else liftIO $ BC.writeBChan eChan $ TickVal 1.0
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -797,16 +780,16 @@ scanZebra dbP zHost zPort b eChan znet = do
             Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
             Right hb -> do
               let blockTime = getBlockTime hb
-              bi <-
+              mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
-                saveBlock pool $
+                bl_txs $ addTime blk blockTime
-                ZcashBlock
-                  (fromIntegral $ bl_height blk)
-                  (HexStringDB $ bl_hash blk)
-                  (fromIntegral $ bl_confirmations blk)
-                  blockTime
-                  (ZcashNetDB znet)
-              mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
               liftIO $ BC.writeBChan eChan $ TickVal step
+    addTime :: BlockResponse -> Int -> BlockResponse
+    addTime bl t =
+      BlockResponse
+        (bl_confirmations bl)
+        (bl_height bl)
+        (fromIntegral t)
+        (bl_txs bl)
 
 appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
 appEvent (BT.AppEvent t) = do
@@ -851,7 +834,6 @@ appEvent (BT.AppEvent t) = do
                      Just (_k, w) -> return w
               _ <-
                 liftIO $
-                runFileLoggingT "zenith.log" $
                 syncWallet
                   (Config
                      (s ^. dbPath)
@@ -888,7 +870,6 @@ appEvent (BT.AppEvent t) = do
                   _ <-
                     liftIO $
                     forkIO $
-                    runFileLoggingT "zenith.log" $
                     scanZebra
                       (s ^. dbPath)
                       (s ^. zebraHost)
@@ -1160,7 +1141,7 @@ appEvent (BT.VtyEvent e) = do
                                     (addressBookAbaddress (entityVal a))
                                     0.0
                                     ""
-                                    Full)
+                                    None)
                              BT.modify $ set dialogBox SendTx
                            _ -> do
                              BT.modify $
@@ -1332,7 +1313,7 @@ appEvent (BT.VtyEvent e) = do
                        V.EvKey (V.KChar 's') [] -> do
                          BT.modify $
                            set txForm $
-                           mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
+                           mkSendForm (s ^. balance) (SendInput "" 0.0 "" None)
                          BT.modify $ set dialogBox SendTx
                        V.EvKey (V.KChar 'b') [] ->
                          BT.modify $ set dialogBox AdrBook
@@ -1467,7 +1448,7 @@ runZenithTUI config = do
                   1.0
                   eventChan
                   0
-                  (mkSendForm 0 $ SendInput "" 0.0 "" Full)
+                  (mkSendForm 0 $ SendInput "" 0.0 "" None)
                   (L.list ABList (Vec.fromList abookList) 1)
                   (mkNewABForm (AdrBookEntry "" ""))
                   ""
@@ -1689,7 +1670,7 @@ sendTransaction ::
   -> IO ()
 sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
   BC.writeBChan chan $ TickMsg "Preparing transaction..."
-  case parseAddressUA ua znet of
+  case parseAddress ua znet of
     Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
     Just outUA -> do
       res <-

src/Zenith/Core.hs

@@ -772,254 +772,98 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
       {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
       --let fee = calculateTxFee firstPass $ fst recipient
       --logDebugN $ T.pack $ "calculated fee " ++ show fee
-      notePlan <-
+      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
+      logDebugN "selected notes"
+      logDebugN $ T.pack $ show tList
+      logDebugN $ T.pack $ show sList
+      logDebugN $ T.pack $ show oList
+      let noteTotal = getTotalAmount (tList, sList, oList)
+      tSpends <-
         liftIO $
-        selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
+        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
-      case notePlan of
+      --print tSpends
-        Right (tList, sList, oList) -> do
+      sSpends <-
-          logDebugN "selected notes"
+        liftIO $
+        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
+      --print sSpends
+      oSpends <-
+        liftIO $
+        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
+      --print oSpends
+      dummy <-
+        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
+      logDebugN "Calculating fee"
+      let feeResponse =
+            createTransaction
+              (Just sT)
+              (Just oT)
+              tSpends
+              sSpends
+              oSpends
+              dummy
+              zn
+              (bh + 3)
+              False
+      case feeResponse of
+        Left e1 -> return $ Left Fee
+        Right fee -> do
+          let feeAmt =
+                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+          (tList1, sList1, oList1) <-
+            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
+          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
           logDebugN $ T.pack $ show tList
           logDebugN $ T.pack $ show sList
           logDebugN $ T.pack $ show oList
-          let noteTotal = getTotalAmount (tList, sList, oList)
+          outgoing <-
-          tSpends <-
+            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
-            liftIO $
+          logDebugN $ T.pack $ show outgoing
-            prepTSpends
+          let tx =
-              (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
+                createTransaction
-              tList
+                  (Just sT)
-            --print tSpends
+                  (Just oT)
-          sSpends <-
+                  tSpends
-            liftIO $
+                  sSpends
-            prepSSpends
+                  oSpends
-              (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
+                  outgoing
-              sList
+                  zn
-            --print sSpends
+                  (bh + 3)
-          oSpends <-
+                  True
-            liftIO $
+          logDebugN $ T.pack $ show tx
-            prepOSpends
+          return tx
-              (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-              oList
-            --print oSpends
-          dummy' <-
-            liftIO $
-            makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
-          case dummy' of
-            Left e -> return $ Left e
-            Right dummy -> do
-              logDebugN "Calculating fee"
-              let feeResponse =
-                    createTransaction
-                      (Just sT)
-                      (Just oT)
-                      tSpends
-                      sSpends
-                      oSpends
-                      dummy
-                      zn
-                      (bh + 3)
-                      False
-              case feeResponse of
-                Left e1 -> return $ Left Fee
-                Right fee -> do
-                  let feeAmt =
-                        fromIntegral
-                          (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
-                  finalNotePlan <-
-                    liftIO $
-                    selectUnspentNotesV2
-                      pool
-                      za
-                      (zats + feeAmt)
-                      (fst recipient)
-                      policy
-                  case finalNotePlan of
-                    Right (tList1, sList1, oList1) -> do
-                      logDebugN $
-                        T.pack $ "selected notes with fee" ++ show feeAmt
-                      logDebugN $ T.pack $ show tList1
-                      logDebugN $ T.pack $ show sList1
-                      logDebugN $ T.pack $ show oList1
-                      tSpends1 <-
-                        liftIO $
-                        prepTSpends
-                          (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
-                          tList1
-                      sSpends1 <-
-                        liftIO $
-                        prepSSpends
-                          (getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                          sList1
-                      oSpends1 <-
-                        liftIO $
-                        prepOSpends
-                          (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-                          oList1
-                      let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
-                      outgoing' <-
-                        liftIO $
-                        makeOutgoing
-                          acc
-                          recipient
-                          zats
-                          (noteTotal1 - feeAmt - zats)
-                          policy
-                      logDebugN $ T.pack $ show outgoing'
-                      case outgoing' of
-                        Left e -> return $ Left e
-                        Right outgoing -> do
-                          let tx =
-                                createTransaction
-                                  (Just sT)
-                                  (Just oT)
-                                  tSpends1
-                                  sSpends1
-                                  oSpends1
-                                  outgoing
-                                  zn
-                                  (bh + 3)
-                                  True
-                          logDebugN $ T.pack $ show tx
-                          return tx
-                    Left e -> return $ Left e
-        Left e -> do
-          logErrorN $ T.pack $ show e
-          return $ Left e
   where
     makeOutgoing ::
          Entity ZcashAccount
       -> (Int, BS.ByteString)
       -> Integer
       -> Integer
-      -> PrivacyPolicy
+      -> IO [OutgoingNote]
-      -> IO (Either TxError [OutgoingNote])
+    makeOutgoing acc (k, recvr) zats chg = do
-    makeOutgoing acc (k, recvr) zats chg policy = do
       chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
       let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
-      case k of
+      let chgRcvr =
-        4 ->
+            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-          case policy of
+      return
-            None ->
+        [ OutgoingNote
-              return $
+            4
-              Left $
+            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-              PrivacyPolicyError "Recipient not allowed by privacy policy"
+            (getBytes chgRcvr)
-            _anyOther -> do
+            (fromIntegral chg)
-              let chgRcvr =
+            ""
-                    fromJust $
+            True
-                    o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+        , OutgoingNote
-              return $
+            (fromIntegral k)
-                Right
+            (case k of
-                  [ OutgoingNote
+               4 ->
-                      4
+                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
-                      (getBytes $
+               3 ->
-                       getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
-                      (getBytes chgRcvr)
+               _ -> "")
-                      (fromIntegral chg)
+            recvr
-                      ""
+            (fromIntegral zats)
-                      True
+            (E.encodeUtf8 memo)
-                  , OutgoingNote
+            False
-                      4
+        ]
-                      (getBytes $
-                       getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-                      recvr
-                      (fromIntegral zats)
-                      (E.encodeUtf8 memo)
-                      False
-                  ]
-        3 ->
-          case policy of
-            None ->
-              return $
-              Left $
-              PrivacyPolicyError "Receiver not compatible with privacy policy"
-            Full -> do
-              let chgRcvr =
-                    fromJust $
-                    s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
-                Right
-                  [ OutgoingNote
-                      3
-                      (getBytes $
-                       getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                      (getBytes chgRcvr)
-                      (fromIntegral chg)
-                      ""
-                      True
-                  , OutgoingNote
-                      3
-                      (getBytes $
-                       getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                      recvr
-                      (fromIntegral zats)
-                      (E.encodeUtf8 memo)
-                      False
-                  ]
-            _anyOther -> do
-              let chgRcvr =
-                    fromJust $
-                    o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
-                Right
-                  [ OutgoingNote
-                      4
-                      (getBytes $
-                       getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
-                      (getBytes chgRcvr)
-                      (fromIntegral chg)
-                      ""
-                      True
-                  , OutgoingNote
-                      3
-                      (getBytes $
-                       getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
-                      recvr
-                      (fromIntegral zats)
-                      (E.encodeUtf8 memo)
-                      False
-                  ]
-        2 ->
-          if policy <= Low
-            then do
-              let chgRcvr =
-                    fromJust $
-                    t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
-                Right
-                  [ OutgoingNote
-                      1
-                      BS.empty
-                      (toBytes $ tr_bytes chgRcvr)
-                      (fromIntegral chg)
-                      ""
-                      True
-                  , OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
-                  ]
-            else return $
-                 Left $
-                 PrivacyPolicyError
-                   "Receiver not compatible with privacy policy"
-        1 ->
-          if policy <= Low
-            then do
-              let chgRcvr =
-                    fromJust $
-                    t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
-              return $
-                Right
-                  [ OutgoingNote
-                      1
-                      BS.empty
-                      (toBytes $ tr_bytes chgRcvr)
-                      (fromIntegral chg)
-                      ""
-                      True
-                  , OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
-                  ]
-            else return $
-                 Left $
-                 PrivacyPolicyError
-                   "Receiver not compatible with privacy policy"
-        _anyOther -> return $ Left ZHError
     getTotalAmount ::
          ( [Entity WalletTrNote]
          , [Entity WalletSapNote]
@@ -1107,30 +951,22 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
 syncWallet ::
      Config -- ^ configuration parameters
   -> Entity ZcashWallet
-  -> LoggingT IO ()
+  -> IO ()
 syncWallet config w = do
   startTime <- liftIO getCurrentTime
   let walletDb = c_dbPath config
   let znet = zcashWalletNetwork $ entityVal w
-  pool <- liftIO $ runNoLoggingT $ initPool walletDb
+  pool <- runNoLoggingT $ initPool walletDb
-  accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w
+  accs <- runNoLoggingT $ getAccounts pool $ entityKey w
-  logDebugN $ "Accounts: " <> T.pack (show accs)
+  addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
-  addrs <-
-    concat <$>
-    mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
-  logDebugN $ "addrs: " <> T.pack (show addrs)
   intAddrs <-
-    concat <$>
+    concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
-    mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs
+  chainTip <- getMaxBlock pool znet
-  chainTip <- liftIO $ getMaxBlock pool znet
-  logDebugN $ "chain tip: " <> T.pack (show chainTip)
   let lastBlock = zcashWalletLastSync $ entityVal w
-  logDebugN $ "last block: " <> T.pack (show lastBlock)
   let startBlock =
         if lastBlock > 0
           then lastBlock
           else zcashWalletBirthdayHeight $ entityVal w
-  logDebugN $ "start block: " <> T.pack (show startBlock)
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
   mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
   mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
@@ -1144,7 +980,7 @@ syncWallet config w = do
     mapM
       (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
       accs
-  _ <- liftIO $ updateSaplingWitnesses pool
+  _ <- updateSaplingWitnesses pool
-  _ <- liftIO $ updateOrchardWitnesses pool
+  _ <- updateOrchardWitnesses pool
   _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
-  mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs
+  mapM_ (runNoLoggingT . getWalletTransactions pool) addrs

src/Zenith/DB.hs

@@ -18,7 +18,7 @@
 
 module Zenith.DB where
 
-import Control.Exception (SomeException(..), throw, throwIO, try)
+import Control.Exception (SomeException(..), throwIO, try)
 import Control.Monad (when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
@@ -69,7 +69,6 @@ import ZcashHaskell.Types
   , TransparentAddress(..)
   , TransparentBundle(..)
   , TransparentReceiver(..)
-  , TxError(..)
   , UnifiedAddress(..)
   , ValidAddress(..)
   , ZcashNet(..)
@@ -79,7 +78,6 @@ import Zenith.Types
   , HexStringDB(..)
   , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
-  , PrivacyPolicy(..)
   , RseedDB(..)
   , SaplingSpendingKeyDB(..)
   , ScopeDB(..)
@@ -204,28 +202,23 @@ share
     value Int64
     UniqueOrchSpend tx accId
     deriving Show Eq
-  ZcashBlock
+  ZcashTransaction
-    height Int
+    block Int
-    hash HexStringDB
+    txId HexStringDB
     conf Int
     time Int
     network ZcashNetDB
-    UniqueBlock height network
+    UniqueTx block txId network
-    deriving Show Eq
-  ZcashTransaction
-    blockId ZcashBlockId OnDeleteCascade OnUpdateCascade
-    txId HexStringDB
-    UniqueTx blockId txId
     deriving Show Eq
   TransparentNote
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     value Int64
     script BS.ByteString
     position Int
     UniqueTNPos tx position
     deriving Show Eq
   TransparentSpend
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     outPointHash HexStringDB
     outPointIndex Word64
     script BS.ByteString
@@ -234,7 +227,7 @@ share
     UniqueTSPos tx position
     deriving Show Eq
   OrchAction
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     nf HexStringDB
     rk HexStringDB
     cmx HexStringDB
@@ -247,7 +240,7 @@ share
     UniqueOAPos tx position
     deriving Show Eq
   ShieldOutput
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     cv HexStringDB
     cmu HexStringDB
     ephKey HexStringDB
@@ -258,7 +251,7 @@ share
     UniqueSOPos tx position
     deriving Show Eq
   ShieldSpend
-    tx ZcashTransactionId OnDeleteCascade OnUpdateCascade
+    tx ZcashTransactionId
     cv HexStringDB
     anchor HexStringDB
     nullifier HexStringDB
@@ -347,7 +340,7 @@ trToZcashNoteAPI pool n = do
       return $
         ZcashNoteAPI
           (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
-          Zenith.Types.TransparentPool -- pool
+          Zenith.Types.Transparent -- pool
           (fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
           (walletTrNoteValue $ entityVal n) -- zats
           "" -- memo
@@ -368,7 +361,7 @@ sapToZcashNoteAPI pool n = do
       return $
         ZcashNoteAPI
           (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
-          Zenith.Types.SaplingPool -- pool
+          Zenith.Types.Sapling -- pool
           (fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
           (walletSapNoteValue $ entityVal n) -- zats
           (walletSapNoteMemo $ entityVal n) -- memo
@@ -389,7 +382,7 @@ orchToZcashNoteAPI pool n = do
       return $
         ZcashNoteAPI
           (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
-          OrchardPool
+          Orchard
           (fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
           (walletOrchNoteValue $ entityVal n) -- zats
           (walletOrchNoteMemo $ entityVal n) -- memo
@@ -444,10 +437,10 @@ initDb dbName = do
       clearWalletTransactions pool
       clearWalletData pool
       m <-
-        try $ PS.runSqlite dbName $ runMigrationUnsafeQuiet migrateAll :: IO
+        try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
           (Either SomeException [T.Text])
       case m of
-        Left e2 -> return $ Left $ "Failed to migrate data tables" ++ show e2
+        Left _e2 -> return $ Left "Failed to migrate data tables"
         Right _ -> return $ Right True
     Right _ -> return $ Right False
 
@@ -586,13 +579,14 @@ getMaxBlock pool net = do
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
       selectOne $ do
-        bls <- from $ table @ZcashBlock
+        txs <- from $ table @ZcashTransaction
-        where_ (bls ^. ZcashBlockNetwork ==. val net)
+        where_ (txs ^. ZcashTransactionBlock >. val 0)
-        orderBy [desc $ bls ^. ZcashBlockHeight]
+        where_ (txs ^. ZcashTransactionNetwork ==. val net)
-        pure bls
+        orderBy [desc $ txs ^. ZcashTransactionBlock]
+        pure txs
   case b of
     Nothing -> return $ -1
-    Just x -> return $ zcashBlockHeight $ entityVal x
+    Just x -> return $ zcashTransactionBlock $ entityVal x
 
 -- | Returns a list of addresses associated with the given account
 getAddresses ::
@@ -683,33 +677,20 @@ saveAddress pool w =
   runNoLoggingT $
   PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
 
--- | Save a block to the database
-saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
-saveBlock pool b =
-  runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
-
--- | Read a block by height
-getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
-getBlock pool b =
-  runNoLoggingT $
-  PS.retryOnBusy $
-  flip PS.runSqlPool pool $ do
-    selectOne $ do
-      bl <- from $ table @ZcashBlock
-      where_ $ bl ^. ZcashBlockHeight ==. val b
-      pure bl
-
 -- | Save a transaction to the data model
 saveTransaction ::
      ConnectionPool -- ^ the database path
-  -> ZcashBlockId -- ^ The block the transaction is in
+  -> Int -- ^ block time
+  -> ZcashNetDB -- ^ the network
   -> Transaction -- ^ The transaction to save
   -> NoLoggingT IO (Key ZcashTransaction)
-saveTransaction pool bi wt =
+saveTransaction pool t n wt =
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     let ix = [0 ..]
-    w <- insert $ ZcashTransaction bi (HexStringDB $ tx_id wt)
+    w <-
+      insert $
+      ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
     when (isJust $ tx_transpBundle wt) $ do
       _ <-
         insertMany_ $
@@ -795,13 +776,10 @@ getZcashTransactions pool b net =
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     select $ do
-      (blks :& txs) <-
+      txs <- from $ table @ZcashTransaction
-        from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
+      where_ (txs ^. ZcashTransactionBlock >. val b)
-        (\(blks :& txs) ->
+      where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
-           blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId)
+      orderBy [asc $ txs ^. ZcashTransactionBlock]
-      where_ (blks ^. ZcashBlockHeight >. val b)
-      where_ (blks ^. ZcashBlockNetwork ==. val (ZcashNetDB net))
-      orderBy [asc $ blks ^. ZcashBlockHeight]
       return txs
 
 -- ** QR codes
@@ -898,25 +876,16 @@ saveWalletTransaction pool za zt = do
   runNoLoggingT $
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
-      b <-
+      t <-
-        selectOne $ do
+        upsert
-          blks <- from $ table @ZcashBlock
+          (WalletTransaction
-          where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zT'))
+             (zcashTransactionTxId zT')
-          pure blks
+             za
-      case b of
+             (zcashTransactionBlock zT')
-        Nothing ->
+             (zcashTransactionConf zT')
-          throw $ userError "invalid block for saving wallet transaction"
+             (zcashTransactionTime zT'))
-        Just blk -> do
+          []
-          t <-
+      return $ entityKey t
-            upsert
-              (WalletTransaction
-                 (zcashTransactionTxId zT')
-                 za
-                 (zcashBlockHeight $ entityVal blk)
-                 (zcashBlockConf $ entityVal blk)
-                 (zcashBlockTime $ entityVal blk))
-              []
-          return $ entityKey t
 
 -- | Save a @WalletSapNote@
 saveWalletSapNote ::
@@ -1007,17 +976,14 @@ findTransparentNotes pool b net t = do
         PS.retryOnBusy $
         flip PS.runSqlPool pool $ do
           select $ do
-            (blks :& txs :& tNotes) <-
+            (txs :& tNotes) <-
-              from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
+              from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
-              (\(blks :& txs) ->
+              (\(txs :& tNotes) ->
-                 blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
-              table @TransparentNote `on`
-              (\(_ :& txs :& tNotes) ->
                  txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
-            where_ (blks ^. ZcashBlockHeight >. val b)
+            where_ (txs ^. ZcashTransactionBlock >. val b)
-            where_ (blks ^. ZcashBlockNetwork ==. val net)
+            where_ (txs ^. ZcashTransactionNetwork ==. val net)
             where_ (tNotes ^. TransparentNoteScript ==. val s)
-            pure (blks, txs, tNotes)
+            pure (txs, tNotes)
       mapM_
         (saveWalletTrNote
            pool
@@ -1033,11 +999,10 @@ saveWalletTrNote ::
   -> Scope
   -> ZcashAccountId
   -> WalletAddressId
-  -> (Entity ZcashBlock, Entity ZcashTransaction, Entity TransparentNote)
+  -> (Entity ZcashTransaction, Entity TransparentNote)
   -> IO ()
-saveWalletTrNote pool ch za wa (blk, zt, tn) = do
+saveWalletTrNote pool ch za wa (zt, tn) = do
   let zT' = entityVal zt
-  let b = entityVal blk
   runNoLoggingT $
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
@@ -1046,9 +1011,9 @@ saveWalletTrNote pool ch za wa (blk, zt, tn) = do
           (WalletTransaction
              (zcashTransactionTxId zT')
              za
-             (zcashBlockHeight b)
+             (zcashTransactionBlock zT')
-             (zcashBlockConf b)
+             (zcashTransactionConf zT')
-             (zcashBlockTime b))
+             (zcashTransactionTime zT'))
           []
       insert_ $
         WalletTrNote
@@ -1077,15 +1042,12 @@ getShieldedOutputs pool b net =
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     select $ do
-      (blks :& txs :& sOutputs) <-
+      (txs :& sOutputs) <-
-        from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
+        from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
-        (\(blks :& txs) ->
+        (\(txs :& sOutputs) ->
-           blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
-        table @ShieldOutput `on`
-        (\(_ :& txs :& sOutputs) ->
            txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
-      where_ (blks ^. ZcashBlockHeight >=. val b)
+      where_ (txs ^. ZcashTransactionBlock >=. val b)
-      where_ (blks ^. ZcashBlockNetwork ==. val net)
+      where_ (txs ^. ZcashTransactionNetwork ==. val net)
       orderBy
         [ asc $ txs ^. ZcashTransactionId
         , asc $ sOutputs ^. ShieldOutputPosition
@@ -1103,15 +1065,12 @@ getOrchardActions pool b net =
   PS.retryOnBusy $
   flip PS.runSqlPool pool $ do
     select $ do
-      (blks :& txs :& oActions) <-
+      (txs :& oActions) <-
-        from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
+        from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
-        (\(blks :& txs) ->
+        (\(txs :& oActions) ->
-           blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
-        table @OrchAction `on`
-        (\(_ :& txs :& oActions) ->
            txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
-      where_ (blks ^. ZcashBlockHeight >=. val b)
+      where_ (txs ^. ZcashTransactionBlock >=. val b)
-      where_ (blks ^. ZcashBlockNetwork ==. val net)
+      where_ (txs ^. ZcashTransactionNetwork ==. val net)
       orderBy
         [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
       pure (txs, oActions)
@@ -1611,29 +1570,15 @@ getOrchardCmxs pool zt = do
 getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
 getMaxOrchardNote pool = do
   flip PS.runSqlPool pool $ do
-    maxBlock <-
+    x <-
       selectOne $ do
-        blks <- from $ table @ZcashBlock
+        n <- from $ table @OrchAction
-        where_ $ blks ^. ZcashBlockHeight >. val 0
+        where_ (n ^. OrchActionId >. val (toSqlKey 0))
-        pure $ blks ^. ZcashBlockHeight
+        orderBy [desc $ n ^. OrchActionId]
-    case maxBlock of
+        pure (n ^. OrchActionId)
+    case x of
       Nothing -> return $ toSqlKey 0
-      Just (Value mb) -> do
+      Just (Value y) -> return y
-        x <-
-          selectOne $ do
-            (blks :& txs :& n) <-
-              from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on`
-              (\(blks :& txs) ->
-                 blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
-              table @OrchAction `on`
-              (\(_ :& txs :& n) ->
-                 txs ^. ZcashTransactionId ==. n ^. OrchActionTx)
-            where_ (blks ^. ZcashBlockHeight <=. val (mb - 5))
-            orderBy [desc $ n ^. OrchActionId]
-            pure (n ^. OrchActionId)
-        case x of
-          Nothing -> return $ toSqlKey 0
-          Just (Value y) -> return y
 
 updateOrchNoteRecord ::
      Pool SqlBackend
@@ -1695,23 +1640,15 @@ upsertWalTx ::
   => ZcashTransaction
   -> ZcashAccountId
   -> SqlPersistT m (Entity WalletTransaction)
-upsertWalTx zt za = do
+upsertWalTx zt za =
-  blk <-
+  upsert
-    selectOne $ do
+    (WalletTransaction
-      blks <- from $ table @ZcashBlock
+       (zcashTransactionTxId zt)
-      where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zt))
+       za
-      pure blks
+       (zcashTransactionBlock zt)
-  case blk of
+       (zcashTransactionConf zt)
-    Nothing -> throw $ userError "Invalid block for transaction"
+       (zcashTransactionTime zt))
-    Just b ->
+    []
-      upsert
-        (WalletTransaction
-           (zcashTransactionTxId zt)
-           za
-           (zcashBlockHeight $ entityVal b)
-           (zcashBlockConf $ entityVal b)
-           (zcashBlockTime $ entityVal b))
-        []
 
 getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
 getSaplingOutIndex pool i = do
@@ -1864,9 +1801,6 @@ clearWalletData pool = do
       delete $ do
         _ <- from $ table @ZcashTransaction
         return ()
-      delete $ do
-        _ <- from $ table @ZcashBlock
-        return ()
 
 getWalletUnspentTrNotes ::
      ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
@@ -2048,130 +1982,6 @@ selectUnspentNotes pool za amt = do
              , n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
         else (0, [n])
 
-selectUnspentNotesV2 ::
-     ConnectionPool
-  -> ZcashAccountId
-  -> Integer
-  -> Int
-  -> PrivacyPolicy
-  -> IO
-       (Either
-          TxError
-          ( [Entity WalletTrNote]
-          , [Entity WalletSapNote]
-          , [Entity WalletOrchNote]))
-selectUnspentNotesV2 pool za amt recv policy = do
-  case policy of
-    Full ->
-      case recv of
-        4 -> do
-          orchNotes <- getWalletUnspentOrchNotes pool za
-          let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
-          if a1 > 0
-            then return $
-                 Left $ PrivacyPolicyError "Not enough notes for Full privacy"
-            else return $ Right ([], [], oList)
-        3 -> do
-          sapNotes <- getWalletUnspentSapNotes pool za
-          let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
-          if a2 > 0
-            then return $
-                 Left $ PrivacyPolicyError "Not enough notes for Full privacy"
-            else return $ Right ([], sList, [])
-        _anyOther ->
-          return $
-          Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
-    Medium ->
-      if recv > 2
-        then do
-          orchNotes <- getWalletUnspentOrchNotes pool za
-          let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
-          if a1 > 0
-            then do
-              sapNotes <- getWalletUnspentSapNotes pool za
-              let (a2, sList) = checkSapling a1 sapNotes
-              if a2 > 0
-                then return $
-                     Left $
-                     PrivacyPolicyError "Not enough notes for Medium privacy"
-                else return $ Right ([], sList, oList)
-            else return $ Right ([], [], oList)
-        else return $
-             Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
-    Low ->
-      if recv == 0
-        then return $ Left ZHError
-        else do
-          case recv of
-            3 -> do
-              sapNotes <- getWalletUnspentSapNotes pool za
-              let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
-              if a1 > 0
-                then do
-                  orchNotes <- getWalletUnspentOrchNotes pool za
-                  let (a2, oList) = checkOrchard a1 orchNotes
-                  if a2 > 0
-                    then return $
-                         Left $
-                         PrivacyPolicyError "Not enough notes for Low privacy"
-                    else return $ Right ([], sList, oList)
-                else return $ Right ([], sList, [])
-            _anyOther -> do
-              orchNotes <- getWalletUnspentOrchNotes pool za
-              let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
-              if a1 > 0
-                then do
-                  sapNotes <- getWalletUnspentSapNotes pool za
-                  let (a2, sList) = checkSapling a1 sapNotes
-                  if a2 > 0
-                    then return $
-                         Left $
-                         PrivacyPolicyError "Not enough notes for Low privacy"
-                    else return $ Right ([], sList, oList)
-                else return $ Right ([], [], oList)
-    None -> do
-      orchNotes <- getWalletUnspentOrchNotes pool za
-      let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
-      if a1 > 0
-        then do
-          sapNotes <- getWalletUnspentSapNotes pool za
-          let (a2, sList) = checkSapling a1 sapNotes
-          if a2 > 0
-            then do
-              trNotes <- getWalletUnspentTrNotes pool za
-              let (a3, tList) = checkTransparent a2 trNotes
-              if a3 > 0
-                then return $ Left InsufficientFunds
-                else return $ Right (tList, sList, oList)
-            else return $ Right ([], sList, oList)
-        else return $ Right ([], [], oList)
-  where
-    checkTransparent ::
-         Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
-    checkTransparent x [] = (x, [])
-    checkTransparent x (n:ns) =
-      if walletTrNoteValue (entityVal n) < x
-        then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)
-             , n :
-               snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
-        else (0, [n])
-    checkSapling ::
-         Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
-    checkSapling x [] = (x, [])
-    checkSapling x (n:ns) =
-      if walletSapNoteValue (entityVal n) < x
-        then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns)
-             , n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
-        else (0, [n])
-    checkOrchard ::
-         Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
-    checkOrchard x [] = (x, [])
-    checkOrchard x (n:ns) =
-      if walletOrchNoteValue (entityVal n) < x
-        then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)
-             , n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
-        else (0, [n])
-
 getWalletTxId ::
      ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
 getWalletTxId pool wId = do
@@ -2203,9 +2013,6 @@ saveConfs pool b c = do
       update $ \t -> do
         set t [WalletTransactionConf =. val c]
         where_ $ t ^. WalletTransactionBlock ==. val b
-      update $ \bl -> do
-        set bl [ZcashBlockConf =. val c]
-        where_ $ bl ^. ZcashBlockHeight ==. val b
 
 -- | Helper function to extract a Unified Address from the database
 readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
@@ -2298,14 +2105,3 @@ finalizeOperation pool op status result = do
         , OperationResult =. val (Just result)
         ]
       where_ (ops ^. OperationId ==. val op)
-
--- | Rewind the data store to a given block height
-rewindWalletData :: ConnectionPool -> Int -> IO ()
-rewindWalletData pool b = do
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $
-    delete $ do
-      blk <- from $ table @ZcashBlock
-      where_ $ blk ^. ZcashBlockHeight >=. val b
-  clearWalletTransactions pool

src/Zenith/GUI.hs

@@ -10,7 +10,7 @@ import Codec.QRCode
 import Codec.QRCode.JuicyPixels
 import Control.Concurrent (threadDelay)
 import Control.Exception (throwIO, try)
-import Control.Monad (unless, when)
+import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
 import Data.Aeson
@@ -47,19 +47,20 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
 import Zenith.DB
 import Zenith.GUI.Theme
-import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
+import Zenith.Scanner (processTx, rescanZebra, updateConfs)
 import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
+  , getZenithPath
+  , isEmpty
   , isRecipientValid
-  , isRecipientValidGUI
-  , isZecAddressValid
   , isValidString
   , jsonNumber
   , padWithZero
-  , parseAddressUA
+  , parseAddress
   , showAddress
   , validBarValue
+  , validateAddressBool
   )
 
 data AppEvent
@@ -115,6 +116,7 @@ data AppEvent
   | CheckValidAddress !T.Text
   | CheckValidDescrip !T.Text
   | SaveNewABEntry
+  | SaveABDescription !T.Text
   | UpdateABEntry !T.Text !T.Text
   | CloseUpdABEntry
   | ShowMessage !T.Text
@@ -123,7 +125,6 @@ data AppEvent
   | CopyABAdress !T.Text
   | DeleteABEntry !T.Text
   | UpdateABDescrip !T.Text !T.Text
-  | ResetRecipientValid
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -417,43 +418,43 @@ buildUI wenv model = widgetTree
                [ vstack
                    [ tooltip "Unified" $
                      box_
-                       [onClick (SetPool OrchardPool)]
+                       [onClick (SetPool Orchard)]
                        (remixIcon remixShieldCheckFill `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
-                            (model ^. selPool == OrchardPool)
+                            (model ^. selPool == Orchard)
                             (bgColor btnColor)
                         , styleIf
-                            (model ^. selPool == OrchardPool)
+                            (model ^. selPool == Orchard)
                             (textColor white)
                         ])
                    , filler
                    , tooltip "Legacy Shielded" $
                      box_
-                       [onClick (SetPool SaplingPool)]
+                       [onClick (SetPool Sapling)]
                        (remixIcon remixShieldLine `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
-                            (model ^. selPool == SaplingPool)
+                            (model ^. selPool == Sapling)
                             (bgColor btnColor)
                         , styleIf
-                            (model ^. selPool == SaplingPool)
+                            (model ^. selPool == Sapling)
                             (textColor white)
                         ])
                    , filler
                    , tooltip "Transparent" $
                      box_
-                       [onClick (SetPool TransparentPool)]
+                       [onClick (SetPool Transparent)]
                        (remixIcon remixEyeLine `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
-                            (model ^. selPool == TransparentPool)
+                            (model ^. selPool == Transparent)
                             (bgColor btnColor)
                         , styleIf
-                            (model ^. selPool == TransparentPool)
+                            (model ^. selPool == Transparent)
                             (textColor white)
                         ])
                    ] `styleBasic`
@@ -466,10 +467,10 @@ buildUI wenv model = widgetTree
                        (hstack
                           [ label
                               (case model ^. selPool of
-                                 OrchardPool -> "Unified"
+                                 Orchard -> "Unified"
-                                 SaplingPool -> "Legacy Shielded"
+                                 Sapling -> "Legacy Shielded"
-                                 TransparentPool -> "Transparent"
+                                 Transparent -> "Transparent"
-                                 SproutPool -> "Unknown") `styleBasic`
+                                 Sprout -> "Unknown") `styleBasic`
                             [textColor white]
                           , remixIcon remixFileCopyFill `styleBasic`
                             [textSize 14, padding 4, textColor white]
@@ -604,29 +605,8 @@ buildUI wenv model = widgetTree
                            [textFont "Bold", textSize 12])
                       , separatorLine `styleBasic` [fgColor btnColor]
                       , spacer
-                      , hstack 
-                          [ 
-                            label "Privacy Level:" `styleBasic` [width 70, textFont "Bold"]
-                          , spacer
-                          , label "Full " `styleBasic` [width 40]
-                          , radio  Full privacyChoice 
-                          , spacer
-                          , label "Medium " `styleBasic` [width 40]
-                          , radio Medium privacyChoice 
-                          ]
-                      , hstack 
-                          [
-                            label "               " `styleBasic` [width 70,  textFont "Bold"]
-                          , spacer
-                          , label "Low " `styleBasic` [width 40]
-                          , radio  Low privacyChoice 
-                          , spacer
-                          , label "None " `styleBasic` [width 40]
-                          , radio None privacyChoice 
-                          ]
-                      , spacer
                       , hstack
-                          [ label "To:" `styleBasic` [width 50,  textFont "Bold"]
+                          [ label "To:" `styleBasic` [width 50]
                           , spacer
                           , textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
                             [ width 150
@@ -636,7 +616,7 @@ buildUI wenv model = widgetTree
                             ]
                           ]
                       , hstack
-                          [ label "Amount:" `styleBasic` [width 50,  textFont "Bold"]
+                          [ label "Amount:" `styleBasic` [width 50]
                           , spacer
                           , numericField_
                               sendAmount
@@ -654,13 +634,35 @@ buildUI wenv model = widgetTree
                             ]
                           ]
                       , hstack
-                          [ label "Memo:" `styleBasic` [width 50,  textFont "Bold"]
+                          [ label "Memo:" `styleBasic` [width 50]
                           , spacer
                           , textArea sendMemo `styleBasic`
                             [width 150, height 40]
                           ]
                       , spacer
                         -- Radio button group for privacy level
+                      , hstack 
+                          [ 
+                            label "Privacy Level:" `styleBasic` [width 70]
+                          , spacer
+                          , label "None " `styleBasic` [width 40]
+                          , radio None privacyChoice
+                          , spacer
+                          , label "Low " `styleBasic` [width 40]
+                          , radio  Low privacyChoice
+
+                          ]
+                      , hstack 
+                          [
+                            label "               " `styleBasic` [width 70]
+                          , spacer
+                          , label "Medium " `styleBasic` [width 40]
+                          , radio  Medium privacyChoice
+                          , spacer
+                          , label "Full " `styleBasic` [width 40]
+                          , radio  Full privacyChoice
+                          ]
+                      , spacer
                       , box_
                           [alignMiddle]
                           (hstack
@@ -970,9 +972,9 @@ generateQRCodes config = do
       if not (null s)
         then return ()
         else do
-          generateOneQr pool OrchardPool wAddr
+          generateOneQr pool Orchard wAddr
-          generateOneQr pool SaplingPool wAddr
+          generateOneQr pool Sapling wAddr
-          generateOneQr pool TransparentPool wAddr
+          generateOneQr pool Transparent wAddr
     generateOneQr ::
          ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
     generateOneQr p zp wAddr =
@@ -1007,7 +1009,7 @@ generateQRCodes config = do
     dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
     dispAddr zp w =
       case zp of
-        TransparentPool ->
+        Transparent ->
           T.append "zcash:" .
           encodeTransparentReceiver
             (maybe
@@ -1019,12 +1021,11 @@ generateQRCodes config = do
           (t_rec =<<
            (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
              w)
-        SaplingPool ->
+        Sapling ->
           T.append "zcash:" <$>
           (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
-        OrchardPool ->
+        Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
-          Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
+        Sprout -> Nothing
-        SproutPool -> Nothing
 
 handleEvent ::
      WidgetEnv AppModel AppEvent
@@ -1079,7 +1080,7 @@ handleEvent wenv node model evt =
       ]
     ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
     ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
-    ShowSend -> [Model $ model & openSend .~ True & privacyChoice .~ Full & recipientValid .~ False]
+    ShowSend -> [Model $ model & openSend .~ True]
     SendTx ->
       case currentAccount of
         Nothing -> [Event $ ShowError "No account available", Event CancelSend]
@@ -1138,7 +1139,7 @@ handleEvent wenv node model evt =
             Just wAddr -> getUserTx dbPool $ entityKey wAddr
       ]
     SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
-    SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool OrchardPool]
+    SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
     SwitchAcc i ->
       [ Model $ model & selAcc .~ i
       , Task $
@@ -1156,7 +1157,7 @@ handleEvent wenv node model evt =
               b <- getBalance dbPool $ entityKey acc
               u <- getUnconfirmedBalance dbPool $ entityKey acc
               return (b, u)
-      , Event $ SetPool OrchardPool
+      , Event $ SetPool Orchard
       ]
     SwitchWal i ->
       [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
@@ -1179,15 +1180,14 @@ handleEvent wenv node model evt =
       , setClipboardData $
         ClipboardText $
         case model ^. selPool of
-          OrchardPool ->
+          Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
-            maybe "None" (getUA . walletAddressUAddress . entityVal) a
+          Sapling ->
-          SaplingPool ->
             fromMaybe "None" $
             (getSaplingFromUA .
              E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
             a
-          SproutPool -> "None"
+          Sprout -> "None"
-          TransparentPool ->
+          Transparent ->
             maybe "None" (encodeTransparentReceiver (model ^. network)) $
             t_rec =<<
             (isValidUnifiedAddress .
@@ -1210,7 +1210,7 @@ handleEvent wenv node model evt =
       if not (null a)
         then [ Model $ model & addresses .~ a
              , Event $ SwitchAddr $ model ^. selAddr
-             , Event $ SetPool OrchardPool
+             , Event $ SetPool Orchard
              ]
         else [Event $ NewAddress currentAccount]
     LoadAccs a ->
@@ -1248,8 +1248,7 @@ handleEvent wenv node model evt =
                  case currentWallet of
                    Nothing -> return $ ShowError "No wallet available"
                    Just cW -> do
-                     runFileLoggingT "zenith.log" $
+                     syncWallet (model ^. configuration) cW
-                       syncWallet (model ^. configuration) cW
                      pool <-
                        runNoLoggingT $
                        initPool $ c_dbPath $ model ^. configuration
@@ -1262,10 +1261,7 @@ handleEvent wenv node model evt =
                ("Wallet Sync: " <>
                 T.pack (printf "%.2f%%" (model ^. barValue * 100)))
              ]
-    ResetRecipientValid -> [Model $ model &  recipientValid .~ False]
+    CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
-    CheckRecipient a -> [Model $ 
-                            model & recipientValid .~ isRecipientValidGUI (model ^.privacyChoice) a ]
---                            model & recipientValid .~ ((model ^. privacyChoice) == Low)  ]
     CheckAmount i ->
       [ Model $
         model & amountValid .~
@@ -1276,7 +1272,7 @@ handleEvent wenv node model evt =
     -- | Address Book Events
     -- |
     CheckValidAddress a ->
-      [Model $ model & abAddressValid .~ isZecAddressValid a]
+      [Model $ model & abAddressValid .~ isRecipientValid a]
     CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
     ShowAdrBook ->
       if null (model ^. abaddressList)
@@ -1471,25 +1467,20 @@ scanZebra dbPath zHost zPort net sendMsg = do
   pool <- runNoLoggingT $ initPool dbPath
   b <- liftIO $ getMinBirthdayHeight pool
   dbBlock <- getMaxBlock pool $ ZcashNetDB net
-  chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
+  let sb = max dbBlock b
-  unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock
-  let sb =
-        if chkBlock == dbBlock
-          then max dbBlock b
-          else max chkBlock b
-  if sb > zgb_blocks bStatus || sb < 1
-    then sendMsg (ShowError "Invalid starting block for scan")
-    else do
-      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-      if not (null bList)
-        then do
-          let step = (1.0 :: Float) / fromIntegral (length bList)
-          mapM_ (processBlock pool step) bList
-        else sendMsg (SyncVal 1.0)
   confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
   case confUp of
     Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
-    Right _ -> return ()
+    Right _ -> do
+      if sb > zgb_blocks bStatus || sb < 1
+        then sendMsg (ShowError "Invalid starting block for scan")
+        else do
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+          if not (null bList)
+            then do
+              let step = (1.0 :: Float) / fromIntegral (length bList)
+              mapM_ (processBlock pool step) bList
+            else sendMsg (SyncVal 1.0)
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -1514,16 +1505,16 @@ scanZebra dbPath zHost zPort net sendMsg = do
             Left e2 -> sendMsg (ShowError $ showt e2)
             Right hb -> do
               let blockTime = getBlockTime hb
-              bi <-
+              mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
-                saveBlock pool $
+                bl_txs $ addTime blk blockTime
-                ZcashBlock
-                  (fromIntegral $ bl_height blk)
-                  (HexStringDB $ bl_hash blk)
-                  (fromIntegral $ bl_confirmations blk)
-                  blockTime
-                  (ZcashNetDB net)
-              mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
               sendMsg (SyncVal step)
+    addTime :: BlockResponse -> Int -> BlockResponse
+    addTime bl t =
+      BlockResponse
+        (bl_confirmations bl)
+        (bl_height bl)
+        (fromIntegral t)
+        (bl_txs bl)
 
 sendTransaction ::
      Config
@@ -1537,7 +1528,7 @@ sendTransaction ::
   -> IO ()
 sendTransaction config znet accId bl amt ua memo sendMsg = do
   sendMsg $ ShowModal "Preparing transaction..."
-  case parseAddressUA ua znet of
+  case parseAddress ua znet of
     Nothing -> sendMsg $ ShowError "Incorrect address"
     Just outUA -> do
       let dbPath = c_dbPath config
@@ -1615,8 +1606,7 @@ runZenithGUI config = do
                       else return []
                   qr <-
                     if not (null addrList)
-                      then getQrCode pool OrchardPool $
+                      then getQrCode pool Orchard $ entityKey $ head addrList
-                           entityKey $ head addrList
                       else return Nothing
                   bal <-
                     if not (null accList)
@@ -1645,7 +1635,7 @@ runZenithGUI config = do
                           (if unconfBal == 0
                              then Nothing
                              else Just unconfBal)
-                          OrchardPool
+                          Orchard
                           qr
                           False
                           False
@@ -1683,7 +1673,7 @@ runZenithGUI config = do
                           Nothing
                           False
                           False
-                          Full
+                          None
                   startApp model handleEvent buildUI (params hD)
         Left _e -> print "Zebra not available"
   where

src/Zenith/Scanner.hs

@@ -6,13 +6,7 @@ import Control.Concurrent.Async (concurrently_, withAsync)
 import Control.Exception (throwIO, try)
 import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Logger
+import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
-  ( NoLoggingT
-  , logErrorN
-  , logInfoN
-  , runFileLoggingT
-  , runNoLoggingT
-  )
 import Data.Aeson
 import Data.HexString
 import qualified Data.Text as T
@@ -33,23 +27,19 @@ import ZcashHaskell.Types
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
 import Zenith.Core (checkBlockChain, syncWallet)
 import Zenith.DB
-  ( ZcashBlock(..)
+  ( clearWalletData
-  , ZcashBlockId
-  , clearWalletData
   , clearWalletTransactions
-  , getBlock
   , getMaxBlock
   , getMinBirthdayHeight
   , getUnconfirmedBlocks
   , getWallets
   , initDb
   , initPool
-  , saveBlock
   , saveConfs
   , saveTransaction
   , updateWalletSync
   )
-import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
+import Zenith.Types (Config(..), ZcashNetDB(..))
 import Zenith.Utils (jsonNumber)
 
 -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
@@ -67,8 +57,8 @@ rescanZebra host port dbFilePath = do
     Right bStatus -> do
       let znet = ZcashNetDB $ zgb_net bStatus
       pool1 <- runNoLoggingT $ initPool dbFilePath
-      {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
+      pool2 <- runNoLoggingT $ initPool dbFilePath
-      {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
+      pool3 <- runNoLoggingT $ initPool dbFilePath
       clearWalletTransactions pool1
       clearWalletData pool1
       dbBlock <- getMaxBlock pool1 znet
@@ -129,26 +119,28 @@ processBlock host port pool pg net b = do
         Left e2 -> liftIO $ throwIO $ userError e2
         Right hb -> do
           let blockTime = getBlockTime hb
-          bi <-
+          mapM_ (processTx host port blockTime pool net) $
-            saveBlock pool $
+            bl_txs $ addTime blk blockTime
-            ZcashBlock
-              (fromIntegral $ bl_height blk)
-              (HexStringDB $ bl_hash blk)
-              (fromIntegral $ bl_confirmations blk)
-              blockTime
-              net
-          mapM_ (processTx host port bi pool) $ bl_txs blk
           liftIO $ tick pg
+  where
+    addTime :: BlockResponse -> Int -> BlockResponse
+    addTime bl t =
+      BlockResponse
+        (bl_confirmations bl)
+        (bl_height bl)
+        (fromIntegral t)
+        (bl_txs bl)
 
 -- | Function to process a raw transaction
 processTx ::
      T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
-  -> ZcashBlockId -- ^ Block ID
+  -> Int -- ^ Block time
   -> ConnectionPool -- ^ DB file path
+  -> ZcashNetDB -- ^ the network
   -> HexString -- ^ transaction id
   -> IO ()
-processTx host port bt pool t = do
+processTx host port bt pool net t = do
   r <-
     liftIO $
     makeZebraCall
@@ -164,7 +156,7 @@ processTx host port bt pool t = do
         Just rzt -> do
           _ <-
             runNoLoggingT $
-            saveTransaction pool bt $
+            saveTransaction pool bt net $
             Transaction
               t
               (ztr_blockheight rawTx)
@@ -219,35 +211,5 @@ clearSync config = do
           w <- getWallets pool $ zgb_net chainInfo
           liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
           w' <- liftIO $ getWallets pool $ zgb_net chainInfo
-          r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
+          r <- mapM (syncWallet config) w'
           liftIO $ print r
-
--- | Detect chain re-orgs
-checkIntegrity ::
-     T.Text -- ^ Database path
-  -> T.Text -- ^ Zebra host
-  -> Int -- ^ Zebra port
-  -> Int -- ^ The block to start the check
-  -> Int -- ^ depth
-  -> IO Int
-checkIntegrity dbP zHost zPort b d =
-  if b < 1
-    then return 1
-    else do
-      r <-
-        makeZebraCall
-          zHost
-          zPort
-          "getblock"
-          [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
-      case r of
-        Left e -> throwIO $ userError e
-        Right blk -> do
-          pool <- runNoLoggingT $ initPool dbP
-          dbBlk <- getBlock pool b
-          case dbBlk of
-            Nothing -> throwIO $ userError "Block mismatch, rescan needed"
-            Just dbBlk' ->
-              if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
-                then return b
-                else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)

src/Zenith/Types.hs

@@ -104,10 +104,10 @@ data Config = Config
   } deriving (Eq, Prelude.Show)
 
 data ZcashPool
-  = TransparentPool
+  = Transparent
-  | SproutPool
+  | Sprout
-  | SaplingPool
+  | Sapling
-  | OrchardPool
+  | Orchard
   deriving (Show, Read, Eq)
 
 derivePersistField "ZcashPool"
@@ -115,18 +115,18 @@ derivePersistField "ZcashPool"
 instance ToJSON ZcashPool where
   toJSON zp =
     case zp of
-      TransparentPool -> Data.Aeson.String "p2pkh"
+      Transparent -> Data.Aeson.String "p2pkh"
-      SproutPool -> Data.Aeson.String "sprout"
+      Sprout -> Data.Aeson.String "sprout"
-      SaplingPool -> Data.Aeson.String "sapling"
+      Sapling -> Data.Aeson.String "sapling"
-      OrchardPool -> Data.Aeson.String "orchard"
+      Orchard -> Data.Aeson.String "orchard"
 
 instance FromJSON ZcashPool where
   parseJSON =
     withText "ZcashPool" $ \case
-      "p2pkh" -> return TransparentPool
+      "p2pkh" -> return Transparent
-      "sprout" -> return SproutPool
+      "sprout" -> return Sprout
-      "sapling" -> return SaplingPool
+      "sapling" -> return Sapling
-      "orchard" -> return OrchardPool
+      "orchard" -> return Orchard
       _ -> fail "Not a known Zcash pool"
 
 newtype ZenithUuid = ZenithUuid
@@ -199,12 +199,12 @@ $(deriveJSON defaultOptions ''ZenithStatus)
 derivePersistField "ZenithStatus"
 
 data PrivacyPolicy
-  = None
+  = Full
-  | Low
   | Medium
-  | Full
+  | Low
+  | None
   deriving (Eq, Show, Read, Ord)
-
+  
 $(deriveJSON defaultOptions ''PrivacyPolicy)
 
 -- ** `zebrad`
@@ -298,8 +298,7 @@ instance FromJSON AddressGroup where
           Nothing -> return []
           Just x -> do
             x' <- x .:? "addresses"
-            return $
+            return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
-              maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
       processSapling k s2 =
         case k of
           Nothing -> return []
@@ -307,7 +306,7 @@ instance FromJSON AddressGroup where
             where processOneSapling sx =
                     withObject "Sapling" $ \oS -> do
                       oS' <- oS .: "addresses"
-                      return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
+                      return $ map (ZcashAddress sx [Sapling] Nothing) oS'
       processUnified u =
         case u of
           Nothing -> return []

src/Zenith/Utils.hs

@@ -3,17 +3,17 @@
 module Zenith.Utils where
 
 import Data.Aeson
-import Data.Char (isAlphaNum, isSpace)
 import Data.Functor (void)
 import Data.Maybe
 import Data.Ord (clamp)
 import Data.Scientific (Scientific(..), scientific)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
+import Data.Char (isAlphaNum, isSpace)
 import System.Directory
 import System.Process (createProcess_, shell)
 import Text.Regex.Posix
-import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress)
+import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
 import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
 import ZcashHaskell.Transparent
   ( decodeExchangeAddress
@@ -24,15 +24,12 @@ import ZcashHaskell.Types
   , TransparentAddress(..)
   , UnifiedAddress(..)
   , ZcashNet(..)
-  , ValidAddress(..)
-  , ExchangeAddress(..)
   )
 import Zenith.Types
   ( AddressGroup(..)
   , UnifiedAddressDB(..)
   , ZcashAddress(..)
   , ZcashPool(..)
-  , PrivacyPolicy(..)
   )
 
 -- | Helper function to convert numbers into JSON
@@ -74,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
 -- | Helper function to validate potential Zcash addresses
 validateAddress :: T.Text -> Maybe ZcashPool
 validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
-  | tReg = Just TransparentPool
+  | tReg = Just Transparent
-  | sReg && chkS = Just SaplingPool
+  | sReg && chkS = Just Sapling
-  | uReg && chk = Just OrchardPool
+  | uReg && chk = Just Orchard
   | otherwise = Nothing
   where
     transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@@ -113,7 +110,7 @@ validBarValue :: Float -> Float
 validBarValue = clamp (0, 1)
 
 isRecipientValid :: T.Text -> Bool
-isRecipientValid a = do
+isRecipientValid a =
   case isValidUnifiedAddress (E.encodeUtf8 a) of
     Just _a1 -> True
     Nothing ->
@@ -125,78 +122,8 @@ isRecipientValid a = do
              Just _a4 -> True
              Nothing -> False)
 
-isUnifiedAddressValid :: T.Text -> Bool
+parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
-isUnifiedAddressValid ua =
+parseAddress a znet =
-    case isValidUnifiedAddress (E.encodeUtf8 ua)  of
-            Just _a1 -> True
-            Nothing -> False
-
-isSaplingAddressValid :: T.Text -> Bool
-isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
-
-isTransparentAddressValid :: T.Text -> Bool
-isTransparentAddressValid ta =
-  case decodeTransparentAddress (E.encodeUtf8 ta) of
-         Just _a3 -> True
-         Nothing -> False
-
-isExchangeAddressValid :: T.Text -> Bool
-isExchangeAddressValid xa =
-  case decodeExchangeAddress (E.encodeUtf8 xa) of
-    Just _a4 -> True
-    Nothing -> False
-
-isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
-isRecipientValidGUI p a  = do
-  let adr = parseAddress (E.encodeUtf8 a)
-  case p of 
-    Full -> case adr of  
-              Just a -> 
-                case a of  
-                    Unified ua -> True
-                    Sapling sa -> True
-                    _ -> False
-              Nothing -> False
-    Medium -> case adr of 
-                Just a -> 
-                  case a of  
-                      Unified ua -> True
-                      Sapling sa -> True
-                      _ -> False
-                Nothing -> False
-    Low -> case adr of  
-              Just a -> 
-                case a of  
-                    Unified ua -> True
-                    Sapling sa -> True
-                    Transparent ta -> True
-                    Exchange ea -> True
-                    _ -> False
-              Nothing -> False
-
-    None -> case adr of  
-              Just a -> 
-                case a of  
-                    Transparent ta -> True
-                    Exchange ea -> True
-                    _ -> False
-              Nothing -> False
-
-isZecAddressValid ::  T.Text -> Bool
-isZecAddressValid a = do
-  case isValidUnifiedAddress (E.encodeUtf8 a) of
-    Just _a1 -> True
-    Nothing ->
-      isValidShieldedAddress (E.encodeUtf8 a) ||
-      (case decodeTransparentAddress (E.encodeUtf8 a) of
-         Just _a3 -> True
-         Nothing ->
-           case decodeExchangeAddress (E.encodeUtf8 a) of
-             Just _a4 -> True
-             Nothing -> False)
-
-parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
-parseAddressUA a znet =
   case isValidUnifiedAddress (E.encodeUtf8 a) of
     Just a1 -> Just a1
     Nothing ->
@@ -210,27 +137,28 @@ parseAddressUA a znet =
             Nothing -> Nothing
 
 isValidContent :: String -> Bool
-isValidContent [] = False --  an empty string is invalid   
+isValidContent [] = False         --  an empty string is invalid   
-isValidContent (x:xs)
+isValidContent (x:xs) 
-  | not (isAlphaNum x) = False --  string must start with an alphanumeric character
+  | not (isAlphaNum x ) = False   --  string must start with an alphanumeric character
-  | otherwise = allValidChars xs --  process the rest of the string 
+  | otherwise = allValidChars xs  --  process the rest of the string 
   where
-    allValidChars :: String -> Bool
+    allValidChars :: String -> Bool 
-    allValidChars [] = True -- if we got here, string is valid
+    allValidChars [] = True  -- if we got here, string is valid
-    allValidChars (y:ys)
+    allValidChars (y:ys) 
       | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
-      | otherwise = False -- found an invalid character, return false  
+      | otherwise = False  -- found an invalid character, return false  
 
 isValidString :: T.Text -> Bool
-isValidString c = do
+isValidString c = do  
   let a = T.unpack c
   isValidContent a
 
 padWithZero :: Int -> String -> String
-padWithZero n s
+padWithZero n s 
-  | (length s) >= n = s
+  | (length s) >= n  = s 
-  | otherwise = padWithZero n ("0" ++ s)
+  | otherwise  = padWithZero n ("0" ++ s)
 
 isEmpty :: [a] -> Bool
 isEmpty [] = True
-isEmpty _ = False
+isEmpty _  = False
+  

src/Zenith/Zcashd.hs

@@ -123,10 +123,9 @@ sendTx user pwd fromAddy toAddy amount memo = do
       if source fromAddy /= ImportedWatchOnly
         then do
           let privacyPolicy
-                | valAdd == Just TransparentPool = "AllowRevealedRecipients"
+                | valAdd == Just Transparent = "AllowRevealedRecipients"
                 | isNothing (account fromAddy) &&
-                    elem TransparentPool (pool fromAddy) =
+                    elem Transparent (pool fromAddy) = "AllowRevealedSenders"
-                  "AllowRevealedSenders"
                 | otherwise = "AllowRevealedAmounts"
           let pd =
                 case memo of
@@ -302,7 +301,7 @@ sendWithUri user pwd fromAddy uri repTo = do
       let addType = validateAddress $ T.pack parsedAddress
       case addType of
         Nothing -> putStrLn "   Invalid address"
-        Just TransparentPool -> do
+        Just Transparent -> do
           putStrLn $ "   Address is valid: " ++ parsedAddress
           case (readMaybe parsedAmount :: Maybe Double) of
             Nothing -> putStrLn "   Invalid amount."

test/Spec.hs

@@ -1,16 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Monad (when)
-import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
+import Control.Monad.Logger (runNoLoggingT)
 import Data.HexString
-import Data.Maybe (fromJust)
 import qualified Data.Text.Encoding as E
 import Database.Persist
 import Database.Persist.Sqlite
 import System.Directory
 import Test.HUnit
 import Test.Hspec
-import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
+import ZcashHaskell.Orchard (isValidUnifiedAddress)
 import ZcashHaskell.Sapling
   ( decodeSaplingOutputEsk
   , encodeSaplingAddress
@@ -173,15 +172,15 @@ main = do
                       "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
       describe "Note selection for Tx" $ do
         it "Value less than balance" $ do
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+          pool <- runNoLoggingT $ initPool "zenith.db"
           res <- selectUnspentNotes pool (toSqlKey 1) 14000000
           res `shouldNotBe` ([], [], [])
         it "Value greater than balance" $ do
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+          pool <- runNoLoggingT $ initPool "zenith.db"
           let res = selectUnspentNotes pool (toSqlKey 1) 84000000
           res `shouldThrow` anyIOException
         it "Fee calculation" $ do
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+          pool <- runNoLoggingT $ initPool "zenith.db"
           res <- selectUnspentNotes pool (toSqlKey 1) 14000000
           calculateTxFee res 3 `shouldBe` 20000
       describe "Testing validation" $ do
@@ -210,7 +209,7 @@ main = do
                  (case decodeTransparentAddress (E.encodeUtf8 a) of
                     Just _a3 -> True
                     Nothing ->
-                      case decodeExchangeAddress (E.encodeUtf8 a) of
+                      case decodeExchangeAddress (En.encodeUtf8 a) of
                         Just _a4 -> True
                         Nothing -> False))
         it "Transparent" $ do
@@ -234,115 +233,21 @@ main = do
           a `shouldBe`
             Just
               "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
-      describe "Notes" $ do
+      {-describe "Creating Tx" $ do-}
-        it "Check Orchard notes" $ do
+        {-xit "To Orchard" $ do-}
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+          {-let uaRead =-}
-          oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1)
+                {-isValidUnifiedAddress-}
-          oNotes `shouldBe` []
+                  {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
-        it "Check Sapling notes" $ do
+          {-case uaRead of-}
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+            {-Nothing -> assertFailure "wrong address"-}
-          oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4)
+            {-Just ua -> do-}
-          oNotes `shouldBe` []
+              {-tx <--}
-        it "Check transparent notes" $ do
+                {-prepareTx-}
-          pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
+                  {-"zenith.db"-}
-          oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1)
+                  {-TestNet-}
-          oNotes `shouldBe` []
+                  {-(toSqlKey 1)-}
-      describe "Creating Tx" $ do
+                  {-2819811-}
-        describe "Full" $ do
+                  {-0.04-}
-          it "To Orchard" $ do
+                  {-ua-}
-            let uaRead =
+                  {-"sent with Zenith, test"-}
-                  parseAddress
+              {-tx `shouldBe` Right (hexString "deadbeef")-}
-                    "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-            case uaRead of
-              Nothing -> assertFailure "wrong address"
-              Just ua -> do
-                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                tx <-
-                  runFileLoggingT "zenith.log" $
-                  prepareTxV2
-                    pool
-                    "localhost"
-                    18232
-                    TestNet
-                    (toSqlKey 1)
-                    3001230
-                    0.005
-                    (fromJust uaRead)
-                    "Sending memo to orchard"
-                    Full
-                case tx of
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
-          it "To Sapling" $ do
-            let uaRead =
-                  parseAddress
-                    "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
-            case uaRead of
-              Nothing -> assertFailure "wrong address"
-              Just ua -> do
-                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                tx <-
-                  runFileLoggingT "zenith.log" $
-                  prepareTxV2
-                    pool
-                    "localhost"
-                    18232
-                    TestNet
-                    (toSqlKey 4)
-                    3001230
-                    0.005
-                    (fromJust uaRead)
-                    "Sending memo to sapling"
-                    Full
-                case tx of
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
-        describe "Medium" $ do
-          xit "To Orchard" $ do
-            let uaRead =
-                  parseAddress
-                    "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-            case uaRead of
-              Nothing -> assertFailure "wrong address"
-              Just ua -> do
-                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                tx <-
-                  runFileLoggingT "zenith.log" $
-                  prepareTxV2
-                    pool
-                    "localhost"
-                    18232
-                    TestNet
-                    (toSqlKey 1)
-                    3000789
-                    0.005
-                    (fromJust uaRead)
-                    "Sending memo to orchard"
-                    Medium
-                case tx of
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")
-          xit "To Sapling" $ do
-            let uaRead =
-                  parseAddress
-                    "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
-            case uaRead of
-              Nothing -> assertFailure "wrong address"
-              Just ua -> do
-                pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
-                tx <-
-                  runFileLoggingT "zenith.log" $
-                  prepareTxV2
-                    pool
-                    "localhost"
-                    18232
-                    TestNet
-                    (toSqlKey 1)
-                    3000789
-                    0.005
-                    (fromJust uaRead)
-                    "Sending memo to orchard"
-                    Medium
-                case tx of
-                  Left e -> assertFailure $ show e
-                  Right h -> h `shouldNotBe` (hexString "deadbeef")

zcash-haskell

@@ -1 +1 @@
-Subproject commit 12296026a0ebb9a5afe0904b251c5d31080eab18
+Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c