diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,58 @@ +# Haskell JSON-RPC client for PegNet + +[![Build Status](https://travis-ci.com/kompendium-llc/api-rpc-factom.svg?branch=master)](https://travis-ci.com/kompendium-llc/api-rpc-factom) +[![License](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/kompendium-llc/api-rpc-factom/blob/master/LICENSE) + +A JSON-RPC Haskell client for the PegNet [API](https://github.com/pegnet/pegnetd/wiki/API). Each response has special ADT(algebraic data type) that automatically converted from JSON response. + +# Installation + +You can install package from [Hackage](https://hackage.haskell.org/package/api-rpc-factom) and build with Cabal, but we recommend to use [Stack](https://haskellstack.org) tool. Add to you dependencies in stack.yaml and cabal file dependency `- api-rpc-factom`. + +To run and test fromrepository + +1. Build with stack +```bash +$ stack build +``` + +2. Load REPL with stack for evaluation +``` +$ stack repl +``` + +3. execute required methods + +## Usage + +for basic daemon functionality + +1. import with + +```haskell +import PegNet.RPC.Api +``` +or load in REPL. + +2. build communication session with +``` +weakSession (traceSendAPI "" $ clientSendAPI endpoint) +``` + +3. run required methods inside `RPC` monad + +#### Retreiving a sync status + +```haskell +-- build communication session +let s = weakSession (traceSendAPI "" $ clientSendAPI endpoint) + +-- run Remote Monad +h <- send s $ do + -- run specific events by executing exposed + h <- reqGetSyncStatus + return h +-- show converted ADT +print h +-- or use for special business logic +``` diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/api-rpc-pegnet.cabal b/api-rpc-pegnet.cabal new file mode 100644 --- /dev/null +++ b/api-rpc-pegnet.cabal @@ -0,0 +1,55 @@ +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: f998af876ee380cd0f3e17213282441322f7618fb4ea71159e87d583bb7e2f57 + +name: api-rpc-pegnet +version: 0.1.0.0 +synopsis: simple json-rpc client for PegNet +description: simple json-rpc client for PegNet integration +category: Web +homepage: https://github.com/sigrlami/api-rpc-pegnet#readme +bug-reports: https://github.com/sigrlami/api-rpc-pegnet/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-rpc-pegnet + +library + exposed-modules: + PegNet.RPC.Api + other-modules: + PegNet.RPC.Types + PegNet.RPC.Types.SyncStatus + PegNet.RPC.Types.Transaction + Paths_api_rpc_pegnet + hs-source-dirs: + src + build-depends: + aeson + , aeson-casing + , base >=4.7 && <5 + , bytestring + , http-client + , http-client-tls + , http-conduit + , json-alt + , network + , remote-json + , remote-json-client + , remote-monad + , text + , time + , transformers + default-language: Haskell2010 diff --git a/src/PegNet/RPC/Api.hs b/src/PegNet/RPC/Api.hs new file mode 100644 --- /dev/null +++ b/src/PegNet/RPC/Api.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module PegNet.RPC.Api where + +import Control.Concurrent +import Control.Exception (bracket) +import Control.Monad.IO.Class +import Control.Remote.Monad.JSON +import Control.Remote.Monad.JSON.Client +import Control.Remote.Monad.JSON.Router +import Control.Remote.Monad.JSON.Trace +import Data.Aeson +import Data.Aeson.Types +import Data.Text +import Network.Socket (HostName, ServiceName, + SocketType (Stream), + addrAddress, addrFamily, + addrProtocol, addrSocketType, + close, connect, defaultHints, + getAddrInfo, socket) + +import PegNet.RPC.Types.SyncStatus +import PegNet.RPC.Types.Transaction + +-------------------------------------------------------------------------------- + +endpoint = "http://localhost:8070/v1" +endpointRemote = "http://dev.pegnet.org/v1" + +-- | "get-sync-status" +-- Return the current heights synced by pegnetd and the factomd it is communicating with +reqGetSyncStatus :: RPC SyncStatus +reqGetSyncStatus = + method "get-sync-status" None -- $ List [toJSON height] + +-- | "get-transaction" +-- Returns if a given entry hash is a pegnet transaction, and if so returns the transaction. +reqGetTransaction :: Text -> Text -> RPC Transaction +reqGetTransaction chainId entryHash = + method "get-transaction" $ List [String chainId, String entryHash] + +reqPegNetIssuance :: RPC () +reqPegNetIssuance = + method "get-pegnet-issuance" None + +reqPegNetBalances :: RPC () +reqPegNetBalances = + method "get-pegnet-balances" None + +reqPegNetRates :: RPC () +reqPegNetRates = + method "get-pegnet-rates" None + +reqGetTransactionStatus :: Text -> RPC () +reqGetTransactionStatus id = + method "get-transaction-status" None + +reqGeTransactions :: RPC [Transaction] +reqGeTransactions = + method "get-transactions" None + +-------------------------------------------------------------------------------- + +main = do + let s = weakSession (traceSendAPI "" $ clientSendAPI endpoint) + h <- send s $ do + h <- reqGetSyncStatus + return h + print h diff --git a/src/PegNet/RPC/Types.hs b/src/PegNet/RPC/Types.hs new file mode 100644 --- /dev/null +++ b/src/PegNet/RPC/Types.hs @@ -0,0 +1,1 @@ +module PegNet.RPC.Types where diff --git a/src/PegNet/RPC/Types/SyncStatus.hs b/src/PegNet/RPC/Types/SyncStatus.hs new file mode 100644 --- /dev/null +++ b/src/PegNet/RPC/Types/SyncStatus.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + +module PegNet.RPC.Types.SyncStatus where + +import Control.Applicative +import Control.Monad (forM_, join, mzero) +import Data.Aeson (FromJSON (..), ToJSON (..), + Value (..), decode, object, + pairs, (.:), (.:?), (.=)) +import Data.Aeson.AutoType.Alternative +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Monoid +import Data.Text (Text) +import qualified GHC.Generics +import System.Environment (getArgs) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStrLn, stderr) + +-------------------------------------------------------------------------------- + +-- | Workaround for https://github.com/bos/aeson/issues/287. +o .:?? val = fmap join (o .:? val) + +data SyncStatus = SyncStatus { + topLevelFactomheight :: Double, + topLevelSyncheight :: Double + } deriving (Show,Eq,GHC.Generics.Generic) + +instance FromJSON SyncStatus where + parseJSON (Object v) = + SyncStatus + <$> v .: "factomheight" + <*> v .: "syncheight" + parseJSON _ = mzero + +instance ToJSON SyncStatus where + toJSON (SyncStatus {..}) = + object [ "factomheight" .= topLevelFactomheight + , "syncheight" .= topLevelSyncheight] + toEncoding (SyncStatus {..}) = + pairs ( "factomheight" .= topLevelFactomheight + <> "syncheight" .= topLevelSyncheight) diff --git a/src/PegNet/RPC/Types/Transaction.hs b/src/PegNet/RPC/Types/Transaction.hs new file mode 100644 --- /dev/null +++ b/src/PegNet/RPC/Types/Transaction.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeOperators #-} + +module PegNet.RPC.Types.Transaction where + +import Control.Applicative +import Control.Monad (forM_, join, mzero) +import Data.Aeson (FromJSON (..), ToJSON (..), + Value (..), decode, object, + pairs, (.:), (.:?), (.=)) +import Data.Aeson.AutoType.Alternative +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Monoid +import Data.Text (Text) +import qualified GHC.Generics +import System.Environment (getArgs) +import System.Exit (exitFailure, exitSuccess) +import System.IO (hPutStrLn, stderr) + +-------------------------------------------------------------------------------- + +-- | Workaround for https://github.com/bos/aeson/issues/287. +o .:?? val = fmap join (o .:? val) + + +data Input = Input { + inputAmount :: Double, + inputAddress :: Text, + inputType :: Text + } deriving (Show,Eq,GHC.Generics.Generic) + + +instance FromJSON Input where + parseJSON (Object v) = Input <$> v .: "amount" <*> v .: "address" <*> v .: "type" + parseJSON _ = mzero + + +instance ToJSON Input where + toJSON (Input {..}) = object ["amount" .= inputAmount, "address" .= inputAddress, "type" .= inputType] + toEncoding (Input {..}) = pairs ("amount" .= inputAmount<>"address" .= inputAddress<>"type" .= inputType) + + +data TransactionsElt = TransactionsElt { + transactionsEltInput :: Input, + transactionsEltMetadata :: (Maybe Value), + transactionsEltConversion :: Text + } deriving (Show,Eq,GHC.Generics.Generic) + + +instance FromJSON TransactionsElt where + parseJSON (Object v) = TransactionsElt <$> v .: "input" <*> v .:?? "metadata" <*> v .: "conversion" + parseJSON _ = mzero + + +instance ToJSON TransactionsElt where + toJSON (TransactionsElt {..}) = object ["input" .= transactionsEltInput, "metadata" .= transactionsEltMetadata, "conversion" .= transactionsEltConversion] + toEncoding (TransactionsElt {..}) = pairs ("input" .= transactionsEltInput<>"metadata" .= transactionsEltMetadata<>"conversion" .= transactionsEltConversion) + + +data Data = Data { + dataTransactions :: [TransactionsElt], + dataVersion :: Double + } deriving (Show,Eq,GHC.Generics.Generic) + + +instance FromJSON Data where + parseJSON (Object v) = Data <$> v .: "transactions" <*> v .: "version" + parseJSON _ = mzero + + +instance ToJSON Data where + toJSON (Data {..}) = object ["transactions" .= dataTransactions, "version" .= dataVersion] + toEncoding (Data {..}) = pairs ("transactions" .= dataTransactions<>"version" .= dataVersion) + + +data Transaction = Transaction { + topLevelData :: Data, + topLevelEntryhash :: Text, + topLevelTimestamp :: Double + } deriving (Show,Eq,GHC.Generics.Generic) + + +instance FromJSON Transaction where + parseJSON (Object v) = Transaction <$> v .: "data" <*> v .: "entryhash" <*> v .: "timestamp" + parseJSON _ = mzero + + +instance ToJSON Transaction where + toJSON (Transaction {..}) = + object [ "data" .= topLevelData + , "entryhash" .= topLevelEntryhash + , "timestamp" .= topLevelTimestamp] + toEncoding (Transaction {..}) = + pairs ( "data" .= topLevelData + <> "entryhash" .= topLevelEntryhash + <>"timestamp" .= topLevelTimestamp)