Improve the fee calculation

src/Zenith/CLI.hs

@@ -11,11 +11,15 @@ import qualified Brick.Focus as F
 import Brick.Forms
   ( Form(..)
   , (@@=)
+  , allFieldsValid
+  , editShowableFieldWithValidate
   , editTextField
   , focusedFormInputAttr
   , handleFormEvent
+  , invalidFormInputAttr
   , newForm
   , renderForm
+  , setFieldValid
   , updateFormState
   )
 import qualified Brick.Main as M
@@ -49,6 +53,7 @@ import Brick.Widgets.Core
   , withBorderStyle
   )
 import qualified Brick.Widgets.Dialog as D
+import qualified Brick.Widgets.Edit as E
 import qualified Brick.Widgets.List as L
 import qualified Brick.Widgets.ProgressBar as P
 import Control.Concurrent (forkIO, threadDelay)
@@ -57,6 +62,7 @@ import Control.Monad (forever, void)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
 import Data.Aeson
+import Data.HexString (toText)
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
@@ -73,7 +79,12 @@ import System.Hclip
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
-import ZcashHaskell.Transparent (encodeTransparentReceiver)
+import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
+import ZcashHaskell.Transparent
+  ( decodeExchangeAddress
+  , decodeTransparentAddress
+  , encodeTransparentReceiver
+  )
 import ZcashHaskell.Types
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
 import Zenith.Core
@@ -94,6 +105,9 @@ data Name
   | TList
   | HelpDialog
   | DialogInputField
+  | RecField
+  | AmtField
+  | MemoField
   deriving (Eq, Show, Ord)
 
 data DialogInput = DialogInput
@@ -102,12 +116,21 @@ data DialogInput = DialogInput
 
 makeLenses ''DialogInput
 
+data SendInput = SendInput
+  { _sendTo :: !T.Text
+  , _sendAmt :: !Float
+  , _sendMemo :: !T.Text
+  } deriving (Show)
+
+makeLenses ''SendInput
+
 data DialogType
   = WName
   | AName
   | AdName
   | WSelect
   | ASelect
+  | SendTx
   | Blank
 
 data DisplayType
@@ -116,6 +139,7 @@ data DisplayType
   | PhraseDisplay
   | TxDisplay
   | SyncDisplay
+  | SendDisplay
   | BlankDisplay
 
 data Tick
@@ -144,6 +168,7 @@ data State = State
   , _barValue :: !Float
   , _eventDispatch :: !(BC.BChan Tick)
   , _timer :: !Int
+  , _txForm :: !(Form SendInput () Name)
   }
 
 makeLenses ''State
@@ -182,7 +207,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
          listAddressBox "Addresses" (st ^. addresses) <+>
          B.vBorder <+>
          (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
-          listTxBox "Transactions" (st ^. transactions))) <=>
+          listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=>
       C.hCenter
         (hBox
            [ capCommand "W" "allets"
@@ -230,13 +255,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                , capCommand "Tab " "->"
                ])
         ]
-    listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
+    listTxBox ::
-    listTxBox titleLabel tx =
+         String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name
+    listTxBox titleLabel znet tx =
       C.vCenter $
       vBox
         [ C.hCenter
             (B.borderWithLabel (str titleLabel) $
-             hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
+             hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx)
         , str " "
         , C.hCenter
             (hBox
@@ -303,6 +329,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   , capCommand "N" "ew"
                   , xCommand
                   ]))
+        SendTx ->
+          D.renderDialog
+            (D.dialog (Just (str "Send Transaction")) Nothing 50)
+            (renderForm (st ^. txForm) <=>
+             C.hCenter
+               (hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
         Blank -> emptyWidget
     splashDialog :: State -> Widget Name
     splashDialog st =
@@ -421,6 +453,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   (P.progressBar
                      (Just $ show (st ^. barValue * 100))
                      (_barValue st))))
+        SendDisplay ->
+          withBorderStyle unicodeBold $
+          D.renderDialog
+            (D.dialog (Just $ txt "Sending Transaction") Nothing 50)
+            (padAll 1 (str $ st ^. msg))
         BlankDisplay -> emptyWidget
 
 mkInputForm :: DialogInput -> Form DialogInput e Name
@@ -431,6 +468,33 @@ mkInputForm =
     label s w =
       padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
 
+mkSendForm :: Integer -> SendInput -> Form SendInput e Name
+mkSendForm bal =
+  newForm
+    [ label "To:     " @@= editTextField sendTo RecField (Just 1)
+    , label "Amount: " @@=
+      editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
+    , label "Memo:   " @@= editTextField sendMemo MemoField (Just 1)
+    ]
+  where
+    isAmountValid :: Integer -> Float -> Bool
+    isAmountValid b i = (fromIntegral b * 100000000.0) >= i
+    label s w =
+      padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
+
+isRecipientValid :: T.Text -> Bool
+isRecipientValid a =
+  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 a of
+             Just _a4 -> True
+             Nothing -> False)
+
 listDrawElement :: (Show a) => Bool -> a -> Widget Name
 listDrawElement sel a =
   let selStr s =
@@ -466,18 +530,22 @@ listDrawAddress sel w =
       walletAddressName (entityVal w) <>
       ": " <> showAddress (walletAddressUAddress (entityVal w))
 
-listDrawTx :: Bool -> Entity UserTx -> Widget Name
+listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name
-listDrawTx sel tx =
+listDrawTx znet sel tx =
   selStr $
   T.pack
     (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
-  " " <> fmtAmt
+  " " <> T.pack fmtAmt
   where
-    amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
+    amt = fromIntegral $ userTxAmount $ entityVal tx
+    dispAmount =
+      if znet == MainNet
+        then displayZec amt
+        else displayTaz amt
     fmtAmt =
       if amt > 0
-        then "↘" <> T.pack (show amt) <> " "
+        then "↘" <> dispAmount <> " "
-        else " " <> T.pack (show amt) <> "↗"
+        else " " <> dispAmount <> "↗"
     selStr s =
       if sel
         then withAttr customAttr (txt $ "> " <> s)
@@ -561,14 +629,22 @@ appEvent (BT.AppEvent t) = do
   pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
   case t of
     TickMsg m -> do
-      BT.modify $ set msg m
+      case s ^. displayBox of
-      BT.modify $ set displayBox MsgDisplay
+        AddrDisplay -> return ()
+        MsgDisplay -> return ()
+        PhraseDisplay -> return ()
+        TxDisplay -> return ()
+        SyncDisplay -> return ()
+        SendDisplay -> do
+          BT.modify $ set msg m
+        BlankDisplay -> return ()
     TickVal v -> do
       case s ^. displayBox of
         AddrDisplay -> return ()
         MsgDisplay -> return ()
         PhraseDisplay -> return ()
         TxDisplay -> return ()
+        SendDisplay -> return ()
         SyncDisplay -> do
           if s ^. barValue == 1.0
             then do
@@ -600,6 +676,7 @@ appEvent (BT.AppEvent t) = do
             WName -> return ()
             WSelect -> return ()
             ASelect -> return ()
+            SendTx -> return ()
             Blank -> do
               if s ^. timer == 90
                 then do
@@ -643,6 +720,11 @@ appEvent (BT.VtyEvent e) = do
                            setClipboard $
                            T.unpack $
                            getUA $ walletAddressUAddress $ entityVal a
+                         BT.modify $
+                           set msg $
+                           "Copied Unified Address <" ++
+                           T.unpack (walletAddressName (entityVal a)) ++ ">!"
+                         BT.modify $ set displayBox MsgDisplay
                        Nothing -> return ()
                    V.EvKey (V.KChar 's') [] -> do
                      case L.listSelectedElement $ s ^. addresses of
@@ -653,6 +735,11 @@ appEvent (BT.VtyEvent e) = do
                            getSaplingFromUA $
                            E.encodeUtf8 $
                            getUA $ walletAddressUAddress $ entityVal a
+                         BT.modify $
+                           set msg $
+                           "Copied Sapling Address <" ++
+                           T.unpack (walletAddressName (entityVal a)) ++ ">!"
+                         BT.modify $ set displayBox MsgDisplay
                        Nothing -> return ()
                    V.EvKey (V.KChar 't') [] -> do
                      case L.listSelectedElement $ s ^. addresses of
@@ -667,11 +754,17 @@ appEvent (BT.VtyEvent e) = do
                            (isValidUnifiedAddress .
                             E.encodeUtf8 . getUA . walletAddressUAddress)
                              (entityVal a)
+                         BT.modify $
+                           set msg $
+                           "Copied Transparent Address <" ++
+                           T.unpack (walletAddressName (entityVal a)) ++ ">!"
+                         BT.modify $ set displayBox MsgDisplay
                        Nothing -> return ()
                    _ev -> return ()
                MsgDisplay -> BT.modify $ set displayBox BlankDisplay
                PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
                TxDisplay -> BT.modify $ set displayBox BlankDisplay
+               SendDisplay -> BT.modify $ set displayBox BlankDisplay
                SyncDisplay -> BT.modify $ set displayBox BlankDisplay
                BlankDisplay -> do
                  case s ^. dialogBox of
@@ -756,6 +849,71 @@ appEvent (BT.VtyEvent e) = do
                            s ^. inputForm
                          BT.modify $ set dialogBox AName
                        ev -> BT.zoom accounts $ L.handleListEvent ev
+                   SendTx -> do
+                     case e of
+                       V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
+                       V.EvKey V.KEnter [] -> do
+                         if allFieldsValid (s ^. txForm)
+                           then do
+                             pool <-
+                               liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
+                             selWal <-
+                               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
+                             selAcc <-
+                               do case L.listSelectedElement $ s ^. accounts of
+                                    Nothing -> do
+                                      let fAcc =
+                                            L.listSelectedElement $
+                                            L.listMoveToBeginning $
+                                            s ^. accounts
+                                      case fAcc of
+                                        Nothing ->
+                                          throw $
+                                          userError "Failed to select wallet"
+                                        Just (_j, w1) -> return w1
+                                    Just (_k, w) -> return w
+                             fs1 <- BT.zoom txForm $ BT.gets formState
+                             bl <-
+                               liftIO $ getLastSyncBlock pool $ entityKey selWal
+                             _ <-
+                               liftIO $
+                               forkIO $
+                               sendTransaction
+                                 pool
+                                 (s ^. eventDispatch)
+                                 (s ^. zebraHost)
+                                 (s ^. zebraPort)
+                                 (s ^. network)
+                                 (entityKey selAcc)
+                                 bl
+                                 (fs1 ^. sendAmt)
+                                 (fs1 ^. sendTo)
+                                 (fs1 ^. sendMemo)
+                             BT.modify $ set msg "Preparing transaction..."
+                             BT.modify $ set displayBox SendDisplay
+                             BT.modify $ set dialogBox Blank
+                           else do
+                             BT.modify $ set msg "Invalid inputs"
+                             BT.modify $ set displayBox MsgDisplay
+                             BT.modify $ set dialogBox Blank
+                       ev -> do
+                         BT.zoom txForm $ do
+                           handleFormEvent (BT.VtyEvent ev)
+                           fs <- BT.gets formState
+                           BT.modify $
+                             setFieldValid
+                               (isRecipientValid (fs ^. sendTo))
+                               RecField
                    Blank -> do
                      case e of
                        V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
@@ -774,6 +932,11 @@ 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 txForm $
+                           mkSendForm (s ^. balance) (SendInput "" 0.0 "")
+                         BT.modify $ set dialogBox SendTx
                        ev ->
                          case r of
                            Just AList ->
@@ -798,6 +961,9 @@ theMap =
     , (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
     , (blinkAttr, style V.blink)
     , (focusedFormInputAttr, V.white `on` V.blue)
+    , (invalidFormInputAttr, V.red `on` V.black)
+    , (E.editAttr, V.white `on` V.blue)
+    , (E.editFocusedAttr, V.blue `on` V.white)
     , (baseAttr, bg V.brightBlack)
     , (barDoneAttr, V.white `on` V.blue)
     , (barToDoAttr, V.white `on` V.black)
@@ -885,6 +1051,7 @@ runZenithCLI config = do
               1.0
               eventChan
               0
+              (mkSendForm 0 $ SendInput "" 0.0 "")
     Left e -> do
       print $
         "No Zebra node available on port " <>
@@ -1063,3 +1230,51 @@ addNewAddress n scope s = do
             T.unpack n ++
             "(" ++
             T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"
+
+sendTransaction ::
+     ConnectionPool
+  -> BC.BChan Tick
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> Float
+  -> T.Text
+  -> T.Text
+  -> IO ()
+sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
+  BC.writeBChan chan $ TickMsg "Preparing transaction..."
+  outUA <- parseAddress ua
+  res <-
+    runFileLoggingT "zenith.log" $
+    prepareTx pool zHost zPort znet accId bl amt outUA memo
+  BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
+  case res of
+    Left e -> BC.writeBChan chan $ TickMsg $ show e
+    Right rawTx -> do
+      resp <-
+        makeZebraCall
+          zHost
+          zPort
+          "sendrawtransaction"
+          [Data.Aeson.String $ toText rawTx]
+      case resp of
+        Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
+        Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId
+  where
+    parseAddress :: T.Text -> IO UnifiedAddress
+    parseAddress a =
+      case isValidUnifiedAddress (E.encodeUtf8 a) of
+        Just a1 -> return a1
+        Nothing ->
+          case decodeSaplingAddress (E.encodeUtf8 a) of
+            Just a2 ->
+              return $
+              UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
+            Nothing ->
+              case decodeTransparentAddress (E.encodeUtf8 a) of
+                Just a3 ->
+                  return $
+                  UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
+                Nothing -> throwIO $ userError "Incorrect address"

src/Zenith/Core.hs

@@ -10,6 +10,8 @@ import Control.Monad.Logger
   ( LoggingT
   , MonadLoggerIO
   , NoLoggingT
+  , logDebugN
+  , logErrorN
   , logInfoN
   , logWarnN
   , runFileLoggingT
@@ -18,6 +20,7 @@ import Control.Monad.Logger
   )
 import Crypto.Secp256k1 (SecKey(..))
 import Data.Aeson
+import Data.Binary.Get hiding (getBytes)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import Data.Digest.Pure.MD5
@@ -442,17 +445,17 @@ calculateTxFee (t, s, o) i =
     (5000 * (max (length t) tout + max (length s) sout + length o + oout))
   where
     tout =
-      if i == 1
+      if i == 1 || i == 2
         then 1
         else 0
     sout =
-      if i == 2
+      if i == 3
         then 1
         else 0
     oout =
-      if i == 3
+      if i == 4
-        then 2
+        then 1
-        else 1
+        else 0
 
 -- | Prepare a transaction for sending
 prepareTx ::
@@ -465,9 +468,9 @@ prepareTx ::
   -> Float
   -> UnifiedAddress
   -> T.Text
-  -> IO (Either TxError HexString)
+  -> LoggingT IO (Either TxError HexString)
 prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
-  accRead <- getAccountById pool za
+  accRead <- liftIO $ getAccountById pool za
   let recipient =
         case o_rec ua of
           Nothing ->
@@ -481,63 +484,97 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
                       P2SH -> (2, toBytes $ tr_bytes r3)
               Just r2 -> (3, getBytes r2)
           Just r1 -> (4, getBytes r1)
-  print recipient
+  logDebugN $ T.pack $ show recipient
-  trees <- getCommitmentTrees zebraHost zebraPort bh
+  logDebugN $ T.pack $ "Target block: " ++ show bh
+  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
   let sT = SaplingCommitmentTree $ ztiSapling trees
   let oT = OrchardCommitmentTree $ ztiOrchard trees
   case accRead of
-    Nothing -> throwIO $ userError "Can't find Account"
+    Nothing -> do
+      logErrorN "Can't find Account"
+      return $ Left ZHError
     Just acc -> do
-      print acc
+      logDebugN $ T.pack $ show acc
-      spParams <- BS.readFile "sapling-spend.params"
+      spParams <- liftIO $ BS.readFile "sapling-spend.params"
-      outParams <- BS.readFile "sapling-output.params"
+      outParams <- liftIO $ BS.readFile "sapling-output.params"
       if show (md5 $ LBS.fromStrict spParams) /=
          "0f44c12ef115ae019decf18ade583b20"
-        then throwIO $ userError "Can't validate sapling parameters"
+        then logErrorN "Can't validate sapling parameters"
-        else print "Valid Sapling spend params"
+        else logInfoN "Valid Sapling spend params"
       if show (md5 $ LBS.fromStrict outParams) /=
          "924daf81b87a81bbbb9c7d18562046c8"
-        then throwIO $ userError "Can't validate sapling parameters"
+        then logErrorN "Can't validate sapling parameters"
-        else print "Valid Sapling output params"
+        else logInfoN "Valid Sapling output params"
-      print $ BS.length spParams
+      --print $ BS.length spParams
-      print $ BS.length outParams
+      --print $ BS.length outParams
-      print "Read Sapling params"
+      logDebugN "Read Sapling params"
       let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
-      firstPass <- selectUnspentNotes pool za zats
+      logDebugN $ T.pack $ show zats
-      let fee = calculateTxFee firstPass 3
+      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
-      print "calculated fee"
+      --let fee = calculateTxFee firstPass $ fst recipient
-      print fee
+      --logDebugN $ T.pack $ "calculated fee " ++ show fee
-      (tList, sList, oList) <- selectUnspentNotes pool za (zats + fee)
+      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
-      print "selected notes"
+      logDebugN "selected notes"
-      print tList
+      logDebugN $ T.pack $ show tList
-      print sList
+      logDebugN $ T.pack $ show sList
-      print oList
+      logDebugN $ T.pack $ show oList
       let noteTotal = getTotalAmount (tList, sList, oList)
-      print noteTotal
       tSpends <-
+        liftIO $
         prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
-      print tSpends
+      --print tSpends
       sSpends <-
+        liftIO $
         prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
-      print sSpends
+      --print sSpends
       oSpends <-
+        liftIO $
         prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
-      print oSpends
+      --print oSpends
-      outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats)
+      dummy <-
-      print outgoing
+        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
-      let tx =
+      logDebugN "Calculating fee"
+      let feeResponse =
             createTransaction
               (Just sT)
               (Just oT)
               tSpends
               sSpends
               oSpends
-              outgoing
+              dummy
               (SaplingSpendParams spParams)
               (SaplingOutputParams outParams)
               zn
               (bh + 3)
-      return tx
+              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
+          outgoing <-
+            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
+          logDebugN $ T.pack $ show outgoing
+          let tx =
+                createTransaction
+                  (Just sT)
+                  (Just oT)
+                  tSpends
+                  sSpends
+                  oSpends
+                  outgoing
+                  (SaplingSpendParams spParams)
+                  (SaplingOutputParams outParams)
+                  zn
+                  (bh + 3)
+                  True
+          return tx
   where
     makeOutgoing ::
          Entity ZcashAccount
@@ -587,7 +624,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
     prepTSpends sk notes = do
       forM notes $ \n -> do
         tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
-        print n
         case tAddRead of
           Nothing -> throwIO $ userError "Couldn't read t-address"
           Just tAdd -> do
@@ -614,7 +650,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
          SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
     prepSSpends sk notes = do
       forM notes $ \n -> do
-        print n
         return $
           SaplingTxSpend
             (getBytes sk)
@@ -630,7 +665,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
          OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
     prepOSpends sk notes = do
       forM notes $ \n -> do
-        print n
         return $
           OrchardTxSpend
             (getBytes sk)

src/Zenith/DB.hs

@@ -119,7 +119,7 @@ share
     deriving Show Eq
   UserTx
     hex HexStringDB
-    address WalletAddressId
+    address WalletAddressId OnDeleteCascade OnUpdateCascade
     time Int
     amount Int
     memo T.Text
@@ -127,8 +127,8 @@ share
     deriving Show Eq
   WalletTrNote
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
-    accId ZcashAccountId
+    accId ZcashAccountId OnDeleteCascade OnUpdateCascade
-    address WalletAddressId
+    address WalletAddressId OnDeleteCascade OnUpdateCascade
     value Word64
     spent Bool
     script BS.ByteString
@@ -138,13 +138,14 @@ share
     deriving Show Eq
   WalletTrSpend
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
-    note WalletTrNoteId
+    note WalletTrNoteId OnDeleteCascade OnUpdateCascade
-    accId ZcashAccountId
+    accId ZcashAccountId OnDeleteCascade OnUpdateCascade
     value Word64
+    UniqueTrSpend tx accId
     deriving Show Eq
   WalletSapNote
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
-    accId ZcashAccountId
+    accId ZcashAccountId OnDeleteCascade OnUpdateCascade
     value Word64
     recipient BS.ByteString
     memo T.Text
@@ -159,13 +160,14 @@ share
     deriving Show Eq
   WalletSapSpend
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
-    note WalletSapNoteId
+    note WalletSapNoteId OnDeleteCascade OnUpdateCascade
-    accId ZcashAccountId
+    accId ZcashAccountId OnDeleteCascade OnUpdateCascade
     value Word64
+    UniqueSapSepnd tx accId
     deriving Show Eq
   WalletOrchNote
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
-    accId ZcashAccountId
+    accId ZcashAccountId OnDeleteCascade OnUpdateCascade
     value Word64
     recipient BS.ByteString
     memo T.Text
@@ -181,9 +183,10 @@ share
     deriving Show Eq
   WalletOrchSpend
     tx WalletTransactionId OnDeleteCascade OnUpdateCascade
-    note WalletOrchNoteId
+    note WalletOrchNoteId OnDeleteCascade OnUpdateCascade
-    accId ZcashAccountId
+    accId ZcashAccountId OnDeleteCascade OnUpdateCascade
     value Word64
+    UniqueOrchSpend tx accId
     deriving Show Eq
   ZcashTransaction
     block Int
@@ -579,6 +582,20 @@ getMinBirthdayHeight pool = do
     Nothing -> return 0
     Just x -> return $ zcashWalletBirthdayHeight $ entityVal x
 
+getLastSyncBlock :: ConnectionPool -> ZcashWalletId -> IO Int
+getLastSyncBlock pool zw = do
+  b <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $ do
+      selectOne $ do
+        w <- from $ table @ZcashWallet
+        where_ (w ^. ZcashWalletId ==. val zw)
+        pure w
+  case b of
+    Nothing -> throwIO $ userError "Failed to retrieve wallet"
+    Just x -> return $ zcashWalletLastSync $ entityVal x
+
 -- | Save a @WalletTransaction@
 saveWalletTransaction ::
      ConnectionPool
@@ -1083,12 +1100,15 @@ findTransparentSpends pool za = do
                       set w [WalletTrNoteSpent =. val True]
                       where_ $ w ^. WalletTrNoteId ==. val (entityKey n)
                   t' <- upsertWalTx (entityVal $ fst $ head s) za
-                  insert_ $
+                  _ <-
-                    WalletTrSpend
+                    upsert
-                      (entityKey t')
+                      (WalletTrSpend
-                      (entityKey n)
+                         (entityKey t')
-                      za
+                         (entityKey n)
-                      (walletTrNoteValue $ entityVal n)
+                         za
+                         (walletTrNoteValue $ entityVal n))
+                      []
+                  return ()
 
 getWalletSapNotes ::
      ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
@@ -1130,12 +1150,15 @@ findSapSpends pool za (n:notes) = do
               set w [WalletSapNoteSpent =. val True]
               where_ $ w ^. WalletSapNoteId ==. val (entityKey n)
           t' <- upsertWalTx (entityVal $ fst $ head s) za
-          insert_ $
+          _ <-
-            WalletSapSpend
+            upsert
-              (entityKey t')
+              (WalletSapSpend
-              (entityKey n)
+                 (entityKey t')
-              za
+                 (entityKey n)
-              (walletSapNoteValue $ entityVal n)
+                 za
+                 (walletSapNoteValue $ entityVal n))
+              []
+          return ()
       findSapSpends pool za notes
 
 getWalletOrchNotes ::
@@ -1275,12 +1298,15 @@ findOrchSpends pool za (n:notes) = do
               set w [WalletOrchNoteSpent =. val True]
               where_ $ w ^. WalletOrchNoteId ==. val (entityKey n)
           t' <- upsertWalTx (entityVal $ fst $ head s) za
-          insert_ $
+          _ <-
-            WalletOrchSpend
+            upsert
-              (entityKey t')
+              (WalletOrchSpend
-              (entityKey n)
+                 (entityKey t')
-              za
+                 (entityKey n)
-              (walletOrchNoteValue $ entityVal n)
+                 za
+                 (walletOrchNoteValue $ entityVal n))
+              []
+          return ()
       findOrchSpends pool za notes
 
 upsertWalTx ::
@@ -1316,6 +1342,9 @@ clearWalletTransactions pool = do
   runNoLoggingT $
     PS.retryOnBusy $
     flip PS.runSqlPool pool $ do
+      delete $ do
+        _ <- from $ table @UserTx
+        return ()
       delete $ do
         _ <- from $ table @WalletOrchSpend
         return ()
@@ -1337,9 +1366,6 @@ clearWalletTransactions pool = do
       delete $ do
         _ <- from $ table @WalletTransaction
         return ()
-      delete $ do
-        _ <- from $ table @UserTx
-        return ()
 
 getWalletUnspentTrNotes ::
      ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]

src/Zenith/Utils.hs

@@ -26,17 +26,17 @@ jsonNumber i = Number $ scientific (fromIntegral i) 0
 -- | Helper function to display small amounts of ZEC
 displayZec :: Integer -> String
 displayZec s
-  | s < 100 = show s ++ " zats "
+  | abs s < 100 = show s ++ " zats "
-  | s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
+  | abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
-  | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
+  | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
   | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
 
 -- | Helper function to display small amounts of ZEC
 displayTaz :: Integer -> String
 displayTaz s
-  | s < 100 = show s ++ " tazs "
+  | abs s < 100 = show s ++ " tazs "
-  | s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
+  | abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
-  | s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
+  | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
   | otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
 
 -- | Helper function to display abbreviated Unified Address

test/Spec.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 import Control.Monad (when)
+import Control.Monad.Logger (runNoLoggingT)
 import Data.HexString
+import qualified Data.Text.Encoding as E
 import Database.Persist
 import Database.Persist.Sqlite
 import System.Directory
@@ -10,15 +12,22 @@ import Test.Hspec
 import ZcashHaskell.Orchard (isValidUnifiedAddress)
 import ZcashHaskell.Sapling
   ( decodeSaplingOutputEsk
+  , encodeSaplingAddress
   , getSaplingNotePosition
   , getSaplingWitness
+  , isValidShieldedAddress
   , updateSaplingCommitmentTree
   )
+import ZcashHaskell.Transparent
+  ( decodeExchangeAddress
+  , decodeTransparentAddress
+  )
 import ZcashHaskell.Types
   ( DecodedNote(..)
   , OrchardSpendingKey(..)
   , Phrase(..)
   , SaplingCommitmentTree(..)
+  , SaplingReceiver(..)
   , SaplingSpendingKey(..)
   , Scope(..)
   , ShieldedOutput(..)
@@ -72,8 +81,9 @@ main = do
           "None" `shouldBe` maybe "None" zcashWalletName s
       describe "Wallet function tests:" $ do
         it "Save Wallet:" $ do
+          pool <- runNoLoggingT $ initPool "test.db"
           zw <-
-            saveWallet "test.db" $
+            saveWallet pool $
             ZcashWallet
               "Testing"
               (ZcashNetDB MainNet)
@@ -84,19 +94,19 @@ main = do
               0
           zw `shouldNotBe` Nothing
         it "Save Account:" $ do
+          pool <- runNoLoggingT $ initPool "test.db"
           s <-
             runSqlite "test.db" $ do
               selectList [ZcashWalletName ==. "Testing"] []
-          za <-
+          za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
-            saveAccount "test.db" =<<
-            createZcashAccount "TestAccount" 0 (head s)
           za `shouldNotBe` Nothing
         it "Save address:" $ do
+          pool <- runNoLoggingT $ initPool "test.db"
           acList <-
             runSqlite "test.db" $
             selectList [ZcashAccountName ==. "TestAccount"] []
           zAdd <-
-            saveAddress "test.db" =<<
+            saveAddress pool =<<
             createWalletAddress "Personal123" 0 MainNet External (head acList)
           addList <-
             runSqlite "test.db" $
@@ -162,29 +172,82 @@ main = do
                       "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
       describe "Note selection for Tx" $ do
         it "Value less than balance" $ do
-          res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
+          pool <- runNoLoggingT $ initPool "zenith.db"
+          res <- selectUnspentNotes pool (toSqlKey 1) 14000000
           res `shouldNotBe` ([], [], [])
         it "Value greater than balance" $ do
-          let res = selectUnspentNotes "zenith.db" (toSqlKey 1) 84000000
+          pool <- runNoLoggingT $ initPool "zenith.db"
+          let res = selectUnspentNotes pool (toSqlKey 1) 84000000
           res `shouldThrow` anyIOException
         it "Fee calculation" $ do
-          res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
+          pool <- runNoLoggingT $ initPool "zenith.db"
+          res <- selectUnspentNotes pool (toSqlKey 1) 14000000
           calculateTxFee res 3 `shouldBe` 20000
-      describe "Creating Tx" $ do
+      describe "Testing validation" $ do
-        xit "To Orchard" $ do
+        it "Unified" $ do
-          let uaRead =
+          let a =
-                isValidUnifiedAddress
+                "utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu"
-                  "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
+          True `shouldBe`
-          case uaRead of
+            (case isValidUnifiedAddress (E.encodeUtf8 a) of
-            Nothing -> assertFailure "wrong address"
+               Just _a1 -> True
-            Just ua -> do
+               Nothing ->
-              tx <-
+                 isValidShieldedAddress (E.encodeUtf8 a) ||
-                prepareTx
+                 (case decodeTransparentAddress (E.encodeUtf8 a) of
-                  "zenith.db"
+                    Just _a3 -> True
-                  TestNet
+                    Nothing ->
-                  (toSqlKey 1)
+                      case decodeExchangeAddress a of
-                  2819811
+                        Just _a4 -> True
-                  0.04
+                        Nothing -> False))
-                  ua
+        it "Sapling" $ do
-                  "sent with Zenith, test"
+          let a =
-              tx `shouldBe` Right (hexString "deadbeef")
+                "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+          True `shouldBe`
+            (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 a of
+                        Just _a4 -> True
+                        Nothing -> False))
+        it "Transparent" $ do
+          let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3"
+          True `shouldBe`
+            (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 a of
+                        Just _a4 -> True
+                        Nothing -> False))
+        it "Check Sapling Address" $ do
+          let a =
+                encodeSaplingAddress TestNet $
+                SaplingReceiver
+                  "Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-"
+          a `shouldBe`
+            Just
+              "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+      {-describe "Creating Tx" $ do-}
+        {-xit "To Orchard" $ do-}
+          {-let uaRead =-}
+                {-isValidUnifiedAddress-}
+                  {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
+          {-case uaRead of-}
+            {-Nothing -> assertFailure "wrong address"-}
+            {-Just ua -> do-}
+              {-tx <--}
+                {-prepareTx-}
+                  {-"zenith.db"-}
+                  {-TestNet-}
+                  {-(toSqlKey 1)-}
+                  {-2819811-}
+                  {-0.04-}
+                  {-ua-}
+                  {-"sent with Zenith, test"-}
+              {-tx `shouldBe` Right (hexString "deadbeef")-}

zcash-haskell

@@ -1 +1 @@
-Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111
+Subproject commit 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6

zenith.cabal

@@ -46,6 +46,7 @@ library
     , bytestring
     , esqueleto
     , resource-pool
+    , binary
     , exceptions
     , monad-logger
     , vty-crossplatform
@@ -122,6 +123,7 @@ test-suite zenith-tests
       base >=4.12 && <5
     , bytestring
     , configurator
+    , monad-logger
     , data-default
     , sort
     , text