diff --git a/CHANGELOG.md b/CHANGELOG.md index 20fa1a2..8f7d280 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/app/Server.hs b/app/Server.hs new file mode 100644 index 0000000..b95527b --- /dev/null +++ b/app/Server.hs @@ -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) diff --git a/cabal.project.freeze b/cabal.project.freeze index 175cc2c..b836f57 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -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, diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index c0b4623..70b8fd7 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -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) & diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs new file mode 100644 index 0000000..7db5337 --- /dev/null +++ b/src/Zenith/RPC.hs @@ -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 diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 6176c17..9868618 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -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 diff --git a/zenith.cabal b/zenith.cabal index 2aacd50..a849d74 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -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