Skip to content

Commit

Permalink
Add PactPollResponses module
Browse files Browse the repository at this point in the history
This is a small step in reducing downstream projects' reliance
on pact types. Some projects can't keep apace with both pact's (and
chainweb's) need to use very recently published GHC versions.
  • Loading branch information
giantimi committed Dec 7, 2023
1 parent 7fb1e73 commit 0c2fb66
Show file tree
Hide file tree
Showing 2 changed files with 61 additions and 0 deletions.
1 change: 1 addition & 0 deletions chainweb-api.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,7 @@ library
Chainweb.Api.NodeInfo
Chainweb.Api.PactCommand
Chainweb.Api.PactNumber
Chainweb.Api.PactPollResponses
Chainweb.Api.ParsedNumbers
Chainweb.Api.Payload
Chainweb.Api.RespItems
Expand Down
60 changes: 60 additions & 0 deletions lib/Chainweb/Api/PactPollResponses.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,60 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Chainweb.Api.PactPollResponses where

------------------------------------------------------------------------------
import Data.Aeson
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import Data.Int
import Data.Text (Text)
import Data.Word
------------------------------------------------------------------------------

newtype RequestKey = RequestKey { unRequestKey :: Text }
deriving (Eq, Ord, Show, Hashable, FromJSON, FromJSONKey, ToJSON, ToJSONKey)

newtype TxId = TxId Word64
deriving (Eq, Ord, Show, FromJSON, ToJSON)

newtype PactResult = PactResult { unPactResult :: Either Value Value }
deriving (Eq, Show, FromJSON, ToJSON)

newtype Gas = Gas Int64
deriving (Eq, Ord, Show, FromJSON, ToJSON)

data CommandResult l = CommandResult
{ _crReqKey :: !RequestKey
, _crTxId :: !(Maybe TxId)
, _crResult :: !PactResult
, _crGas :: !Gas
, _crLogs :: !(Maybe l)
, _crContinuation :: !(Maybe Value) -- just accept the json?
, _crMetaData :: !(Maybe Value)
, _crEvents :: [Value] -- just accept the json?
} deriving (Eq, Show)

instance FromJSON l => FromJSON (CommandResult l) where
parseJSON = withObject "CommandResult" $ \o -> CommandResult
<$> o .: "requestKey"
<*> o .:? "txId"
<*> o .: "result"
<*> o .: "gas"
<*> o .:? "logs"
<*> o .:? "continuation"
<*> o .:? "metadata"
<*> (events <$> o .: "events")
where
events Nothing = []
events (Just es) = es

newtype PactHash = PactHash { unHash :: Text }
deriving (Eq, Ord, Show, FromJSON, ToJSON)

newtype PollResponses = PollResponses
{ _prResults :: HM.HashMap RequestKey (CommandResult PactHash)
} deriving (Eq, Show)

instance FromJSON PollResponses where
parseJSON v = PollResponses <$> withObject "PollResponses" (\_ -> parseJSON v) v

0 comments on commit 0c2fb66

Please sign in to comment.