api-rpc-factom (empty) → 0.1.3.0
raw patch · 11 files changed
+375/−0 lines, 11 filesdep +aesondep +aeson-casingdep +api-rpc-factomsetup-changed
Dependencies added: aeson, aeson-casing, api-rpc-factom, base, bytestring, http-client, http-client-tls, http-conduit, network, servant, servant-client, servant-jsonrpc, servant-jsonrpc-client, stm, text, time, transformers
Files
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- api-rpc-factom.cabal +89/−0
- app/Main.hs +33/−0
- src/Factom/RPC/Api.hs +43/−0
- src/Factom/RPC/JsonRpc.hs +111/−0
- src/Factom/RPC/Types.hs +64/−0
- src/Factom/RPC/Utils.hs +1/−0
- src/Factom/RPC/Wallet/Api.hs +1/−0
- tests/Spec.hs +0/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Sergey Bushnyak (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Sergey Bushnyak nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# api-factom
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ api-rpc-factom.cabal view
@@ -0,0 +1,89 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 4a03e226d4cdc196784e6ca4a4cc652c2cf2c1812d85ff21c8c672e23581cfb5++name: api-rpc-factom+version: 0.1.3.0+synopsis: RPC API client for Factom+description: RPC API client for Factom blockchain+category: Web+homepage: https://github.com/sigrlami/api-monobank#readme+bug-reports: https://github.com/sigrlami/api-monobank/issues+author: Sergey Bushnyak+maintainer: sergey.bushnyak@sigrlami.eu+copyright: Copyright: (c) 2019 Sergey Bushnyak+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/sigrlami/api-monobank++library+ exposed-modules:+ Factom.RPC.Api+ Factom.RPC.Wallet.Api+ Factom.RPC.Types+ other-modules:+ Factom.RPC.JsonRpc+ Factom.RPC.Utils+ Paths_api_rpc_factom+ hs-source-dirs:+ src+ build-depends:+ aeson+ , aeson-casing+ , base >=4.7 && <5+ , bytestring+ , http-client+ , http-client-tls+ , http-conduit+ , network+ , servant+ , servant-client+ , servant-jsonrpc+ , servant-jsonrpc-client+ , text+ , time+ , transformers+ default-language: Haskell2010++executable factom-app+ main-is: Main.hs+ other-modules:+ Paths_api_rpc_factom+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ aeson+ , api-rpc-factom+ , base+ , bytestring+ , http-client+ , http-conduit+ , stm+ , text+ , time+ default-language: Haskell2010++test-suite factom-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_api_rpc_factom+ hs-source-dirs:+ tests+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ api-rpc-factom+ , base+ , bytestring+ default-language: Haskell2010
+ app/Main.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent (forkIO, threadDelay)+import Control.Concurrent.STM.TVar+import Control.Monad (forever)+import qualified Data.Text as T+import Data.Time.Clock+import System.Environment++import qualified Factom.RPC.Api as FCTApi+import qualified Factom.RPC.Types as FCTApi++--------------------------------------------------------------------------------++main :: IO ()+main =+ do+ let delay = 60000 -- 1 request per minute available+ a <- getArgs+ timeVar <- newTVarIO (delay*1000)+ case a of+ ["-t"] -> do+ -- read token from file+ return ()+ otherwise -> do+ putStrLn $ "Factom | Establishing connection"+ putStrLn $ "Factom | Getting last entries\n"+ --mentries <- MBApi.getEntries+ --putStrLn $ show $ mcurrs+ -- mapM_ FCTApi.showEntryBlock mentries+ return ()
+ src/Factom/RPC/Api.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++module Factom.RPC.Api+ ( runTCPClient+ ) where++import Control.Exception (bracket)+import Network.Socket (HostName, ServiceName, SocketType (Stream),+ addrAddress, addrFamily, addrProtocol,+ addrSocketType, close, connect,+ defaultHints, getAddrInfo, socket)++import Factom.RPC.JsonRpc (JsonRpcT, runJsonRpcT)+++--------------------------------------------------------------------------------++endpoint = "http://localhost:8088/v2"++runTCPClient :: HostName -> ServiceName -> JsonRpcT IO a -> IO a+runTCPClient host port f = do+ addr <- resolve host port+ bracket (open addr) close talk+ where+ resolve host' port' = do+ let hints = defaultHints { addrSocketType = Stream }+ addr:_ <- getAddrInfo (Just hints) (Just host') (Just port')+ return addr++ open addr = do+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ connect sock $ addrAddress addr+ return sock++ talk sock = runJsonRpcT sock f
+ src/Factom/RPC/JsonRpc.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Factom.RPC.JsonRpc+ ( JsonRpcT (..)+ , Method (..)+ , Request (..)+ , Response (..)+ , Error+ , version+ , runJsonRpcT+ , request+ , mkDefaultRequest+ ) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)+import Control.Monad.Trans.State.Lazy (StateT (..), evalStateT, get,+ modify')+import Data.Aeson (FromJSON (..), ToJSON (..),+ eitherDecode', encode,+ withObject, (.:), (.:?))+import Data.Aeson.Casing (snakeCase)+import Data.Aeson.TH (defaultOptions, deriveJSON,+ fieldLabelModifier,+ omitNothingFields)+import Data.ByteString.Lazy (fromStrict, toStrict)+import Data.Either (Either)+import Data.Text (Text)+import Network.Socket (Socket)+import Network.Socket.ByteString (recv, sendAll)++--------------------------------------------------------------------------------++newtype Version =+ Version Text+ deriving (Eq, Show, ToJSON, FromJSON)++version :: Version+version = Version "2.0"++newtype Method =+ Method Text+ deriving (Eq, Show, ToJSON, FromJSON)++data Request a = Request+ { reqJsonrpc :: Version+ , reqMethod :: Method+ , reqParams :: a+ , reqId :: Int+ } deriving (Show, Eq)++deriveJSON defaultOptions+ { omitNothingFields = True+ , fieldLabelModifier = snakeCase . drop 3+ } ''Request++mkDefaultRequest :: ToJSON a => Method -> a -> Request a+mkDefaultRequest method req = Request version method req 0++data Error =+ Error+ { code :: Int+ , message :: Text+ , errData :: Maybe Text+ } deriving (Eq, Show)++deriveJSON defaultOptions ''Error+++-- | TODO: handle jsonrpc errors+data Response a =+ Response+ { resJsonrpc :: Version+ , resResult :: Either Error a+ , resId :: Int+ } deriving (Show, Eq)+++instance FromJSON a => FromJSON (Response a) where+ parseJSON = withObject "response" $ \o -> do+ v <- o .: "jsonrpc"+ jid <- o .: "id"+ result <- o .:? "result"+ e <- o .:? "error"+ let r = maybe (maybe (fail "invalid response") Left e) Right result+ return $ Response v r jid+++unwrapJson :: (Show a, FromJSON a) => Response a -> Either Error a+unwrapJson (Response _ r _) = r+++newtype JsonRpcT m a =+ JsonRpcT+ { unJsonRpcT :: StateT Int (ReaderT Socket m) a+ } deriving ( Functor, Applicative, Monad, MonadIO )++runJsonRpcT :: MonadIO m => Socket -> JsonRpcT m a -> m a+runJsonRpcT s jm = flip runReaderT s . flip evalStateT 0 $ unJsonRpcT jm++request :: (MonadIO m, Show b, ToJSON a, FromJSON b) => Method -> a -> JsonRpcT m (Either Error b)+request method params = do+ s <- JsonRpcT $ lift ask+ req <- toStrict . encode . Request version method params <$> JsonRpcT get+ liftIO $ sendAll s req+ JsonRpcT $ modify' (+1)+ response <- fromStrict <$> liftIO (recv s 262144)+ either fail (return . unwrapJson) $ eitherDecode' response
+ src/Factom/RPC/Types.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Factom.RPC.Types where++import Data.Aeson+import Data.Aeson.TH+import Data.Maybe+import qualified Data.Text as T+import Data.Time+import GHC.Generics++import Factom.RPC.Utils++--------------------------------------------------------------------------------++ -- { "jsonrpc": "2.0"+ -- , "id": 0+ -- , "method":"entry"+ -- , "params": {+ -- "hash":"24674e6bc3094eb773297de955ee095a05830e431da13a37382dcdc89d73c7d7"+ -- }+ -- }+data ApiRequest =+ ApiRequest+ { jsonRpc :: T.Text+ , id :: Int+ , method :: T.Text+ , params :: Maybe Object+ } deriving (Eq, Show, Generic, ToJSON)++data ApiResponse a =+ ApiResponse+ { jsonRpc :: T.Text+ , id :: Int+ , result :: a+ } deriving (Eq, Show, Generic, FromJSON)++-- "chainid":"df3ade9eec4b08d5379cc64270c30ea7315d8a8a1a69efe2b98a60ecdd69e604",+-- "content":"...",+-- "extids":[ "466163746f6d416e63686f72436861696e"]+data Entry =+ Entry+ { enChainId :: T.Text+ , enContent :: T.Text+ , enExtIds :: [T.Text]+ } deriving (Eq, Show, Generic, FromJSON)++data EntryBlock =+ EntryBlock+ { blockSequenceNumber :: Int+ } deriving (Eq, Show, Generic, FromJSON)++data EntryCreditBalance =+ EntryCreditBalance+ { ecBalance :: Int+ } deriving (Eq, Show, Generic, FromJSON)
+ src/Factom/RPC/Utils.hs view
@@ -0,0 +1,1 @@+module Factom.RPC.Utils where
+ src/Factom/RPC/Wallet/Api.hs view
@@ -0,0 +1,1 @@+module Factom.RPC.Wallet.Api where
+ tests/Spec.hs view