Implement listreceived
This commit is contained in:
parent
b75ed16a3e
commit
66767da36a
8 changed files with 203 additions and 98 deletions
|
@ -645,7 +645,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|||
flipTxId
|
||||
(fromIntegral $ walletTrNotePosition $ entityVal n))
|
||||
(RawTxOut
|
||||
(walletTrNoteValue $ entityVal n)
|
||||
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||
(walletTrNoteScript $ entityVal n))
|
||||
prepSSpends ::
|
||||
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
|
|
173
src/Zenith/DB.hs
173
src/Zenith/DB.hs
|
@ -20,7 +20,7 @@ module Zenith.DB where
|
|||
|
||||
import Control.Exception (SomeException(..), throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.HexString
|
||||
|
@ -42,23 +42,33 @@ import Haskoin.Transaction.Common
|
|||
)
|
||||
import System.Directory (doesFileExist, getHomeDirectory, removeFile)
|
||||
import System.FilePath ((</>))
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Orchard
|
||||
( compareAddress
|
||||
, getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Types
|
||||
( DecodedNote(..)
|
||||
, ExchangeAddress(..)
|
||||
, OrchardAction(..)
|
||||
, OrchardBundle(..)
|
||||
, OrchardReceiver(..)
|
||||
, OrchardWitness(..)
|
||||
, SaplingAddress(..)
|
||||
, SaplingBundle(..)
|
||||
, SaplingReceiver(..)
|
||||
, SaplingWitness(..)
|
||||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
, ShieldedSpend(..)
|
||||
, ToBytes(..)
|
||||
, Transaction(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentBundle(..)
|
||||
, TransparentReceiver(..)
|
||||
, UnifiedAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import Zenith.Types
|
||||
|
@ -313,7 +323,7 @@ trToZcashNoteAPI pool n = do
|
|||
return $
|
||||
ZcashNoteAPI
|
||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||
Transparent -- pool
|
||||
Zenith.Types.Transparent -- pool
|
||||
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||
(walletTrNoteValue $ entityVal n) -- zats
|
||||
"" -- memo
|
||||
|
@ -334,7 +344,7 @@ sapToZcashNoteAPI pool n = do
|
|||
return $
|
||||
ZcashNoteAPI
|
||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||
Sapling -- pool
|
||||
Zenith.Types.Sapling -- pool
|
||||
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||
(walletSapNoteValue $ entityVal n) -- zats
|
||||
(walletSapNoteMemo $ entityVal n) -- memo
|
||||
|
@ -355,7 +365,7 @@ orchToZcashNoteAPI pool n = do
|
|||
return $
|
||||
ZcashNoteAPI
|
||||
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID
|
||||
Sapling -- pool
|
||||
Orchard
|
||||
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
|
||||
(walletOrchNoteValue $ entityVal n) -- zats
|
||||
(walletOrchNoteMemo $ entityVal n) -- memo
|
||||
|
@ -1038,6 +1048,66 @@ getOrchardActions pool b net =
|
|||
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
|
||||
pure (txs, oActions)
|
||||
|
||||
findNotesByAddress ::
|
||||
ConnectionPool -> ValidAddress -> Entity WalletAddress -> IO [ZcashNoteAPI]
|
||||
findNotesByAddress pool va addr = do
|
||||
let ua =
|
||||
isValidUnifiedAddress
|
||||
((TE.encodeUtf8 . getUA . walletAddressUAddress . entityVal) addr)
|
||||
case ua of
|
||||
Just ua' -> do
|
||||
if compareAddress va ua'
|
||||
then do
|
||||
case va of
|
||||
Unified _ -> getWalletNotes pool addr
|
||||
ZcashHaskell.Types.Sapling s -> do
|
||||
n <- getSapNotes pool $ sa_receiver s
|
||||
mapM (sapToZcashNoteAPI pool) n
|
||||
ZcashHaskell.Types.Transparent t -> do
|
||||
n <- getTrNotes pool $ ta_receiver t
|
||||
mapM (trToZcashNoteAPI pool) n
|
||||
Exchange e -> do
|
||||
n <- getTrNotes pool $ ex_address e
|
||||
mapM (trToZcashNoteAPI pool) n
|
||||
else return []
|
||||
Nothing -> return []
|
||||
|
||||
getTrNotes :: ConnectionPool -> TransparentReceiver -> IO [Entity WalletTrNote]
|
||||
getTrNotes pool tr = do
|
||||
let s =
|
||||
BS.concat
|
||||
[ BS.pack [0x76, 0xA9, 0x14]
|
||||
, (toBytes . tr_bytes) tr
|
||||
, BS.pack [0x88, 0xAC]
|
||||
]
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
tnotes <- from $ table @WalletTrNote
|
||||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||
pure tnotes
|
||||
|
||||
getSapNotes :: ConnectionPool -> SaplingReceiver -> IO [Entity WalletSapNote]
|
||||
getSapNotes pool sr = do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
snotes <- from $ table @WalletSapNote
|
||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sr))
|
||||
pure snotes
|
||||
|
||||
getOrchNotes :: ConnectionPool -> OrchardReceiver -> IO [Entity WalletOrchNote]
|
||||
getOrchNotes pool o = do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
onotes <- from $ table @WalletOrchNote
|
||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes o))
|
||||
pure onotes
|
||||
|
||||
getWalletNotes ::
|
||||
ConnectionPool -- ^ database path
|
||||
-> Entity WalletAddress
|
||||
|
@ -1050,42 +1120,15 @@ getWalletNotes pool w = do
|
|||
trNotes <-
|
||||
case tReceiver of
|
||||
Nothing -> return []
|
||||
Just tR -> do
|
||||
let s =
|
||||
BS.concat
|
||||
[ BS.pack [0x76, 0xA9, 0x14]
|
||||
, (toBytes . tr_bytes) tR
|
||||
, BS.pack [0x88, 0xAC]
|
||||
]
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
tnotes <- from $ table @WalletTrNote
|
||||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||
pure tnotes
|
||||
Just tR -> getTrNotes pool tR
|
||||
sapNotes <-
|
||||
case sReceiver of
|
||||
Nothing -> return []
|
||||
Just sR -> do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
snotes <- from $ table @WalletSapNote
|
||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
||||
pure snotes
|
||||
Just sR -> getSapNotes pool sR
|
||||
orchNotes <-
|
||||
case oReceiver of
|
||||
Nothing -> return []
|
||||
Just oR -> do
|
||||
runNoLoggingT $
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
onotes <- from $ table @WalletOrchNote
|
||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
||||
pure onotes
|
||||
Just oR -> getOrchNotes pool oR
|
||||
trNotes' <- mapM (trToZcashNoteAPI pool) trNotes
|
||||
sapNotes' <- mapM (sapToZcashNoteAPI pool) sapNotes
|
||||
orchNotes' <- mapM (orchToZcashNoteAPI pool) orchNotes
|
||||
|
@ -1108,35 +1151,11 @@ getWalletTransactions pool w = do
|
|||
trNotes <-
|
||||
case tReceiver of
|
||||
Nothing -> return []
|
||||
Just tR -> do
|
||||
let s =
|
||||
BS.concat
|
||||
[ BS.pack [0x76, 0xA9, 0x14]
|
||||
, (toBytes . tr_bytes) tR
|
||||
, BS.pack [0x88, 0xAC]
|
||||
]
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
tnotes <- from $ table @WalletTrNote
|
||||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||
pure tnotes
|
||||
Just tR -> liftIO $ getTrNotes pool tR
|
||||
trChgNotes <-
|
||||
case ctReceiver of
|
||||
Nothing -> return []
|
||||
Just tR -> do
|
||||
let s1 =
|
||||
BS.concat
|
||||
[ BS.pack [0x76, 0xA9, 0x14]
|
||||
, (toBytes . tr_bytes) tR
|
||||
, BS.pack [0x88, 0xAC]
|
||||
]
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
tnotes <- from $ table @WalletTrNote
|
||||
where_ (tnotes ^. WalletTrNoteScript ==. val s1)
|
||||
pure tnotes
|
||||
Just tR -> liftIO $ getTrNotes pool tR
|
||||
trSpends <-
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
|
@ -1149,44 +1168,20 @@ getWalletTransactions pool w = do
|
|||
sapNotes <-
|
||||
case sReceiver of
|
||||
Nothing -> return []
|
||||
Just sR -> do
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
snotes <- from $ table @WalletSapNote
|
||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
||||
pure snotes
|
||||
Just sR -> liftIO $ getSapNotes pool sR
|
||||
sapChgNotes <-
|
||||
case csReceiver of
|
||||
Nothing -> return []
|
||||
Just sR -> do
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
snotes <- from $ table @WalletSapNote
|
||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
||||
pure snotes
|
||||
Just sR -> liftIO $ getSapNotes pool sR
|
||||
sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes)
|
||||
orchNotes <-
|
||||
case oReceiver of
|
||||
Nothing -> return []
|
||||
Just oR -> do
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
onotes <- from $ table @WalletOrchNote
|
||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
||||
pure onotes
|
||||
Just oR -> liftIO $ getOrchNotes pool oR
|
||||
orchChgNotes <-
|
||||
case coReceiver of
|
||||
Nothing -> return []
|
||||
Just oR -> do
|
||||
PS.retryOnBusy $
|
||||
flip PS.runSqlPool pool $ do
|
||||
select $ do
|
||||
onotes <- from $ table @WalletOrchNote
|
||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
||||
pure onotes
|
||||
Just oR -> liftIO $ getOrchNotes pool oR
|
||||
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
|
||||
clearUserTx (entityKey w)
|
||||
mapM_ addTr trNotes
|
||||
|
|
|
@ -17,21 +17,26 @@ import Control.Monad.Logger (runNoLoggingT)
|
|||
import Data.Aeson
|
||||
import Data.Int
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Vector as V
|
||||
import Database.Esqueleto.Experimental (toSqlKey)
|
||||
import Servant
|
||||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Orchard (parseAddress)
|
||||
import ZcashHaskell.Types
|
||||
( RpcError(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
, ZebraGetInfo(..)
|
||||
)
|
||||
import Zenith.Core (checkBlockChain, checkZebra)
|
||||
import Zenith.DB
|
||||
( getAccounts
|
||||
( findNotesByAddress
|
||||
, getAccounts
|
||||
, getAddressById
|
||||
, getAddresses
|
||||
, getExternalAddresses
|
||||
, getWalletNotes
|
||||
, getWallets
|
||||
, initPool
|
||||
|
@ -377,7 +382,22 @@ zenithServer config = getinfo :<|> handleRPC
|
|||
(callId req)
|
||||
(-32004)
|
||||
"Address does not belong to the wallet"
|
||||
Nothing -> undefined -- search by address
|
||||
Nothing ->
|
||||
case parseAddress (E.encodeUtf8 x) of
|
||||
Nothing ->
|
||||
return $
|
||||
ErrorResponse
|
||||
(callId req)
|
||||
(-32005)
|
||||
"Unable to parse address"
|
||||
Just x' -> do
|
||||
let dbPath = c_dbPath config
|
||||
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
||||
addrs <- liftIO $ getExternalAddresses pool
|
||||
nList <-
|
||||
liftIO $
|
||||
concat <$> mapM (findNotesByAddress pool x') addrs
|
||||
return $ NoteListResponse (callId req) nList
|
||||
_anyOtherParams ->
|
||||
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
||||
|
||||
|
|
|
@ -103,7 +103,7 @@ isRecipientValid a =
|
|||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||
Just _a4 -> True
|
||||
Nothing -> False)
|
||||
|
||||
|
|
|
@ -153,6 +153,43 @@ main = do
|
|||
"zh"
|
||||
(-32003)
|
||||
"No addresses available for this account. Please create one first"
|
||||
describe "Notes" $ do
|
||||
describe "listreceived" $ do
|
||||
it "bad credentials" $ do
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
"baduser"
|
||||
"idontknow"
|
||||
ListReceived
|
||||
BlankParams
|
||||
res `shouldBe` Left "Invalid credentials"
|
||||
describe "correct credentials" $ do
|
||||
it "no parameters" $ do
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
ListReceived
|
||||
BlankParams
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||
it "unknown index" $ do
|
||||
res <-
|
||||
makeZenithCall
|
||||
"127.0.0.1"
|
||||
nodePort
|
||||
nodeUser
|
||||
nodePwd
|
||||
ListReceived
|
||||
(NotesParams "17")
|
||||
case res of
|
||||
Left e -> assertFailure e
|
||||
Right (ErrorResponse i c m) -> c `shouldBe` (-32004)
|
||||
|
||||
startAPI :: Config -> IO ()
|
||||
startAPI config = do
|
||||
|
|
|
@ -195,7 +195,7 @@ main = do
|
|||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||
Just _a4 -> True
|
||||
Nothing -> False))
|
||||
it "Sapling" $ do
|
||||
|
@ -209,7 +209,7 @@ main = do
|
|||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
case decodeExchangeAddress (En.encodeUtf8 a) of
|
||||
Just _a4 -> True
|
||||
Nothing -> False))
|
||||
it "Transparent" $ do
|
||||
|
@ -222,7 +222,7 @@ main = do
|
|||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||
Just _a4 -> True
|
||||
Nothing -> False))
|
||||
it "Check Sapling Address" $ do
|
||||
|
|
|
@ -1 +1 @@
|
|||
Subproject commit cc72fadef36ee8ac235dfd9b8bea4de4ce3122bf
|
||||
Subproject commit 939ae687e8485f5ffce2f09d49c23aac7e14bf72
|
|
@ -270,7 +270,55 @@
|
|||
"$ref": "#/components/schemas/ZcashNote"
|
||||
}
|
||||
}
|
||||
}
|
||||
},
|
||||
"examples": [
|
||||
{
|
||||
"name": "ListReceived by Id",
|
||||
"summary": "Get list of notes received by the address ID",
|
||||
"description": "Provides the list of notes received by the address identified by the index provided as a parameter",
|
||||
"params": [
|
||||
{
|
||||
"name": "Address index",
|
||||
"summary": "The index for the address to use",
|
||||
"value": "1"
|
||||
}
|
||||
],
|
||||
"result": {
|
||||
"name": "ListReceived by Id result",
|
||||
"value": [
|
||||
{
|
||||
"txid": "987fcdb9bd37cbb5b205a8336de60d043f7028bebaa372828d81f3da296c7ef9",
|
||||
"pool": "p2pkh",
|
||||
"amount": 0.13773064,
|
||||
"amountZats": 13773064,
|
||||
"memo": "",
|
||||
"confirmed": true,
|
||||
"blockheight": 2767099,
|
||||
"blocktime": 1711132723,
|
||||
"outindex": 0,
|
||||
"change": false
|
||||
},
|
||||
{
|
||||
"txid": "186bdbc64f728c9d0be96082e946a9228153e24a70e20d8a82f0601da679e0c2",
|
||||
"pool": "orchard",
|
||||
"amount": 0.0005,
|
||||
"amountZats": 50000,
|
||||
"memo": "<22>",
|
||||
"confirmed": true,
|
||||
"blockheight": 2801820,
|
||||
"blocktime": 1713399060,
|
||||
"outindex": 0,
|
||||
"change": false
|
||||
}
|
||||
]
|
||||
}
|
||||
}
|
||||
],
|
||||
"errors": [
|
||||
{ "$ref": "#/components/errors/ZebraNotAvailable" },
|
||||
{ "$ref": "#/components/errors/UnknownAddress" },
|
||||
{ "$ref": "#/components/errors/InvalidAddress" }
|
||||
]
|
||||
},
|
||||
{
|
||||
"name": "sendmany",
|
||||
|
@ -406,7 +454,12 @@
|
|||
"UnknownAddress": {
|
||||
"code": -32004,
|
||||
"message": "Address does not belong to the wallet"
|
||||
},
|
||||
"InvalidAddress": {
|
||||
"code": -32005,
|
||||
"message": "Unable to parse address"
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
Loading…
Reference in a new issue