Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 8 Packages Wiki Activity

Start RPC server

Browse source
This commit is contained in:
Rene Vergara 2024-07-23 13:46:37 -05:00
parent 3a5e593a65
commit 94bfca95ca
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
7 changed files with 167 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
CHANGELOG.md
View file

@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [Unreleased]
### Added
- RPC module
## [0.6.0.0-beta]
### Added

8
app/Server.hs Normal file
View file

@ -0,0 +1,8 @@
module Server where
import Network.Wai.Handler.Warp (run)
import Servant
import Zenith.RPC (ZenithRPC(..), zenithServer)
main :: IO ()
main = run 8081 (serve (Proxy :: Proxy ZenithRPC) zenithServer)

41
cabal.project.freeze
View file

@ -41,8 +41,8 @@ constraints: any.Cabal ==3.10.3.0,
any.authenticate-oauth ==1.7,
any.auto-update ==0.2.1,
any.base ==4.18.2.1,
any.base-compat ==0.14.0,
any.base-compat-batteries ==0.14.0,
any.base-compat ==0.13.1,
any.base-compat-batteries ==0.13.1,
any.base-orphans ==0.9.2,
any.base16 ==1.0,
any.base16-bytestring ==1.0.2.0,
@ -59,9 +59,12 @@ constraints: any.Cabal ==3.10.3.0,
any.blaze-builder ==0.4.2.3,
any.blaze-html ==0.9.2.0,
any.blaze-markup ==0.8.3.0,
any.boring ==0.2.2,
boring +tagged,
any.borsh ==0.3.0,
any.brick ==2.4,
brick -demos,
any.bsb-http-chunked ==0.0.0.4,
any.byteorder ==1.0.4,
any.bytes ==0.17.3,
any.bytestring ==0.11.5.3,
@ -90,6 +93,7 @@ constraints: any.Cabal ==3.10.3.0,
config-ini -enable-doctests,
any.configurator ==0.3.0.0,
configurator -developer,
any.constraints ==0.14.2,
any.containers ==0.6.7,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
@ -113,6 +117,7 @@ constraints: any.Cabal ==3.10.3.0,
any.data-default-instances-dlist ==0.0.1,
any.data-default-instances-old-locale ==0.0.1,
any.data-fix ==0.3.4,
any.dec ==0.0.6,
any.deepseq ==1.4.8.1,
any.directory ==1.3.8.4,
any.distributive ==0.6.2.1,
@ -129,6 +134,7 @@ constraints: any.Cabal ==3.10.3.0,
any.exceptions ==0.10.7,
any.extra ==1.7.16,
any.fast-logger ==3.2.3,
any.file-embed ==0.0.16.0,
any.filepath ==1.4.300.1,
any.fixed ==0.3,
any.foreign-rust ==0.1.0,
@ -169,7 +175,12 @@ constraints: any.Cabal ==3.10.3.0,
any.http-client-tls ==0.3.6.3,
any.http-conduit ==2.3.8.3,
http-conduit +aeson,
any.http-date ==0.0.11,
any.http-media ==0.8.1.1,
any.http-semantics ==0.1.2,
any.http-types ==0.12.4,
any.http2 ==5.2.6,
http2 -devel -h2spec,
any.indexed-traversable ==0.1.4,
any.indexed-traversable-instances ==0.1.2,
any.integer-conversion ==0.1.1,
@ -196,6 +207,7 @@ constraints: any.Cabal ==3.10.3.0,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.15,
any.mime-types ==0.1.2.0,
any.mmorph ==1.2.0,
any.monad-control ==1.0.3.1,
any.monad-logger ==0.3.40,
monad-logger +template_haskell,
@ -210,9 +222,13 @@ constraints: any.Cabal ==3.10.3.0,
nanovg -examples -gl2 -gles3 -stb_truetype,
any.network ==3.2.1.0,
network -devel,
any.network-byte-order ==0.1.7,
any.network-control ==0.1.1,
any.network-uri ==2.6.4.2,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.4,
any.optparse-applicative ==0.18.1.0,
optparse-applicative +process,
any.os-string ==2.0.6,
any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1,
@ -225,6 +241,9 @@ constraints: any.Cabal ==3.10.3.0,
persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4,
any.persistent-template ==2.12.0.0,
any.pretty ==1.1.3.6,
any.prettyprinter ==1.7.1,
prettyprinter -buildreadme +text,
any.prettyprinter-ansi-terminal ==1.1.3,
any.primitive ==0.9.0.0,
any.process ==1.6.19.0,
any.profunctors ==5.6.2,
@ -236,6 +255,7 @@ constraints: any.Cabal ==3.10.3.0,
any.quickcheck-io ==0.2.0,
any.quickcheck-transformer ==0.3.1.2,
any.random ==1.2.1.2,
any.recv ==0.1.0,
any.reflection ==2.1.8,
reflection -slow +template-haskell,
any.regex-base ==0.94.0.2,
@ -260,8 +280,15 @@ constraints: any.Cabal ==3.10.3.0,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
any.serialise ==0.2.6.1,
serialise +newtime15,
any.servant ==0.20.1,
any.servant-server ==0.20,
any.silently ==1.2.5.3,
any.simple-sendfile ==0.2.32,
simple-sendfile +allow-bsd -fallback,
any.singleton-bool ==0.1.8,
any.socks ==0.6.1,
any.some ==1.0.6,
some +newtype-unsafe,
any.sop-core ==0.5.0.2,
any.sort ==1.0.0.0,
any.split ==0.2.5,
@ -296,6 +323,7 @@ constraints: any.Cabal ==3.10.3.0,
any.time-compat ==1.9.7,
any.time-locale-compat ==0.1.1.5,
time-locale-compat -old-locale,
any.time-manager ==0.1.0,
any.tls ==2.1.0,
tls -devel,
any.transformers ==0.6.1.0,
@ -326,9 +354,18 @@ constraints: any.Cabal ==3.10.3.0,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.wai ==3.2.4,
any.wai-app-static ==3.1.9,
wai-app-static +crypton -print,
any.wai-extra ==3.1.15,
wai-extra -build-example,
any.wai-logger ==2.4.0,
any.warp ==3.4.1,
warp +allow-sendfilefd -network-bytestring -warp-debug +x509,
any.wide-word ==0.1.6.0,
any.witherable ==0.5,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.wreq ==0.5.4.3,
wreq -aws -developer +doctest -httpbin,
any.zlib ==0.7.1.0,

11
src/Zenith/GUI.hs
View file

@ -1040,12 +1040,11 @@ handleEvent wenv node model evt =
Nothing -> return $ ShowError "No wallet available"
Just cW -> do
syncWallet (model ^. configuration) cW
return $ SwitchAddr (model ^. selAddr)
, Task $ do
pool <-
runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
pool <-
runNoLoggingT $
initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
]
else [ Model $
model & barValue .~ validBarValue (i + model ^. barValue) &

55
src/Zenith/RPC.hs Normal file
View file

@ -0,0 +1,55 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Zenith.RPC where
import Data.Aeson
import qualified Data.Text as T
import Servant
import ZcashHaskell.Types (RpcError(..), RpcResponse(..))
import Zenith.Types (RpcCall(..), ZenithMethod(..), ZenithParams(..))
type ZenithRPC
= "getinfo" :> Get '[ JSON] Value :<|> ReqBody '[ JSON] RpcCall :> Post
'[ JSON]
(RpcResponse Value)
zenithServer :: Server ZenithRPC
zenithServer = getinfo :<|> handleRPC
where
getinfo :: Handler Value
getinfo =
return $
object
[ "version" .= ("0.7.0.0-beta" :: String)
, "network" .= ("testnet" :: String)
]
handleRPC :: RpcCall -> Handler (RpcResponse Value)
handleRPC req =
case method req of
GetInfo ->
case parameters req of
GetInfoParams ->
return $
MakeRpcResponse
Nothing
(callId req)
(Just $ object ["data" .= ("Here's your info" :: String)])
_anyOtherParams ->
return $
MakeRpcResponse
(Just $ RpcError (-32602) "Invalid params")
(callId req)
Nothing
Test ->
case parameters req of
TestParams x ->
return $
MakeRpcResponse Nothing (callId req) (Just $ object ["data" .= x])
_anyOtherParams ->
return $
MakeRpcResponse
(Just $ RpcError (-32602) "Invalid params")
(callId req)
Nothing

38
src/Zenith/Types.hs
View file

@ -94,6 +94,44 @@ data Config = Config
, c_zebraPort :: !Int
} deriving (Eq, Prelude.Show)
-- ** Zenith methods
data ZenithMethod
= GetInfo
| Test
deriving (Eq, Prelude.Show)
instance FromJSON ZenithMethod where
parseJSON =
withText "ZenithMethod" $ \case
"getinfo" -> pure GetInfo
"test" -> pure Test
_ -> fail "Invalid method"
data ZenithParams
= GetInfoParams
| TestParams !T.Text
deriving (Eq, Prelude.Show)
-- | 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 FromJSON RpcCall where
parseJSON =
withObject "RpcCall" $ \obj -> do
v <- obj .: "jsonrpc"
i <- obj .: "id"
m <- obj .: "method"
case m of
GetInfo -> pure $ RpcCall v i GetInfo GetInfoParams
Test -> do
p <- obj .: "params"
pure $ RpcCall v i Test (TestParams $ head p)
-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo

16
zenith.cabal
View file

@ -35,6 +35,7 @@ library
Zenith.Utils
Zenith.Zcashd
Zenith.Scanner
Zenith.RPC
hs-source-dirs:
src
build-depends:
@ -80,6 +81,7 @@ library
, regex-compat
, regex-posix
, scientific
, servant-server
, text
, text-show
, time
@ -123,6 +125,20 @@ executable zenscan
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
executable zenithserver
ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
main-is: Server.hs
hs-source-dirs:
app
build-depends:
base >=4.12 && <5
, wai-extra
, warp
, servant-server
, zenith
pkgconfig-depends: rustzcash_wrapper
default-language: Haskell2010
test-suite zenith-tests
type: exitcode-stdio-1.0
ghc-options: -threaded -rtsopts -with-rtsopts=-N