feat(core): support for multiple outputs per transaction

This commit is contained in:
Rene Vergara 2024-10-04 12:46:44 -05:00
parent 86b881e752
commit a0b9d4178a
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
7 changed files with 483 additions and 291 deletions

View file

@ -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]

View file

@ -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])

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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",