diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 623f5c4..83da892 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -24,6 +24,7 @@ import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import qualified Data.ByteString as BS import Data.HexString +import Data.Int import Data.List (group, sort) import Data.Maybe (catMaybes, fromJust, isJust) import Data.Pool (Pool) @@ -72,6 +73,7 @@ import Zenith.Types , ZcashAccountAPI(..) , ZcashAddressAPI(..) , ZcashNetDB(..) + , ZcashNoteAPI(..) , ZcashPool(..) , ZcashWalletAPI(..) ) @@ -126,24 +128,24 @@ share tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade address WalletAddressId OnDeleteCascade OnUpdateCascade - value Word64 + value Int64 spent Bool script BS.ByteString change Bool - position Word64 + position Int UniqueTNote tx script deriving Show Eq WalletTrSpend tx WalletTransactionId OnDeleteCascade OnUpdateCascade note WalletTrNoteId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 + value Int64 UniqueTrSpend tx accId deriving Show Eq WalletSapNote tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 + value Int64 recipient BS.ByteString memo T.Text spent Bool @@ -159,18 +161,18 @@ share tx WalletTransactionId OnDeleteCascade OnUpdateCascade note WalletSapNoteId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 + value Int64 UniqueSapSepnd tx accId deriving Show Eq WalletOrchNote tx WalletTransactionId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 + value Int64 recipient BS.ByteString memo T.Text spent Bool nullifier HexStringDB - position Word64 + position Int64 witness HexStringDB change Bool witPos OrchActionId OnDeleteIgnore OnUpdateIgnore @@ -182,7 +184,7 @@ share tx WalletTransactionId OnDeleteCascade OnUpdateCascade note WalletOrchNoteId OnDeleteCascade OnUpdateCascade accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 + value Int64 UniqueOrchSpend tx accId deriving Show Eq ZcashTransaction @@ -195,7 +197,7 @@ share deriving Show Eq TransparentNote tx ZcashTransactionId - value Word64 + value Int64 script BS.ByteString position Int UniqueTNPos tx position @@ -301,6 +303,68 @@ toZcashAddressAPI a = (isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a))) +-- | @WalletTrNote@ +trToZcashNoteAPI :: ConnectionPool -> Entity WalletTrNote -> IO ZcashNoteAPI +trToZcashNoteAPI pool n = do + t <- getWalletTransaction pool $ walletTrNoteTx $ entityVal n + case t of + Nothing -> throwIO $ userError "Unable to find transaction" + Just t' -> do + return $ + ZcashNoteAPI + (getHex $ walletTransactionTxId $ entityVal t') -- tx ID + Transparent -- pool + (fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec + (walletTrNoteValue $ entityVal n) -- zats + "" -- memo + (walletTransactionConf (entityVal t') >= 10) -- confirmed + (walletTransactionBlock $ entityVal t') -- blockheight + (walletTransactionTime $ entityVal t') -- blocktime + (walletTrNotePosition $ entityVal n) -- outindex + (walletTrNoteChange $ entityVal n) -- change + +-- | @WalletSapNote@ +sapToZcashNoteAPI :: ConnectionPool -> Entity WalletSapNote -> IO ZcashNoteAPI +sapToZcashNoteAPI pool n = do + t <- getWalletTransaction pool $ walletSapNoteTx $ entityVal n + oi <- getSaplingOutIndex pool $ walletSapNoteWitPos $ entityVal n + case t of + Nothing -> throwIO $ userError "Unable to find transaction" + Just t' -> do + return $ + ZcashNoteAPI + (getHex $ walletTransactionTxId $ entityVal t') -- tx ID + Sapling -- pool + (fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec + (walletSapNoteValue $ entityVal n) -- zats + (walletSapNoteMemo $ entityVal n) -- memo + (walletTransactionConf (entityVal t') >= 10) -- confirmed + (walletTransactionBlock $ entityVal t') -- blockheight + (walletTransactionTime $ entityVal t') -- blocktime + oi -- outindex + (walletSapNoteChange $ entityVal n) -- change + +-- | @WalletOrchNote@ +orchToZcashNoteAPI :: ConnectionPool -> Entity WalletOrchNote -> IO ZcashNoteAPI +orchToZcashNoteAPI pool n = do + t <- getWalletTransaction pool $ walletOrchNoteTx $ entityVal n + oi <- getOrchardOutIndex pool $ walletOrchNoteWitPos $ entityVal n + case t of + Nothing -> throwIO $ userError "Unable to find transaction" + Just t' -> do + return $ + ZcashNoteAPI + (getHex $ walletTransactionTxId $ entityVal t') -- tx ID + Sapling -- pool + (fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec + (walletOrchNoteValue $ entityVal n) -- zats + (walletOrchNoteMemo $ entityVal n) -- memo + (walletTransactionConf (entityVal t') >= 10) -- confirmed + (walletTransactionBlock $ entityVal t') -- blockheight + (walletTransactionTime $ entityVal t') -- blocktime + oi -- outindex + (walletOrchNoteChange $ entityVal n) -- change + -- * Database functions -- | Initializes the database initDb :: @@ -376,6 +440,26 @@ getWallets pool n = where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n)) pure wallets +getNetwork :: ConnectionPool -> WalletAddressId -> IO ZcashNet +getNetwork pool a = do + n <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + selectOne $ do + (wallet :& acc :& addr) <- + from $ table @ZcashWallet `innerJoin` table @ZcashAccount `on` + (\(wallet :& acc) -> + wallet ^. ZcashWalletId ==. acc ^. ZcashAccountWalletId) `innerJoin` + table @WalletAddress `on` + (\(_ :& acc :& addr) -> + acc ^. ZcashAccountId ==. addr ^. WalletAddressAccId) + where_ (addr ^. WalletAddressId ==. val a) + pure $ wallet ^. ZcashWalletNetwork + case n of + Nothing -> throwIO $ userError "Failed to find wallet" + Just (Value n') -> return $ getNet n' + -- | Save a new wallet to the database saveWallet :: ConnectionPool -- ^ The database path to use @@ -954,6 +1038,59 @@ getOrchardActions pool b net = [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] pure (txs, oActions) +getWalletNotes :: + ConnectionPool -- ^ database path + -> Entity WalletAddress + -> IO [ZcashNoteAPI] +getWalletNotes pool w = do + let w' = entityVal w + let tReceiver = t_rec =<< readUnifiedAddressDB w' + let sReceiver = s_rec =<< readUnifiedAddressDB w' + let oReceiver = o_rec =<< readUnifiedAddressDB w' + 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 + 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 + 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 + trNotes' <- mapM (trToZcashNoteAPI pool) trNotes + sapNotes' <- mapM (sapToZcashNoteAPI pool) sapNotes + orchNotes' <- mapM (orchToZcashNoteAPI pool) orchNotes + return $ trNotes' <> sapNotes' <> orchNotes' + -- | Get the transactions belonging to the given address getWalletTransactions :: ConnectionPool -- ^ database path @@ -1182,6 +1319,19 @@ getWalletTransactions pool w = do where_ (t ^. UserTxId ==. val (entityKey uTx)) return () +getWalletTransaction :: + ConnectionPool + -> WalletTransactionId + -> IO (Maybe (Entity WalletTransaction)) +getWalletTransaction pool i = + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + selectOne $ do + trs <- from $ table @WalletTransaction + where_ (trs ^. WalletTransactionId ==. val i) + pure trs + getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx] getUserTx pool aId = do runNoLoggingT $ @@ -1241,7 +1391,7 @@ findTransparentSpends pool za = do (trSpends ^. TransparentSpendOutPointHash ==. val flipTxId) where_ (trSpends ^. TransparentSpendOutPointIndex ==. - val (walletTrNotePosition $ entityVal n)) + val (fromIntegral $ walletTrNotePosition $ entityVal n)) pure (tx, trSpends) if null s then return () @@ -1478,6 +1628,34 @@ upsertWalTx zt za = (zcashTransactionTime zt)) [] +getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int +getSaplingOutIndex pool i = do + o <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + selectOne $ do + sout <- from $ table @ShieldOutput + where_ (sout ^. ShieldOutputId ==. val i) + pure $ sout ^. ShieldOutputPosition + case o of + Nothing -> throwIO $ userError "couldn't find shielded output" + Just (Value o') -> return o' + +getOrchardOutIndex :: ConnectionPool -> OrchActionId -> IO Int +getOrchardOutIndex pool i = do + o <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + selectOne $ do + sout <- from $ table @OrchAction + where_ (sout ^. OrchActionId ==. val i) + pure $ sout ^. OrchActionPosition + case o of + Nothing -> throwIO $ userError "couldn't find orchard action" + Just (Value o') -> return o' + getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer getBalance pool za = do trNotes <- getWalletUnspentTrNotes pool za @@ -1731,7 +1909,7 @@ selectUnspentNotes pool za amt = do else return (tList, [], []) where checkTransparent :: - Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote]) + Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote]) checkTransparent x [] = (x, []) checkTransparent x (n:ns) = if walletTrNoteValue (entityVal n) < x @@ -1740,7 +1918,7 @@ selectUnspentNotes pool za amt = do snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)) else (0, [n]) checkSapling :: - Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote]) + Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote]) checkSapling x [] = (x, []) checkSapling x (n:ns) = if walletSapNoteValue (entityVal n) < x @@ -1748,7 +1926,7 @@ selectUnspentNotes pool za amt = do , n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns)) else (0, [n]) checkOrchard :: - Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote]) + Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote]) checkOrchard x [] = (x, []) checkOrchard x (n:ns) = if walletOrchNoteValue (entityVal n) < x diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index 3df1d4b..67835bd 100644 --- a/src/Zenith/RPC.hs +++ b/src/Zenith/RPC.hs @@ -15,10 +15,12 @@ import Control.Exception (try) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger (runNoLoggingT) import Data.Aeson +import Data.Int import qualified Data.Text as T import qualified Data.Vector as V import Database.Esqueleto.Experimental (toSqlKey) import Servant +import Text.Read (readMaybe) import ZcashHaskell.Types ( RpcError(..) , ZcashNet(..) @@ -28,9 +30,10 @@ import ZcashHaskell.Types import Zenith.Core (checkBlockChain, checkZebra) import Zenith.DB ( getAccounts + , getAddressById , getAddresses + , getWalletNotes , getWallets - , initDb , initPool , toZcashAccountAPI , toZcashAddressAPI @@ -358,7 +361,23 @@ zenithServer config = getinfo :<|> handleRPC return $ ErrorResponse (callId req) (-32602) "Invalid params" ListReceived -> case parameters req of - NotesParams x -> undefined + NotesParams x -> do + case (readMaybe (T.unpack x) :: Maybe Int64) of + Just x' -> do + let dbPath = c_dbPath config + pool <- liftIO $ runNoLoggingT $ initPool dbPath + a <- liftIO $ getAddressById pool $ toSqlKey x' + case a of + Just a' -> do + nList <- liftIO $ getWalletNotes pool a' + return $ NoteListResponse (callId req) nList + Nothing -> + return $ + ErrorResponse + (callId req) + (-32004) + "Address does not belong to the wallet" + Nothing -> undefined -- search by address _anyOtherParams -> return $ ErrorResponse (callId req) (-32602) "Invalid params" diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index ee70177..987c994 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -167,8 +167,8 @@ data ZcashNoteAPI = ZcashNoteAPI , zn_amountZats :: !Int64 , zn_memo :: !T.Text , zn_confirmed :: !Bool - , zn_blockheight :: !Int64 - , zn_blocktime :: !Int64 + , zn_blockheight :: !Int + , zn_blocktime :: !Int , zn_outindex :: !Int , zn_change :: !Bool } deriving (Eq, Prelude.Show) diff --git a/zenith.cabal b/zenith.cabal index af39c96..d192ba1 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -40,55 +40,55 @@ library src build-depends: Clipboard + , Hclip + , JuicyPixels , aeson , array - , async , ascii-progress + , async , base >=4.12 && <5 , base64-bytestring + , binary , brick , bytestring , configurator , data-default , directory - , filepath , esqueleto - , resource-pool - , binary , exceptions - , monad-logger - , vty-crossplatform - , secp256k1-haskell >= 1 - , pureMD5 + , filepath , ghc , haskoin-core , hexstring , http-client , http-conduit , http-types - , JuicyPixels - , qrcode-core - , qrcode-juicypixels , microlens , microlens-mtl , microlens-th + , monad-logger , monomer , mtl , persistent - , Hclip , persistent-sqlite , persistent-template , process + , pureMD5 + , qrcode-core + , qrcode-juicypixels , regex-base , regex-compat , regex-posix + , resource-pool , scientific + , secp256k1-haskell >= 1 , servant-server , text , text-show , time , vector , vty + , vty-crossplatform , word-wrap , zcash-haskell --pkgconfig-depends: rustzcash_wrapper