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,38 @@ +# Haskell client for Accumulate + +![build](https://github.com/kelecorix/accumulate-haskell-client/workflows/build/badge.svg) +![Hackage](https://img.shields.io/hackage/v/api-rpc-accumulate) +[![License](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/kelecorix/api-rpc-accumulate/blob/master/LICENSE) + +A JSON-RPC Haskell client for the Factom protocol. Each response has special ADT(algebraic data type) that automatically converted from JSON response. Using [Remote Monad](https://ku-fpg.github.io/files/Gill-15-RemoteMonad.pdf) pattern multiple request can be batched and executed simulatenously, following more robust approach and reducing usage of expensive RPC calls. + +Choosing a batching strategy. There are two strategies: +- `Weak` - a single command or a single procedure, or +- `Strong` - a sequence of commands, optionally terminated by a procedure + +# Installation + +You can install package from [Hackage](https://hackage.haskell.org/package/api-rpc-accumulate) 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-accumulate`. + +To run and test from repository + +1. Build with stack +```bash +$ stack build +``` +2. Load REPL with stack for evaluation +``` +$ stack repl +``` + +3. execute required methods + +## Usage + +## Contributions + +The Library developed by Kelecorix, Inc. If you're an active user or find it useful we strongly encourage you to support our efforts and ensure long maintenance by contributing a small donation to one of the following cryptocurrency addresses: + +- BTC: 39oVXpsgsyW8ZgzsnX3sV7HLdtXWfT96qN +- ETH: 0x9cDBA6bb44772259B3A3fb89cf233A147a720f34 +- FCT: FA38cwer93mmPw1HxjScLmK1yF9iJTu5P87T2vdkbuLovm2YXyss 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-accumulate.cabal b/api-rpc-accumulate.cabal new file mode 100644 --- /dev/null +++ b/api-rpc-accumulate.cabal @@ -0,0 +1,91 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.33.0. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 1805692927b5d8cf72892a1cf66efcd49daa3d660596d04a38013452643c9fb2 + +name: api-rpc-accumulate +version: 0.1.0.0 +synopsis: JSON-RPC API client for Accumulate blockchain +description: JSON-RPC API client for Accumulate blockchain. Contains basic models and api calls. +category: Web +homepage: https://github.com/kelecorix/accumulate-haskell-client#readme +bug-reports: https://github.com/kelecorix/accumulate-haskell-client/issues +author: Sergey Bushnyak +maintainer: sergey.bushnyak@sigrlami.eu +copyright: Copyright: (c) 2021-2022 Sergey Bushnyak, Kelecorix, Inc +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + +source-repository head + type: git + location: https://github.com/kelecorix/accumulate-haskell-client + +library + exposed-modules: + Accumulate.RPC.Api + Accumulate.RPC.Types + other-modules: + Accumulate.RPC.JsonRpc + Accumulate.RPC.Types.ApiDataMetricsResponse + Accumulate.RPC.Types.ApiDataResponse + Accumulate.RPC.Types.ApiDataVersionResponse + Paths_api_rpc_accumulate + 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 + , unordered-containers + default-language: Haskell2010 + +executable acme-app + main-is: Main.hs + other-modules: + Paths_api_rpc_accumulate + hs-source-dirs: + app + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + aeson + , api-rpc-accumulate + , base + , bytestring + , http-client + , http-conduit + , stm + , text + , time + default-language: Haskell2010 + +test-suite acme-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_api_rpc_accumulate + hs-source-dirs: + tests + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + api-rpc-accumulate + , base + , bytestring + default-language: Haskell2010 diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,35 @@ +{-# 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 Accumulate.RPC.Api as AcmeApi +import qualified Accumulate.RPC.Types as AcmeApi + +-------------------------------------------------------------------------------- +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 $ "Accumulate | Establishing connection" + putStrLn $ "Accumulate | Getting last entries\n" + + -- let s = weakSession (traceSendAPI "" $ clientSendAPI endpoint) + -- h <- + -- send s $ do + -- h <- reqGetData "acc://9c549cbba290efeb8029184caac3d36c5bfcacb361a29282/ACME" + -- return h + -- print h + return () diff --git a/src/Accumulate/RPC/Api.hs b/src/Accumulate/RPC/Api.hs new file mode 100644 --- /dev/null +++ b/src/Accumulate/RPC/Api.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +module Accumulate.RPC.Api + ( runTCPClient + , reqGetData + ) 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 as T +import Network.Socket (HostName, ServiceName, + SocketType (Stream), + addrAddress, addrFamily, + addrProtocol, + addrSocketType, close, + connect, defaultHints, + getAddrInfo, socket) + +import Accumulate.RPC.JsonRpc (JsonRpcT, runJsonRpcT) +import Accumulate.RPC.Types.ApiDataResponse +import Accumulate.RPC.Types.ApiDataMetricsResponse +import Accumulate.RPC.Types.ApiDataVersionResponse + +-------------------------------------------------------------------------------- + +endpoint = "http://95.141.37.250:35554/v1" + +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 + + +-- Options to convert internal types into Aeson values +-- $ Named [("jsonrpc", String "2.0"), ("id", toJSON (0::Int))] + +-------------------------------------------------------------------------------- +-- Data retrieval methods + +-- | getData returns Accumulate Object by URL +-- +reqGetData :: Text -> RPC APIDataResponse +reqGetData url = method "get" $ Named [("url", String url)] -- Named [("wait", Bool False), ("url", String url)] + +-- | GetDirectory returns ADI directory entries +-- +reqGetDirectory :: Text -> RPC () +reqGetDirectory url = method "get-directory" $ List [String url] + +-------------------------------------------------------------------------------- +-- ADIs + +-- | +-- +reqGetADI :: Text -> RPC () +reqGetADI url = method "adi" $ List [String url] + +-- | +-- +reqCreateADI :: Text -> RPC () +reqCreateADI url = method "adi-create" $ List [String url] + + +-------------------------------------------------------------------------------- +-- Key Management + +-- | +-- +reqGetKeyBook :: Text -> RPC () +reqGetKeyBook url = method "sig-spec-group" $ List [String url] + + +-------------------------------------------------------------------------------- +-- Tokens + +-- | Get infromation about token +-- +reqGetToken :: Text -> RPC () +reqGetToken url = method "token" $ List [String url] + + +-- | Get information about token transaction +-- +reqGetTokenTx :: Text -> RPC () +reqGetTokenTx txid = method "token-tx" $ List [String txid] + +-- | Create new token transaction +-- +reqCreateTokenTx :: Text -> RPC () +reqCreateTokenTx url = method "token-tx-create" $ List [String url] + +-------------------------------------------------------------------------------- +-- Metrics + +-- | +-- +reqGetMetrics :: Text -> Text -> RPC APIDataMetricsResponse +reqGetMetrics metricName duration = + method "metrics" $ Named [ ("metric" , String metricName) + , ("duration", String duration) + ] + +reqGetVersion :: RPC APIDataVersionResponse +reqGetVersion = method "version" $ List [] + + +-------------------------------------------------------------------------------- +-- Faucet + +-- | +-- +reqFaucet :: Text -> RPC () +reqFaucet url = method "faucet" $ Named [("url", String url)] + + +-------------------------------------------------------------------------------- +-- Credits + +-- | +-- +reqAddCredits :: Text -> RPC () +reqAddCredits url = method "add-credits" $ List [String url] + + +main = do + let s = weakSession (traceSendAPI "" $ clientSendAPI endpoint) + (m,v) <- + send s $ do + --h <- reqGetData "acc://c9359900016daa23da0f4c07e66be42c398fe2b10017cecb/ACME" + --t <- reqGetTokenTx "" + m <- reqGetMetrics "tps" "1h" + v <- reqGetVersion + return (m, v) + putStrLn "-----------" + print $ show $ m + putStrLn "-----------" + print $ show $ v diff --git a/src/Accumulate/RPC/JsonRpc.hs b/src/Accumulate/RPC/JsonRpc.hs new file mode 100644 --- /dev/null +++ b/src/Accumulate/RPC/JsonRpc.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Accumulate.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 diff --git a/src/Accumulate/RPC/Types.hs b/src/Accumulate/RPC/Types.hs new file mode 100644 --- /dev/null +++ b/src/Accumulate/RPC/Types.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module Accumulate.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 + + +-------------------------------------------------------------------------------- + +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) diff --git a/src/Accumulate/RPC/Types/ApiDataMetricsResponse.hs b/src/Accumulate/RPC/Types/ApiDataMetricsResponse.hs new file mode 100644 --- /dev/null +++ b/src/Accumulate/RPC/Types/ApiDataMetricsResponse.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE OverloadedStrings #-} + +module Accumulate.RPC.Types.ApiDataMetricsResponse + ( APIDataMetricsResponse (..) + , Data (..) + , decodeTopLevel + ) where + +import Data.Aeson +import Data.Aeson.Types (emptyObject) +import Data.ByteString.Lazy (ByteString) +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) + +data APIDataMetricsResponse = APIDataMetricsResponse + { apiDataMetricsResponseDataAPIDataMetricsResponse :: Data + , sponsorAPIDataMetricsResponse :: Text + , keyPageAPIDataMetricsResponse :: Maybe Text + , apiDataMetricsResponseTypeAPIDataMetricsResponse :: Text + } deriving (Show) + +data Data = Data + { valueData :: Text + } deriving (Show) + +decodeTopLevel :: ByteString -> Maybe APIDataMetricsResponse +decodeTopLevel = decode + +instance ToJSON APIDataMetricsResponse where + toJSON (APIDataMetricsResponse apiDataMetricsResponseDataAPIDataMetricsResponse sponsorAPIDataMetricsResponse keyPageAPIDataMetricsResponse apiDataMetricsResponseTypeAPIDataMetricsResponse) = + object + [ "data" .= apiDataMetricsResponseDataAPIDataMetricsResponse + , "sponsor" .= sponsorAPIDataMetricsResponse + , "keyPage" .= keyPageAPIDataMetricsResponse + , "type" .= apiDataMetricsResponseTypeAPIDataMetricsResponse + ] + +instance FromJSON APIDataMetricsResponse where + parseJSON (Object v) = APIDataMetricsResponse + <$> v .: "data" + <*> v .: "sponsor" + <*> v .: "keyPage" + <*> v .: "type" + +instance ToJSON Data where + toJSON (Data valueData) = + object + [ "value" .= valueData + ] + +instance FromJSON Data where + parseJSON (Object v) = Data + <$> v .: "value" diff --git a/src/Accumulate/RPC/Types/ApiDataResponse.hs b/src/Accumulate/RPC/Types/ApiDataResponse.hs new file mode 100644 --- /dev/null +++ b/src/Accumulate/RPC/Types/ApiDataResponse.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StrictData #-} + +module Accumulate.RPC.Types.ApiDataResponse + ( APIDataResponse (..), + Data (..), + decodeApiData, + ) +where + +import Data.Aeson +import Data.Aeson.Types (emptyObject) +import Data.ByteString.Lazy (ByteString) +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) + +-------------------------------------------------------------------------------- + +data APIDataResponse = APIDataResponse + { apiDataResponseDataAPIDataResponse :: Maybe Data, + sponsorAPIDataResponse :: Maybe Text, + keyPageAPIDataResponse :: Maybe (Maybe Text), + mdRootAPIDataResponse :: Maybe Text, + apiDataResponseTypeAPIDataResponse :: Maybe Text + } + deriving (Show) + +data Data = Data + { txCountData :: Maybe Int, + urlData :: Maybe Text, + balanceData :: Maybe Text, + keyBookURLData :: Maybe Text, + tokenURLData :: Maybe Text, + creditBalanceData :: Maybe Text, + nonceData :: Maybe Int + } + deriving (Show) + +decodeApiData :: ByteString -> Maybe APIDataResponse +decodeApiData = decode + +instance ToJSON APIDataResponse where + toJSON (APIDataResponse apiDataResponseDataAPIDataResponse sponsorAPIDataResponse keyPageAPIDataResponse mdRootAPIDataResponse apiDataResponseTypeAPIDataResponse) = + object + [ "data" .= apiDataResponseDataAPIDataResponse, + "sponsor" .= sponsorAPIDataResponse, + "keyPage" .= keyPageAPIDataResponse, + "mdRoot" .= mdRootAPIDataResponse, + "type" .= apiDataResponseTypeAPIDataResponse + ] + +instance FromJSON APIDataResponse where + parseJSON (Object v) = + APIDataResponse + <$> v .:? "data" + <*> v .:? "sponsor" + <*> v .:? "keyPage" + <*> v .:? "mdRoot" + <*> v .:? "type" + +instance ToJSON Data where + toJSON (Data txCountData urlData balanceData keyBookURLData tokenURLData creditBalanceData nonceData) = + object + [ "txCount" .= txCountData, + "url" .= urlData, + "balance" .= balanceData, + "keyBookUrl" .= keyBookURLData, + "tokenUrl" .= tokenURLData, + "creditBalance" .= creditBalanceData, + "nonce" .= nonceData + ] + +instance FromJSON Data where + parseJSON (Object v) = + Data + <$> v .:? "txCount" + <*> v .:? "url" + <*> v .:? "balance" + <*> v .:? "keyBookUrl" + <*> v .:? "tokenUrl" + <*> v .:? "creditBalance" + <*> v .:? "nonce" diff --git a/src/Accumulate/RPC/Types/ApiDataVersionResponse.hs b/src/Accumulate/RPC/Types/ApiDataVersionResponse.hs new file mode 100644 --- /dev/null +++ b/src/Accumulate/RPC/Types/ApiDataVersionResponse.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE StrictData #-} +{-# LANGUAGE OverloadedStrings #-} + +module Accumulate.RPC.Types.ApiDataVersionResponse + ( APIDataVersionResponse (..) + , Data (..) + , decodeTopLevel + ) where + +import Data.Aeson +import Data.Aeson.Types (emptyObject) +import Data.ByteString.Lazy (ByteString) +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) + +data APIDataVersionResponse = APIDataVersionResponse + { apiDataVersionResponseDataAPIDataVersionResponse :: Data + , sponsorAPIDataVersionResponse :: Text + , keyPageAPIDataVersionResponse :: Maybe Text + , apiDataVersionResponseTypeAPIDataVersionResponse :: Text + } deriving (Show) + +data Data = Data + { versionIsKnownData :: Bool + , versionData :: Text + , commitData :: Text + } deriving (Show) + +decodeTopLevel :: ByteString -> Maybe APIDataVersionResponse +decodeTopLevel = decode + +instance ToJSON APIDataVersionResponse where + toJSON (APIDataVersionResponse apiDataVersionResponseDataAPIDataVersionResponse sponsorAPIDataVersionResponse keyPageAPIDataVersionResponse apiDataVersionResponseTypeAPIDataVersionResponse) = + object + [ "data" .= apiDataVersionResponseDataAPIDataVersionResponse + , "sponsor" .= sponsorAPIDataVersionResponse + , "keyPage" .= keyPageAPIDataVersionResponse + , "type" .= apiDataVersionResponseTypeAPIDataVersionResponse + ] + +instance FromJSON APIDataVersionResponse where + parseJSON (Object v) = APIDataVersionResponse + <$> v .: "data" + <*> v .: "sponsor" + <*> v .: "keyPage" + <*> v .: "type" + +instance ToJSON Data where + toJSON (Data versionIsKnownData versionData commitData) = + object + [ "versionIsKnown" .= versionIsKnownData + , "version" .= versionData + , "commit" .= commitData + ] + +instance FromJSON Data where + parseJSON (Object v) = Data + <$> v .: "versionIsKnown" + <*> v .: "version" + <*> v .: "commit" diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,14 @@ +import Control.Exception (evaluate) +import Test.Hspec +import Test.QuickCheck + +main :: IO () +main = + hspec $ do + describe "Prelude.head" $ do + it "returns the first element of a list" $ do + head [23 ..] `shouldBe` (23 :: Int) + it "returns the first element of an *arbitrary* list" $ + property $ \x xs -> head (x : xs) == (x :: Int) + it "throws an exception if used with an empty list" $ do + evaluate (head []) `shouldThrow` anyException