697 lines
26 KiB
Haskell
697 lines
26 KiB
Haskell
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
|
|
module Zenith.RPC where
|
|
|
|
import Control.Exception (try)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Logger (runNoLoggingT)
|
|
import Data.Aeson
|
|
import Data.Int
|
|
import Data.Scientific (floatingOrInteger)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import qualified Data.UUID as U
|
|
import qualified Data.Vector as V
|
|
import Database.Esqueleto.Experimental
|
|
( entityKey
|
|
, entityVal
|
|
, fromSqlKey
|
|
, toSqlKey
|
|
)
|
|
import Servant
|
|
import Text.Read (readMaybe)
|
|
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
|
import ZcashHaskell.Orchard (parseAddress)
|
|
import ZcashHaskell.Types (RpcError(..), Scope(..), ZcashNet(..))
|
|
import Zenith.Core (createCustomWalletAddress, createZcashAccount)
|
|
import Zenith.DB
|
|
( Operation(..)
|
|
, ZcashAccount(..)
|
|
, ZcashWallet(..)
|
|
, findNotesByAddress
|
|
, getAccountById
|
|
, getAccounts
|
|
, getAddressById
|
|
, getAddresses
|
|
, getExternalAddresses
|
|
, getMaxAccount
|
|
, getMaxAddress
|
|
, getOperation
|
|
, getPoolBalance
|
|
, getUnconfPoolBalance
|
|
, getWalletNotes
|
|
, getWallets
|
|
, initPool
|
|
, saveAccount
|
|
, saveAddress
|
|
, saveWallet
|
|
, toZcashAccountAPI
|
|
, toZcashAddressAPI
|
|
, toZcashWalletAPI
|
|
, walletExists
|
|
)
|
|
import Zenith.Types
|
|
( AccountBalance(..)
|
|
, Config(..)
|
|
, PhraseDB(..)
|
|
, ZcashAccountAPI(..)
|
|
, ZcashAddressAPI(..)
|
|
, ZcashNetDB(..)
|
|
, ZcashNoteAPI(..)
|
|
, ZcashWalletAPI(..)
|
|
, ZenithUuid(..)
|
|
)
|
|
import Zenith.Utils (jsonNumber)
|
|
|
|
data ZenithMethod
|
|
= GetInfo
|
|
| ListWallets
|
|
| ListAccounts
|
|
| ListAddresses
|
|
| ListReceived
|
|
| GetBalance
|
|
| GetNewWallet
|
|
| GetNewAccount
|
|
| GetNewAddress
|
|
| GetOperationStatus
|
|
| UnknownMethod
|
|
deriving (Eq, Prelude.Show)
|
|
|
|
instance ToJSON ZenithMethod where
|
|
toJSON GetInfo = Data.Aeson.String "getinfo"
|
|
toJSON ListWallets = Data.Aeson.String "listwallets"
|
|
toJSON ListAccounts = Data.Aeson.String "listaccounts"
|
|
toJSON ListAddresses = Data.Aeson.String "listaddresses"
|
|
toJSON ListReceived = Data.Aeson.String "listreceived"
|
|
toJSON GetBalance = Data.Aeson.String "getbalance"
|
|
toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
|
|
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
|
|
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
|
|
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
|
|
toJSON UnknownMethod = Data.Aeson.Null
|
|
|
|
instance FromJSON ZenithMethod where
|
|
parseJSON =
|
|
withText "ZenithMethod" $ \case
|
|
"getinfo" -> pure GetInfo
|
|
"listwallets" -> pure ListWallets
|
|
"listaccounts" -> pure ListAccounts
|
|
"listaddresses" -> pure ListAddresses
|
|
"listreceived" -> pure ListReceived
|
|
"getbalance" -> pure GetBalance
|
|
"getnewwallet" -> pure GetNewWallet
|
|
"getnewaccount" -> pure GetNewAccount
|
|
"getnewaddress" -> pure GetNewAddress
|
|
"getoperationstatus" -> pure GetOperationStatus
|
|
_ -> pure UnknownMethod
|
|
|
|
data ZenithParams
|
|
= BlankParams
|
|
| BadParams
|
|
| AccountsParams !Int
|
|
| AddressesParams !Int
|
|
| NotesParams !T.Text
|
|
| BalanceParams !Int64
|
|
| NameParams !T.Text
|
|
| NameIdParams !T.Text !Int
|
|
| NewAddrParams !Int !T.Text !Bool !Bool
|
|
| OpParams !ZenithUuid
|
|
| TestParams !T.Text
|
|
deriving (Eq, Prelude.Show)
|
|
|
|
instance ToJSON ZenithParams where
|
|
toJSON BlankParams = Data.Aeson.Array V.empty
|
|
toJSON BadParams = Data.Aeson.Null
|
|
toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
|
|
toJSON (AddressesParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
|
|
toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
|
|
toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
|
|
toJSON (NameParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
|
|
toJSON (NameIdParams t i) =
|
|
Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
|
|
toJSON (BalanceParams n) =
|
|
Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
|
|
toJSON (NewAddrParams a n s t) =
|
|
Data.Aeson.Array $
|
|
V.fromList $
|
|
[jsonNumber a, Data.Aeson.String n] <>
|
|
[Data.Aeson.String "ExcludeSapling" | s] <>
|
|
[Data.Aeson.String "ExcludeTransparent" | t]
|
|
toJSON (OpParams i) =
|
|
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
|
|
|
|
data ZenithResponse
|
|
= InfoResponse !T.Text !ZenithInfo
|
|
| WalletListResponse !T.Text ![ZcashWalletAPI]
|
|
| AccountListResponse !T.Text ![ZcashAccountAPI]
|
|
| AddressListResponse !T.Text ![ZcashAddressAPI]
|
|
| NoteListResponse !T.Text ![ZcashNoteAPI]
|
|
| BalanceResponse !T.Text !AccountBalance !AccountBalance
|
|
| NewItemResponse !T.Text !Int64
|
|
| NewAddrResponse !T.Text !ZcashAddressAPI
|
|
| OpResponse !T.Text !Operation
|
|
| ErrorResponse !T.Text !Double !T.Text
|
|
deriving (Eq, Prelude.Show)
|
|
|
|
instance ToJSON ZenithResponse where
|
|
toJSON (InfoResponse t i) = packRpcResponse t i
|
|
toJSON (WalletListResponse i w) = packRpcResponse i w
|
|
toJSON (AccountListResponse i a) = packRpcResponse i a
|
|
toJSON (AddressListResponse i a) = packRpcResponse i a
|
|
toJSON (NoteListResponse i n) = packRpcResponse i n
|
|
toJSON (ErrorResponse i c m) =
|
|
object
|
|
[ "jsonrpc" .= ("2.0" :: String)
|
|
, "id" .= i
|
|
, "error" .= object ["code" .= c, "message" .= m]
|
|
]
|
|
toJSON (BalanceResponse i c u) =
|
|
packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
|
|
toJSON (NewItemResponse i ix) = packRpcResponse i ix
|
|
toJSON (NewAddrResponse i a) = packRpcResponse i a
|
|
toJSON (OpResponse i u) = packRpcResponse i u
|
|
|
|
instance FromJSON ZenithResponse where
|
|
parseJSON =
|
|
withObject "ZenithResponse" $ \obj -> do
|
|
jr <- obj .: "jsonrpc"
|
|
i <- obj .: "id"
|
|
e <- obj .:? "error"
|
|
r <- obj .:? "result"
|
|
if jr /= ("2.0" :: String)
|
|
then fail "Malformed JSON"
|
|
else do
|
|
case e of
|
|
Nothing -> do
|
|
case r of
|
|
Nothing -> fail "Malformed JSON"
|
|
Just r1 ->
|
|
case r1 of
|
|
Object k -> do
|
|
v <- k .:? "version"
|
|
v5 <- k .:? "unconfirmed"
|
|
v6 <- k .:? "ua"
|
|
v7 <- k .:? "uuid"
|
|
case (v :: Maybe String) of
|
|
Just _v' -> do
|
|
k1 <- parseJSON r1
|
|
pure $ InfoResponse i k1
|
|
Nothing ->
|
|
case (v5 :: Maybe AccountBalance) of
|
|
Just _v5' -> do
|
|
k6 <- parseJSON r1
|
|
j1 <- k6 .: "confirmed"
|
|
j2 <- k6 .: "unconfirmed"
|
|
pure $ BalanceResponse i j1 j2
|
|
Nothing ->
|
|
case (v6 :: Maybe String) of
|
|
Just _v6' -> do
|
|
k7 <- parseJSON r1
|
|
pure $ NewAddrResponse i k7
|
|
Nothing ->
|
|
case (v7 :: Maybe U.UUID) of
|
|
Just _v7' -> do
|
|
k8 <- parseJSON r1
|
|
pure $ OpResponse i k8
|
|
Nothing -> fail "Unknown object"
|
|
Array n -> do
|
|
if V.null n
|
|
then fail "Malformed JSON"
|
|
else do
|
|
case V.head n of
|
|
Object n' -> do
|
|
v1 <- n' .:? "lastSync"
|
|
v2 <- n' .:? "wallet"
|
|
v3 <- n' .:? "ua"
|
|
v4 <- n' .:? "amountZats"
|
|
case (v1 :: Maybe Int) of
|
|
Just _v1' -> do
|
|
k2 <- parseJSON r1
|
|
pure $ WalletListResponse i k2
|
|
Nothing ->
|
|
case (v2 :: Maybe Int) of
|
|
Just _v2' -> do
|
|
k3 <- parseJSON r1
|
|
pure $ AccountListResponse i k3
|
|
Nothing ->
|
|
case (v3 :: Maybe String) of
|
|
Just _v3' -> do
|
|
k4 <- parseJSON r1
|
|
pure $ AddressListResponse i k4
|
|
Nothing ->
|
|
case (v4 :: Maybe Int) of
|
|
Just _v4' -> do
|
|
k5 <- parseJSON r1
|
|
pure $ NoteListResponse i k5
|
|
Nothing -> fail "Unknown object"
|
|
_anyOther -> fail "Malformed JSON"
|
|
Number k -> do
|
|
case floatingOrInteger k of
|
|
Left _e -> fail "Unknown value"
|
|
Right k' -> pure $ NewItemResponse i k'
|
|
_anyOther -> fail "Malformed JSON"
|
|
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
|
|
|
|
data ZenithInfo = ZenithInfo
|
|
{ zi_version :: !T.Text
|
|
, zi_network :: !ZcashNet
|
|
, zi_zebra :: !T.Text
|
|
} deriving (Eq, Prelude.Show)
|
|
|
|
instance ToJSON ZenithInfo where
|
|
toJSON (ZenithInfo v n z) =
|
|
object ["version" .= v, "network" .= n, "zebraVersion" .= z]
|
|
|
|
instance FromJSON ZenithInfo where
|
|
parseJSON =
|
|
withObject "ZenithInfo" $ \obj -> do
|
|
v <- obj .: "version"
|
|
n <- obj .: "network"
|
|
z <- obj .: "zebraVersion"
|
|
pure $ ZenithInfo v n z
|
|
|
|
-- | A type to model Zenith RPC calls
|
|
data RpcCall = RpcCall
|
|
{ jsonrpc :: !T.Text
|
|
, callId :: !T.Text
|
|
, method :: !ZenithMethod
|
|
, parameters :: !ZenithParams
|
|
} deriving (Eq, Prelude.Show)
|
|
|
|
instance ToJSON RpcCall where
|
|
toJSON (RpcCall jr i m p) =
|
|
object ["jsonrpc" .= jr, "id" .= i, "method" .= m, "params" .= p]
|
|
|
|
instance FromJSON RpcCall where
|
|
parseJSON =
|
|
withObject "RpcCall" $ \obj -> do
|
|
v <- obj .: "jsonrpc"
|
|
i <- obj .: "id"
|
|
m <- obj .: "method"
|
|
case m of
|
|
UnknownMethod -> pure $ RpcCall v i UnknownMethod BlankParams
|
|
ListWallets -> do
|
|
p <- obj .: "params"
|
|
if null (p :: [Value])
|
|
then pure $ RpcCall v i ListWallets BlankParams
|
|
else pure $ RpcCall v i ListWallets BadParams
|
|
GetInfo -> do
|
|
p <- obj .: "params"
|
|
if null (p :: [Value])
|
|
then pure $ RpcCall v i GetInfo BlankParams
|
|
else pure $ RpcCall v i GetInfo BadParams
|
|
ListAccounts -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 1
|
|
then do
|
|
w <- parseJSON $ V.head a
|
|
pure $ RpcCall v i ListAccounts (AccountsParams w)
|
|
else pure $ RpcCall v i ListAccounts BadParams
|
|
_anyOther -> pure $ RpcCall v i ListAccounts BadParams
|
|
ListAddresses -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 1
|
|
then do
|
|
x <- parseJSON $ V.head a
|
|
pure $ RpcCall v i ListAddresses (AddressesParams x)
|
|
else pure $ RpcCall v i ListAddresses BadParams
|
|
_anyOther -> pure $ RpcCall v i ListAddresses BadParams
|
|
ListReceived -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 1
|
|
then do
|
|
x <- parseJSON $ V.head a
|
|
pure $ RpcCall v i ListReceived (NotesParams x)
|
|
else pure $ RpcCall v i ListReceived BadParams
|
|
_anyOther -> pure $ RpcCall v i ListReceived BadParams
|
|
GetBalance -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 1
|
|
then do
|
|
x <- parseJSON $ V.head a
|
|
pure $ RpcCall v i GetBalance (BalanceParams x)
|
|
else pure $ RpcCall v i GetBalance BadParams
|
|
_anyOther -> pure $ RpcCall v i GetBalance BadParams
|
|
GetNewWallet -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 1
|
|
then do
|
|
x <- parseJSON $ V.head a
|
|
pure $ RpcCall v i GetNewWallet (NameParams x)
|
|
else pure $ RpcCall v i GetNewWallet BadParams
|
|
_anyOther -> pure $ RpcCall v i GetNewWallet BadParams
|
|
GetNewAccount -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 2
|
|
then do
|
|
x <- parseJSON $ a V.! 0
|
|
y <- parseJSON $ a V.! 1
|
|
pure $ RpcCall v i GetNewAccount (NameIdParams x y)
|
|
else pure $ RpcCall v i GetNewAccount BadParams
|
|
_anyOther -> pure $ RpcCall v i GetNewAccount BadParams
|
|
GetNewAddress -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a >= 2
|
|
then do
|
|
x <- parseJSON $ a V.! 0
|
|
y <- parseJSON $ a V.! 1
|
|
(sap, tr) <-
|
|
case a V.!? 2 of
|
|
Nothing -> return (False, False)
|
|
Just s -> do
|
|
s' <- parseJSON s
|
|
case s' of
|
|
("ExcludeSapling" :: String) -> do
|
|
case a V.!? 3 of
|
|
Nothing -> return (True, False)
|
|
Just t -> do
|
|
t' <- parseJSON t
|
|
return
|
|
(True, t' == ("ExcludeTransparent" :: String))
|
|
("ExcludeTransparent" :: String) -> do
|
|
case a V.!? 3 of
|
|
Nothing -> return (False, True)
|
|
Just t -> do
|
|
t' <- parseJSON t
|
|
return
|
|
(t' == ("ExcludeSapling" :: String), True)
|
|
_anyOther -> return (False, False)
|
|
pure $ RpcCall v i GetNewAddress (NewAddrParams x y sap tr)
|
|
else pure $ RpcCall v i GetNewAddress BadParams
|
|
_anyOther -> pure $ RpcCall v i GetNewAddress BadParams
|
|
GetOperationStatus -> do
|
|
p <- obj .: "params"
|
|
case p of
|
|
Array a ->
|
|
if V.length a == 1
|
|
then do
|
|
x <- parseJSON $ a V.! 0
|
|
case U.fromText x of
|
|
Just u -> do
|
|
pure $
|
|
RpcCall v i GetOperationStatus (OpParams $ ZenithUuid u)
|
|
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
|
|
else pure $ RpcCall v i GetOperationStatus BadParams
|
|
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
|
|
|
|
type ZenithRPC
|
|
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
|
|
'[ JSON]
|
|
RpcCall :> Post '[ JSON] ZenithResponse
|
|
|
|
data State = State
|
|
{ w_network :: !ZcashNet
|
|
, w_host :: !T.Text
|
|
, w_port :: !Int
|
|
, w_dbPath :: !T.Text
|
|
, w_build :: !T.Text
|
|
, w_startBlock :: !Int
|
|
}
|
|
|
|
zenithServer :: State -> Server ZenithRPC
|
|
zenithServer state = getinfo :<|> handleRPC
|
|
where
|
|
getinfo :: Handler Value
|
|
getinfo =
|
|
return $
|
|
object
|
|
[ "version" .= ("0.7.0.0-beta" :: String)
|
|
, "network" .= ("testnet" :: String)
|
|
]
|
|
handleRPC :: Bool -> RpcCall -> Handler ZenithResponse
|
|
handleRPC isAuth req =
|
|
case method req of
|
|
UnknownMethod ->
|
|
return $ ErrorResponse (callId req) (-32601) "Method not found"
|
|
ListWallets ->
|
|
case parameters req of
|
|
BlankParams -> do
|
|
pool <- liftIO $ runNoLoggingT $ initPool $ w_dbPath state
|
|
walList <- liftIO $ getWallets pool $ w_network state
|
|
if not (null walList)
|
|
then return $
|
|
WalletListResponse
|
|
(callId req)
|
|
(map toZcashWalletAPI walList)
|
|
else return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32001)
|
|
"No wallets available. Please create one first"
|
|
_anyOther ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
ListAccounts ->
|
|
case parameters req of
|
|
AccountsParams w -> do
|
|
let dbPath = w_dbPath state
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
wl <- liftIO $ walletExists pool w
|
|
case wl of
|
|
Just wl' -> do
|
|
accList <-
|
|
liftIO $ runNoLoggingT $ getAccounts pool (entityKey wl')
|
|
if not (null accList)
|
|
then return $
|
|
AccountListResponse
|
|
(callId req)
|
|
(map toZcashAccountAPI accList)
|
|
else return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32002)
|
|
"No accounts available for this wallet. Please create one first"
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse (callId req) (-32008) "Wallet does not exist."
|
|
_anyOther ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
ListAddresses ->
|
|
case parameters req of
|
|
AddressesParams a -> do
|
|
let dbPath = w_dbPath state
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
addrList <-
|
|
liftIO $
|
|
runNoLoggingT $ getAddresses pool (toSqlKey $ fromIntegral a)
|
|
if not (null addrList)
|
|
then return $
|
|
AddressListResponse
|
|
(callId req)
|
|
(map toZcashAddressAPI addrList)
|
|
else return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32003)
|
|
"No addresses available for this account. Please create one first"
|
|
_anyOther ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
GetInfo ->
|
|
case parameters req of
|
|
BlankParams ->
|
|
return $
|
|
InfoResponse
|
|
(callId req)
|
|
(ZenithInfo "0.7.0.0-beta" (w_network state) (w_build state))
|
|
_anyOtherParams ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
ListReceived ->
|
|
case parameters req of
|
|
NotesParams x -> do
|
|
case (readMaybe (T.unpack x) :: Maybe Int64) of
|
|
Just x' -> do
|
|
let dbPath = w_dbPath state
|
|
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 ->
|
|
case parseAddress (E.encodeUtf8 x) of
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32005)
|
|
"Unable to parse address"
|
|
Just x' -> do
|
|
let dbPath = w_dbPath state
|
|
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"
|
|
GetBalance ->
|
|
case parameters req of
|
|
BalanceParams i -> do
|
|
let dbPath = w_dbPath state
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
acc <- liftIO $ getAccountById pool $ toSqlKey i
|
|
case acc of
|
|
Just acc' -> do
|
|
c <- liftIO $ getPoolBalance pool $ entityKey acc'
|
|
u <- liftIO $ getUnconfPoolBalance pool $ entityKey acc'
|
|
return $ BalanceResponse (callId req) c u
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse (callId req) (-32006) "Account does not exist."
|
|
_anyOtherParams ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
GetNewWallet ->
|
|
case parameters req of
|
|
NameParams t -> do
|
|
let dbPath = w_dbPath state
|
|
sP <- liftIO generateWalletSeedPhrase
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
r <-
|
|
liftIO $
|
|
saveWallet pool $
|
|
ZcashWallet
|
|
t
|
|
(ZcashNetDB $ w_network state)
|
|
(PhraseDB sP)
|
|
(w_startBlock state)
|
|
0
|
|
case r of
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32007)
|
|
"Entity with that name already exists."
|
|
Just r' ->
|
|
return $
|
|
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
|
|
_anyOtherParams ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
GetNewAccount ->
|
|
case parameters req of
|
|
NameIdParams t i -> do
|
|
let dbPath = w_dbPath state
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
w <- liftIO $ walletExists pool i
|
|
case w of
|
|
Just w' -> do
|
|
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
|
|
nAcc <-
|
|
liftIO
|
|
(try $ createZcashAccount t (aIdx + 1) w' :: IO
|
|
(Either IOError ZcashAccount))
|
|
case nAcc of
|
|
Left e ->
|
|
return $
|
|
ErrorResponse (callId req) (-32010) $ T.pack $ show e
|
|
Right nAcc' -> do
|
|
r <- liftIO $ saveAccount pool nAcc'
|
|
case r of
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32007)
|
|
"Entity with that name already exists."
|
|
Just x ->
|
|
return $
|
|
NewItemResponse (callId req) $
|
|
fromSqlKey $ entityKey x
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse (callId req) (-32008) "Wallet does not exist."
|
|
_anyOtherParams ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
GetNewAddress ->
|
|
case parameters req of
|
|
NewAddrParams i n s t -> do
|
|
let dbPath = w_dbPath state
|
|
let net = w_network state
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
|
|
case acc of
|
|
Just acc' -> do
|
|
maxAddr <-
|
|
liftIO $ getMaxAddress pool (entityKey acc') External
|
|
newAddr <-
|
|
liftIO $
|
|
createCustomWalletAddress
|
|
n
|
|
(maxAddr + 1)
|
|
net
|
|
External
|
|
acc'
|
|
s
|
|
t
|
|
dbAddr <- liftIO $ saveAddress pool newAddr
|
|
case dbAddr of
|
|
Just nAddr -> do
|
|
return $
|
|
NewAddrResponse (callId req) (toZcashAddressAPI nAddr)
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse
|
|
(callId req)
|
|
(-32007)
|
|
"Entity with that name already exists."
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse (callId req) (-32006) "Account does not exist."
|
|
_anyOtherParams ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
GetOperationStatus ->
|
|
case parameters req of
|
|
OpParams u -> do
|
|
let dbPath = w_dbPath state
|
|
pool <- liftIO $ runNoLoggingT $ initPool dbPath
|
|
op <- liftIO $ getOperation pool $ getUuid u
|
|
case op of
|
|
Just o -> do
|
|
return $ OpResponse (callId req) $ entityVal o
|
|
Nothing ->
|
|
return $
|
|
ErrorResponse (callId req) (-32009) "Operation ID not found"
|
|
_anyOtherParams ->
|
|
return $ ErrorResponse (callId req) (-32602) "Invalid params"
|
|
|
|
authenticate :: Config -> BasicAuthCheck Bool
|
|
authenticate config = BasicAuthCheck check
|
|
where
|
|
check (BasicAuthData username password) =
|
|
if username == c_zenithUser config && password == c_zenithPwd config
|
|
then return $ Authorized True
|
|
else return Unauthorized
|
|
|
|
packRpcResponse :: ToJSON a => T.Text -> a -> Value
|
|
packRpcResponse i x =
|
|
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
|