src/Zenith/Core.hs

@@ -73,6 +73,7 @@ import Zenith.Types
   , HexStringDB(..)
   , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
+  , PrivacyPolicy(..)
   , RseedDB(..)
   , SaplingSpendingKeyDB(..)
   , ScopeDB(..)
@@ -733,6 +734,253 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
              getHex $ walletOrchNoteWitness $ entityVal $ head notes
         else Nothing
 
+-- | Prepare a transaction for sending
+prepareTxV2 ::
+     ConnectionPool
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> Float
+  -> ValidAddress
+  -> T.Text
+  -> PrivacyPolicy
+  -> LoggingT IO (Either TxError HexString)
+prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
+  accRead <- liftIO $ getAccountById pool za
+  let recipient =
+        case va of
+          Unified ua ->
+            case o_rec ua of
+              Nothing ->
+                case s_rec ua of
+                  Nothing ->
+                    case t_rec ua of
+                      Nothing -> (0, "")
+                      Just r3 ->
+                        case tr_type r3 of
+                          P2PKH -> (1, toBytes $ tr_bytes r3)
+                          P2SH -> (2, toBytes $ tr_bytes r3)
+                  Just r2 -> (3, getBytes r2)
+              Just r1 -> (4, getBytes r1)
+          Sapling sa -> (3, getBytes $ sa_receiver sa)
+          Transparent ta ->
+            case tr_type (ta_receiver ta) of
+              P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
+              P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
+          Exchange ea ->
+            case tr_type (ex_address ea) of
+              P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
+              P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
+  logDebugN $ T.pack $ show recipient
+  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 -> do
+      logErrorN "Can't find Account"
+      return $ Left ZHError
+    Just acc -> do
+      logDebugN $ T.pack $ show acc
+      spParams <- liftIO $ BS.readFile "sapling-spend.params"
+      outParams <- liftIO $ BS.readFile "sapling-output.params"
+      if show (md5 $ LBS.fromStrict spParams) /=
+         "0f44c12ef115ae019decf18ade583b20"
+        then logErrorN "Can't validate sapling parameters"
+        else logInfoN "Valid Sapling spend params"
+      if show (md5 $ LBS.fromStrict outParams) /=
+         "924daf81b87a81bbbb9c7d18562046c8"
+        then logErrorN "Can't validate sapling parameters"
+        else logInfoN "Valid Sapling output params"
+      --print $ BS.length spParams
+      --print $ BS.length outParams
+      logDebugN "Read Sapling params"
+      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+      logDebugN $ T.pack $ show zats
+      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
+      --let fee = calculateTxFee firstPass $ fst recipient
+      --logDebugN $ T.pack $ "calculated fee " ++ show fee
+      (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 $
+        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
+      --print tSpends
+      sSpends <-
+        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
+              (SaplingSpendParams spParams)
+              (SaplingOutputParams outParams)
+              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
+          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
+          logDebugN $ T.pack $ show tx
+          return tx
+  where
+    makeOutgoing ::
+         Entity ZcashAccount
+      -> (Int, BS.ByteString)
+      -> Integer
+      -> Integer
+      -> IO [OutgoingNote]
+    makeOutgoing acc (k, recvr) zats chg = do
+      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
+      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
+      let chgRcvr =
+            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+      return
+        [ OutgoingNote
+            4
+            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+            (getBytes chgRcvr)
+            (fromIntegral chg)
+            ""
+            True
+        , OutgoingNote
+            (fromIntegral k)
+            (case k of
+               4 ->
+                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
+               3 ->
+                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
+               _ -> "")
+            recvr
+            (fromIntegral zats)
+            (E.encodeUtf8 memo)
+            False
+        ]
+    getTotalAmount ::
+         ( [Entity WalletTrNote]
+         , [Entity WalletSapNote]
+         , [Entity WalletOrchNote])
+      -> Integer
+    getTotalAmount (t, s, o) =
+      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
+      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
+      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
+    prepTSpends ::
+         TransparentSpendingKey
+      -> [Entity WalletTrNote]
+      -> IO [TransparentTxSpend]
+    prepTSpends sk notes = do
+      forM notes $ \n -> do
+        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
+        case tAddRead of
+          Nothing -> throwIO $ userError "Couldn't read t-address"
+          Just tAdd -> do
+            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
+              genTransparentSecretKey
+                (walletAddressIndex $ entityVal tAdd)
+                (getScope $ walletAddressScope $ entityVal tAdd)
+                sk
+            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
+            case mReverseTxId of
+              Nothing -> throwIO $ userError "failed to get tx ID"
+              Just (ESQ.Value reverseTxId) -> do
+                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
+                return $
+                  TransparentTxSpend
+                    xp_key
+                    (RawOutPoint
+                       flipTxId
+                       (fromIntegral $ walletTrNotePosition $ entityVal n))
+                    (RawTxOut
+                       (fromIntegral $ walletTrNoteValue $ entityVal n)
+                       (walletTrNoteScript $ entityVal n))
+    prepSSpends ::
+         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
+    prepSSpends sk notes = do
+      forM notes $ \n -> do
+        return $
+          SaplingTxSpend
+            (getBytes sk)
+            (DecodedNote
+               (fromIntegral $ walletSapNoteValue $ entityVal n)
+               (walletSapNoteRecipient $ entityVal n)
+               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
+               (getHex $ walletSapNoteNullifier $ entityVal n)
+               ""
+               (getRseed $ walletSapNoteRseed $ entityVal n))
+            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
+    prepOSpends ::
+         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
+    prepOSpends sk notes = do
+      forM notes $ \n -> do
+        return $
+          OrchardTxSpend
+            (getBytes sk)
+            (DecodedNote
+               (fromIntegral $ walletOrchNoteValue $ entityVal n)
+               (walletOrchNoteRecipient $ entityVal n)
+               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
+               (getHex $ walletOrchNoteNullifier $ entityVal n)
+               (walletOrchNoteRho $ entityVal n)
+               (getRseed $ walletOrchNoteRseed $ entityVal n))
+            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
+    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
+    sapAnchor notes =
+      if not (null notes)
+        then Just $
+             SaplingWitness $
+             getHex $ walletSapNoteWitness $ entityVal $ head notes
+        else Nothing
+    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
+    orchAnchor notes =
+      if not (null notes)
+        then Just $
+             OrchardWitness $
+             getHex $ walletOrchNoteWitness $ entityVal $ head notes
+        else Nothing
+
 -- | Sync the wallet with the data store
 syncWallet ::
      Config -- ^ configuration parameters