diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 80bc5f7..cfc74cd 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -26,7 +26,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Digest.Pure.MD5 import Data.HexString (HexString, hexString, toBytes, toText) import Data.List -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, fromMaybe) import Data.Pool (Pool) import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -34,7 +34,11 @@ import Data.Time import qualified Database.Esqueleto.Experimental as ESQ import Database.Persist import Database.Persist.Sqlite -import GHC.Float.RealFracMethods (floorFloatInteger) +import GHC.Float.RealFracMethods + ( ceilingFloatInteger + , floorFloatInt + , floorFloatInteger + ) import Haskoin.Crypto.Keys (XPrvKey(..)) import Lens.Micro ((&), (.~), (^.), set) import Network.HTTP.Client @@ -75,11 +79,13 @@ import Zenith.Types , OrchardSpendingKeyDB(..) , PhraseDB(..) , PrivacyPolicy(..) + , ProposedNote(..) , RseedDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB(..) , UnifiedAddressDB(..) + , ValidAddressAPI(..) , ZcashNetDB(..) , ZebraTreeInfo(..) ) @@ -541,7 +547,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do return $ Left ZHError Just acc -> do logDebugN $ T.pack $ show acc - let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) + let zats = floorFloatInteger $ amt * (10 ^ 8) logDebugN $ T.pack $ show zats {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} --let fee = calculateTxFee firstPass $ fst recipient @@ -729,38 +735,13 @@ prepareTxV2 :: -> ZcashNet -> ZcashAccountId -> Int - -> Float - -> ValidAddress - -> T.Text + -> [ProposedNote] -> PrivacyPolicy -> LoggingT IO (Either TxError HexString) -prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do +prepareTxV2 pool zebraHost zebraPort zn za bh pnotes 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 + let recipients = map extractReceiver pnotes + logDebugN $ T.pack $ show recipients logDebugN $ T.pack $ "Target block: " ++ show bh trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh let sT = SaplingCommitmentTree $ ztiSapling trees @@ -771,14 +752,21 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do return $ Left ZHError Just acc -> do logDebugN $ T.pack $ show acc - let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) - logDebugN $ T.pack $ show zats + let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes + let zats = ceilingFloatInteger $ amt * (10 ^ 8) + logDebugN $ "amt: " <> T.pack (show amt) + logDebugN $ "zats: " <> T.pack (show zats) {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} --let fee = calculateTxFee firstPass $ fst recipient --logDebugN $ T.pack $ "calculated fee " ++ show fee notePlan <- liftIO $ - selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy + selectUnspentNotesV2 + pool + za + (zats + 10000) + (map (\(x, _, _, _) -> x) recipients) + policy case notePlan of Right (tList, sList, oList) -> do logDebugN "selected notes" @@ -786,6 +774,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do logDebugN $ T.pack $ show sList logDebugN $ T.pack $ show oList let noteTotal = getTotalAmount (tList, sList, oList) + logDebugN $ "noteTotal: " <> T.pack (show noteTotal) tSpends <- liftIO $ prepTSpends @@ -806,7 +795,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do --print oSpends dummy' <- liftIO $ - makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy + makeOutgoing acc recipients (noteTotal - 5000 - zats) policy case dummy' of Left e -> return $ Left e Right dummy -> do @@ -834,7 +823,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do pool za (zats + feeAmt) - (fst recipient) + (map (\(x, _, _, _) -> x) recipients) policy case finalNotePlan of Right (tList1, sList1, oList1) -> do @@ -863,8 +852,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do liftIO $ makeOutgoing acc - recipient - zats + recipients (noteTotal1 - feeAmt - zats) policy logDebugN $ T.pack $ show outgoing' @@ -889,30 +877,135 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do logErrorN $ T.pack $ show e return $ Left e where + extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text) + extractReceiver (ProposedNote (ValidAddressAPI va) amt m) = + let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) + in case va of + Unified ua -> + case o_rec ua of + Nothing -> + case s_rec ua of + Nothing -> + case t_rec ua of + Nothing -> (0, "", 0, "") + Just r3 -> + case tr_type r3 of + P2PKH -> + (1, toBytes $ tr_bytes r3, zats, fromMaybe "" m) + P2SH -> + (2, toBytes $ tr_bytes r3, zats, fromMaybe "" m) + Just r2 -> (3, getBytes r2, zats, fromMaybe "" m) + Just r1 -> (4, getBytes r1, zats, fromMaybe "" m) + Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m) + Transparent ta -> + case tr_type (ta_receiver ta) of + P2PKH -> + (1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) + P2SH -> + (2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) + Exchange ea -> + case tr_type (ex_address ea) of + P2PKH -> + (5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) + P2SH -> + (6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) + prepareOutgoingNote :: + ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote + prepareOutgoingNote zac (k, r, a, m) = + OutgoingNote + (if k == 5 + then 1 + else if k == 6 + then 2 + else fromIntegral k) + (case k of + 4 -> getBytes $ getOrchSK $ zcashAccountOrchSpendKey zac + 3 -> getBytes $ getSapSK $ zcashAccountSapSpendKey zac + _anyOther -> BS.empty) + r + (fromIntegral a) + (E.encodeUtf8 m) + False makeOutgoing :: Entity ZcashAccount - -> (Int, BS.ByteString) - -> Integer + -> [(Int, BS.ByteString, Int, T.Text)] -> Integer -> PrivacyPolicy -> IO (Either TxError [OutgoingNote]) - makeOutgoing acc (k, recvr) zats chg policy = do + makeOutgoing acc recvs chg pol = do + let k = map (\(x, _, _, _) -> x) recvs chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr - case k of - 4 -> - case policy of - None -> - return $ - Left $ - PrivacyPolicyError "Receiver not compatible with privacy policy" - _anyOther -> do + case pol of + Full -> + if elem 1 k || elem 2 k || elem 5 k || elem 6 k + then return $ + Left $ + PrivacyPolicyError + "Receiver not compatible with privacy policy" + else if elem 3 k && elem 4 k + then return $ + Left $ + PrivacyPolicyError + "Multiple shielded pulls not allowed for Full privacy" + else if 3 `elem` k + then do + let chgRcvr = + fromJust $ + s_rec =<< + isValidUnifiedAddress + (E.encodeUtf8 internalUA) + let cnote = + OutgoingNote + 3 + (getBytes $ + getSapSK $ + zcashAccountSapSpendKey $ entityVal acc) + (getBytes chgRcvr) + (fromIntegral chg) + "" + True + let onotes = + map + (prepareOutgoingNote (entityVal acc)) + recvs + return $ Right $ cnote : onotes + else if 4 `elem` k + then do + let chgRcvr = + fromJust $ + o_rec =<< + isValidUnifiedAddress + (E.encodeUtf8 internalUA) + let cnote = + OutgoingNote + 4 + (getBytes $ + getOrchSK $ + zcashAccountOrchSpendKey $ + entityVal acc) + (getBytes chgRcvr) + (fromIntegral chg) + "" + True + let onotes = + map + (prepareOutgoingNote (entityVal acc)) + recvs + return $ Right $ cnote : onotes + else return $ Left ZHError + Medium -> + if elem 1 k || elem 2 k || elem 5 k || elem 6 k + then return $ + Left $ + PrivacyPolicyError + "Receiver not compatible with privacy policy" + else do let chgRcvr = fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) - return $ - Right - [ OutgoingNote + let cnote = + OutgoingNote 4 (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) @@ -920,51 +1013,20 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do (fromIntegral chg) "" True - , OutgoingNote - 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 onotes = map (prepareOutgoingNote (entityVal acc)) recvs + return $ Right $ cnote : onotes + Low -> + if elem 5 k || elem 6 k + then return $ + Left $ + PrivacyPolicyError + "Receiver not compatible with privacy policy" + else do let chgRcvr = fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) - return $ - Right - [ OutgoingNote + let cnote = + OutgoingNote 4 (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) @@ -972,58 +1034,28 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do (fromIntegral chg) "" True - , OutgoingNote - 3 - (getBytes $ - getSapSK $ zcashAccountSapSpendKey $ entityVal acc) - recvr - (fromIntegral zats) - (E.encodeUtf8 memo) - False - ] - 2 -> - if policy <= Low - then do + let onotes = map (prepareOutgoingNote (entityVal acc)) recvs + return $ Right $ cnote : onotes + None -> + if elem 3 k || elem 4 k + then return $ + Left $ + PrivacyPolicyError + "Receiver not compatible with privacy policy" + else do let chgRcvr = fromJust $ t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) - return $ - Right - [ OutgoingNote + let cnote = + 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 + let onotes = map (prepareOutgoingNote (entityVal acc)) recvs + return $ Right $ cnote : onotes getTotalAmount :: ( [Entity WalletTrNote] , [Entity WalletSapNote] diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 3f50113..79eb3eb 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -2080,7 +2080,7 @@ selectUnspentNotesV2 :: ConnectionPool -> ZcashAccountId -> Integer - -> Int + -> [Int] -> PrivacyPolicy -> IO (Either @@ -2091,27 +2091,40 @@ selectUnspentNotesV2 :: 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" + if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv + then return $ + Left $ PrivacyPolicyError "Receiver not capable of Full privacy" + else if elem 4 recv && elem 3 recv + then return $ + Left $ + PrivacyPolicyError + "Combination of receivers not allowed for Full privacy" + else if 4 `elem` recv + then 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) + else 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, []) Medium -> - if recv > 2 - then do + if elem 1 recv || elem 2 recv || elem 5 recv || elem 6 recv + then return $ + Left $ PrivacyPolicyError "Receiver not capable of Medium privacy" + else do orchNotes <- getWalletUnspentOrchNotes pool za let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes if a1 > 0 @@ -2124,27 +2137,16 @@ selectUnspentNotesV2 pool za amt recv policy = do 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 + if 0 `elem` recv 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 + if elem 5 recv || elem 6 recv + then return $ + Left $ + PrivacyPolicyError + "Exchange addresses not supported with Low privacy" + else do orchNotes <- getWalletUnspentOrchNotes pool za let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes if a1 > 0 @@ -2152,27 +2154,27 @@ selectUnspentNotesV2 pool za amt recv policy = do sapNotes <- getWalletUnspentSapNotes pool za let (a2, sList) = checkSapling a1 sapNotes if a2 > 0 - then return $ - Left $ - PrivacyPolicyError "Not enough notes for Low privacy" + 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) 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) + if elem 3 recv || elem 4 recv + then return $ + Left $ + PrivacyPolicyError + "Shielded recipients not compatible with privacy policy." + else do + trNotes <- getWalletUnspentTrNotes pool za + let (a3, tList) = checkTransparent (fromIntegral amt) trNotes + if a3 > 0 + then return $ + Left $ PrivacyPolicyError "Insufficient transparent funds" + else return $ Right (tList, [], []) where checkTransparent :: Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote]) diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index b23ff0d..0989634 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -1558,7 +1558,15 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do pool <- runNoLoggingT $ initPool dbPath res <- runFileLoggingT "zenith.log" $ - prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy + prepareTxV2 + pool + zHost + zPort + znet + accId + bl + [ProposedNote (ValidAddressAPI addr) amt (Just memo)] + policy case res of Left e -> sendMsg $ ShowError $ T.pack $ show e Right rawTx -> do diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index e3434e7..fff689f 100644 --- a/src/Zenith/RPC.hs +++ b/src/Zenith/RPC.hs @@ -8,6 +8,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} module Zenith.RPC where @@ -30,8 +32,21 @@ import Database.Esqueleto.Experimental import Servant import Text.Read (readMaybe) import ZcashHaskell.Keys (generateWalletSeedPhrase) -import ZcashHaskell.Orchard (parseAddress) -import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..)) +import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress) +import ZcashHaskell.Sapling (encodeSaplingAddress) +import ZcashHaskell.Transparent + ( encodeExchangeAddress + , encodeTransparentReceiver + ) +import ZcashHaskell.Types + ( ExchangeAddress(..) + , RpcError(..) + , SaplingAddress(..) + , Scope(..) + , TransparentAddress(..) + , ValidAddress(..) + , ZcashNet(..) + ) import Zenith.Core (createCustomWalletAddress, createZcashAccount) import Zenith.DB ( Operation(..) @@ -63,6 +78,9 @@ import Zenith.Types ( AccountBalance(..) , Config(..) , PhraseDB(..) + , PrivacyPolicy(..) + , ProposedNote(..) + , ValidAddressAPI(..) , ZcashAccountAPI(..) , ZcashAddressAPI(..) , ZcashNetDB(..) @@ -83,6 +101,7 @@ data ZenithMethod | GetNewAccount | GetNewAddress | GetOperationStatus + | SendMany | UnknownMethod deriving (Eq, Prelude.Show) @@ -97,6 +116,7 @@ instance ToJSON ZenithMethod where toJSON GetNewAccount = Data.Aeson.String "getnewaccount" toJSON GetNewAddress = Data.Aeson.String "getnewaddress" toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus" + toJSON SendMany = Data.Aeson.String "sendmany" toJSON UnknownMethod = Data.Aeson.Null instance FromJSON ZenithMethod where @@ -112,6 +132,7 @@ instance FromJSON ZenithMethod where "getnewaccount" -> pure GetNewAccount "getnewaddress" -> pure GetNewAddress "getoperationstatus" -> pure GetOperationStatus + "sendmany" -> pure SendMany _ -> pure UnknownMethod data ZenithParams @@ -125,6 +146,7 @@ data ZenithParams | NameIdParams !T.Text !Int | NewAddrParams !Int !T.Text !Bool !Bool | OpParams !ZenithUuid + | SendParams !Int ![ProposedNote] !PrivacyPolicy | TestParams !T.Text deriving (Eq, Prelude.Show) @@ -148,6 +170,8 @@ instance ToJSON ZenithParams where [Data.Aeson.String "ExcludeTransparent" | t] toJSON (OpParams i) = Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i] + toJSON (SendParams i ns p) = + Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p] data ZenithResponse = InfoResponse !T.Text !ZenithInfo @@ -159,6 +183,7 @@ data ZenithResponse | NewItemResponse !T.Text !Int64 | NewAddrResponse !T.Text !ZcashAddressAPI | OpResponse !T.Text !Operation + | SendResponse !T.Text !U.UUID | ErrorResponse !T.Text !Double !T.Text deriving (Eq, Prelude.Show) @@ -179,6 +204,7 @@ instance ToJSON ZenithResponse where toJSON (NewItemResponse i ix) = packRpcResponse i ix toJSON (NewAddrResponse i a) = packRpcResponse i a toJSON (OpResponse i u) = packRpcResponse i u + toJSON (SendResponse i o) = packRpcResponse i o instance FromJSON ZenithResponse where parseJSON = @@ -258,6 +284,10 @@ instance FromJSON ZenithResponse where case floatingOrInteger k of Left _e -> fail "Unknown value" Right k' -> pure $ NewItemResponse i k' + String s -> do + case U.fromText s of + Nothing -> fail "Unknown value" + Just u -> pure $ SendResponse i u _anyOther -> fail "Malformed JSON" Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1) @@ -416,6 +446,25 @@ instance FromJSON RpcCall where Nothing -> pure $ RpcCall v i GetOperationStatus BadParams else pure $ RpcCall v i GetOperationStatus BadParams _anyOther -> pure $ RpcCall v i GetOperationStatus BadParams + SendMany -> do + p <- obj .: "params" + case p of + Array a -> + if V.length a >= 2 + then do + acc <- parseJSON $ a V.! 0 + x <- parseJSON $ a V.! 1 + case x of + String _ -> do + x' <- parseJSON $ a V.! 1 + y <- parseJSON $ a V.! 2 + pure $ RpcCall v i SendMany (SendParams acc y x') + Array _ -> do + x' <- parseJSON $ a V.! 1 + pure $ RpcCall v i SendMany (SendParams acc x' Full) + _anyOther -> pure $ RpcCall v i SendMany BadParams + else pure $ RpcCall v i SendMany BadParams + _anyOther -> pure $ RpcCall v i SendMany BadParams type ZenithRPC = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody @@ -682,6 +731,14 @@ zenithServer state = getinfo :<|> handleRPC ErrorResponse (callId req) (-32009) "Operation ID not found" _anyOtherParams -> return $ ErrorResponse (callId req) (-32602) "Invalid params" + SendMany -> + case parameters req of + SendParams a ns p -> do + let dbPath = w_dbPath state + pool <- liftIO $ runNoLoggingT $ initPool dbPath + undefined + _anyOtherParams -> + return $ ErrorResponse (callId req) (-32602) "Invalid params" authenticate :: Config -> BasicAuthCheck Bool authenticate config = BasicAuthCheck check diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 0a3d58d..18c193d 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -23,13 +23,23 @@ import Data.Text.Encoding.Error (lenientDecode) import qualified Data.UUID as U import Database.Persist.TH import GHC.Generics +import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress) +import ZcashHaskell.Sapling (encodeSaplingAddress) +import ZcashHaskell.Transparent + ( encodeExchangeAddress + , encodeTransparentReceiver + ) import ZcashHaskell.Types - ( OrchardSpendingKey(..) + ( ExchangeAddress(..) + , OrchardSpendingKey(..) , Phrase(..) , Rseed(..) + , SaplingAddress(..) , SaplingSpendingKey(..) , Scope(..) + , TransparentAddress(..) , TransparentSpendingKey + , ValidAddress(..) , ZcashNet(..) ) @@ -207,6 +217,51 @@ data PrivacyPolicy $(deriveJSON defaultOptions ''PrivacyPolicy) +newtype ValidAddressAPI = ValidAddressAPI + { getVA :: ValidAddress + } deriving newtype (Eq, Show) + +instance ToJSON ValidAddressAPI where + toJSON (ValidAddressAPI va) = + case va of + Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua + Sapling sa -> + maybe + Data.Aeson.Null + Data.Aeson.String + (encodeSaplingAddress (net_type sa) (sa_receiver sa)) + Transparent ta -> + Data.Aeson.String $ + encodeTransparentReceiver (ta_network ta) (ta_receiver ta) + Exchange ea -> + maybe + Data.Aeson.Null + Data.Aeson.String + (encodeExchangeAddress (ex_network ea) (ex_address ea)) + +data ProposedNote = ProposedNote + { pn_addr :: !ValidAddressAPI + , pn_amt :: !Float + , pn_memo :: !(Maybe T.Text) + } deriving (Eq, Prelude.Show) + +instance FromJSON ProposedNote where + parseJSON = + withObject "ProposedNote" $ \obj -> do + a <- obj .: "address" + n <- obj .: "amount" + m <- obj .:? "memo" + case parseAddress (E.encodeUtf8 a) of + Nothing -> fail "Invalid address" + Just a' -> + if n > 0 && n < 21000000 + then pure $ ProposedNote (ValidAddressAPI a') n m + else fail "Invalid amount" + +instance ToJSON ProposedNote where + toJSON (ProposedNote a n m) = + object ["address" .= a, "amount" .= n, "memo" .= m] + -- ** `zebrad` -- | Type for modeling the tree state response data ZebraTreeInfo = ZebraTreeInfo diff --git a/test/Spec.hs b/test/Spec.hs index 79c7aaa..ac09115 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -123,55 +123,6 @@ main = do let ua = "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" isValidUnifiedAddress ua `shouldNotBe` Nothing - describe "Function tests" $ do - describe "Sapling Decoding" $ do - let sk = - SaplingSpendingKey - "\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB" - let tree = - SaplingCommitmentTree $ - hexString - "01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39" - let nextTree = - SaplingCommitmentTree $ - hexString - "01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39" - it "Sapling is decoded correctly" $ do - so <- - runSqlite "zenith.db" $ - selectList [ShieldOutputTx ==. toSqlKey 38318] [] - let cmus = map (getHex . shieldOutputCmu . entityVal) so - let pos = - getSaplingNotePosition <$> - (getSaplingWitness =<< - updateSaplingCommitmentTree tree (head cmus)) - let pos1 = getSaplingNotePosition <$> getSaplingWitness tree - let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree - case pos of - Nothing -> assertFailure "couldn't get note position" - Just p -> do - print p - print pos1 - print pos2 - let dn = - decodeSaplingOutputEsk - sk - (ShieldedOutput - (getHex $ shieldOutputCv $ entityVal $ head so) - (getHex $ shieldOutputCmu $ entityVal $ head so) - (getHex $ shieldOutputEphKey $ entityVal $ head so) - (getHex $ shieldOutputEncCipher $ entityVal $ head so) - (getHex $ shieldOutputOutCipher $ entityVal $ head so) - (getHex $ shieldOutputProof $ entityVal $ head so)) - TestNet - External - p - case dn of - Nothing -> assertFailure "couldn't decode Sap output" - Just d -> - a_nullifier d `shouldBe` - hexString - "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" describe "Note selection for Tx" $ do it "Value less than balance" $ do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" @@ -181,10 +132,6 @@ main = do pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" let res = selectUnspentNotes pool (toSqlKey 1) 84000000 res `shouldThrow` anyIOException - it "Fee calculation" $ do - pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" - res <- selectUnspentNotes pool (toSqlKey 1) 14000000 - calculateTxFee res 3 `shouldBe` 20000 describe "Testing validation" $ do it "Unified" $ do let a = @@ -267,9 +214,11 @@ main = do TestNet (toSqlKey 1) 3001331 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + (Just "Sending memo to orchard") + ] Full case tx of Left e -> assertFailure $ show e @@ -291,9 +240,11 @@ main = do TestNet (toSqlKey 4) 3001331 - 0.005 - (fromJust uaRead) - "Sending memo to sapling" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + (Just "Sending memo to sapling") + ] Full case tx of Left e -> assertFailure $ show e @@ -313,13 +264,49 @@ main = do TestNet (toSqlKey 4) 3001331 - 0.005 - (fromJust uaRead) - "" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] Full tx `shouldBe` Left (PrivacyPolicyError "Receiver not capable of Full privacy") + it "To mixed shielded receivers" $ do + let uaRead = + parseAddress + "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" + let uaRead2 = + 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) + 3001331 + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + (Just "Sending memo to orchard") + , ProposedNote + (ValidAddressAPI $ fromJust uaRead2) + 0.004 + Nothing + ] + Full + tx `shouldBe` + Left + (PrivacyPolicyError + "Combination of receivers not allowed for Full privacy") describe "Medium" $ do it "To Orchard" $ do let uaRead = @@ -338,9 +325,11 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + (Just "Sending memo to orchard") + ] Medium case tx of Left e -> assertFailure $ show e @@ -362,9 +351,11 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + (Just "Sending memo to sapling") + ] Medium case tx of Left e -> assertFailure $ show e @@ -384,13 +375,48 @@ main = do TestNet (toSqlKey 4) 3001331 - 0.005 - (fromJust uaRead) - "" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] Medium tx `shouldBe` Left (PrivacyPolicyError "Receiver not capable of Medium privacy") + it "To mixed shielded receivers" $ do + let uaRead = + parseAddress + "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax" + let uaRead2 = + 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) + 3001331 + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + (Just "Sending memo to orchard") + , ProposedNote + (ValidAddressAPI $ fromJust uaRead2) + 0.004 + Nothing + ] + Medium + case tx of + Left e -> assertFailure $ show e + Right h -> h `shouldNotBe` (hexString "deadbeef") describe "Low" $ do it "To Orchard" $ do let uaRead = @@ -409,9 +435,11 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] Low case tx of Left e -> assertFailure $ show e @@ -433,9 +461,11 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] Low case tx of Left e -> assertFailure $ show e @@ -455,9 +485,11 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] Low case tx of Left e -> assertFailure $ show e @@ -480,14 +512,16 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] None tx `shouldBe` Left (PrivacyPolicyError - "Receiver not compatible with privacy policy") + "Shielded recipients not compatible with privacy policy.") it "To Sapling" $ do let uaRead = parseAddress @@ -505,14 +539,16 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "Sending memo to orchard" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] None tx `shouldBe` Left (PrivacyPolicyError - "Receiver not compatible with privacy policy") + "Shielded recipients not compatible with privacy policy.") it "To Transparent" $ do let uaRead = parseAddress "tmAmSa4AauSFuJieeanRBjkfnah45ysGtgZ" case uaRead of @@ -528,9 +564,11 @@ main = do TestNet (toSqlKey 1) 3001372 - 0.005 - (fromJust uaRead) - "" + [ ProposedNote + (ValidAddressAPI $ fromJust uaRead) + 0.005 + Nothing + ] None case tx of Left e -> assertFailure $ show e diff --git a/zenith-openrpc.json b/zenith-openrpc.json index 776bcff..93656a5 100644 --- a/zenith-openrpc.json +++ b/zenith-openrpc.json @@ -746,7 +746,7 @@ "PrivacyPolicy": { "name": "Privacy Policy", "summary": "The chosen privacy policy to use for the transaction", - "description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers. `None` allows for transparent funds to be spent to transparent addresses.", + "description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.", "required": false, "schema": { "type": "string",