json-rpc-1.0.1: Fully-featured JSON-RPC 2.0 library

Safe HaskellNone
LanguageHaskell2010

Network.JSONRPC

Contents

Synopsis

Introduction

This JSON-RPC library is fully-compatible with JSON-RPC 2.0 and 1.0. It provides an interface that combines a JSON-RPC client and server. It can set and keep track of request ids to parse responses. There is support for sending and receiving notifications. You may use any underlying transport. Basic TCP client and server provided.

A JSON-RPC application using this interface is considered to be peer-to-peer, as it can send and receive all types of JSON-RPC message independent of whether it originated the connection.

Establish JSON-RPC context

runJSONRPCT Source #

Arguments

:: (MonadLoggerIO m, MonadUnliftIO m) 
=> Ver

JSON-RPC version

-> Bool

Ignore incoming requests/notifs

-> ConduitT ByteString Void m ()

Sink to send messages

-> ConduitT () ByteString m ()

Source to receive messages from

-> JSONRPCT m a

JSON-RPC action

-> m a

Output of action

Create JSON-RPC session around conduits from transport layer. When context exits session disappears.

Conduits for encoding/decoding

decodeConduit :: MonadLogger m => Ver -> ConduitT ByteString (Either Response Value) m () Source #

Conduit to decode incoming messages. Left Response indicates a response to send back to sender if parsing JSON fails.

Communicate with remote party

receiveRequest :: MonadLoggerIO m => JSONRPCT m (Maybe Request) Source #

Receive requests from remote endpoint. Returns Nothing if incoming channel is closed or has never been opened. Will reject incoming request if sent in a batch.

receiveBatchRequest :: MonadLoggerIO m => JSONRPCT m (Maybe BatchRequest) Source #

Receive batch of requests. Will also accept single requests.

sendResponse :: MonadLoggerIO m => Response -> JSONRPCT m () Source #

Send response message. Do not use to respond to a batch of requests.

sendBatchResponse :: MonadLoggerIO m => BatchResponse -> JSONRPCT m () Source #

Send batch of responses. Use to respond to a batch of requests.

sendRequest :: (MonadLoggerIO m, ToJSON q, ToRequest q, FromResponse r) => q -> JSONRPCT m (Maybe (Either ErrorObj r)) Source #

Returns Nothing if did not receive response, could not parse it, or request is a notification. Just Left contains the error object returned by server if any. Just Right means response was received just right.

sendBatchRequest :: (MonadLoggerIO m, ToJSON q, ToRequest q, FromResponse r) => [q] -> JSONRPCT m [Maybe (Either ErrorObj r)] Source #

Send multiple requests in a batch. If only a single request, do not put it in a batch.

Transports

Client

jsonrpcTCPClient Source #

Arguments

:: (MonadLoggerIO m, MonadUnliftIO m) 
=> Ver

JSON-RPC version

-> Bool

Ignore incoming requests or notifications

-> ClientSettings

Connection settings

-> JSONRPCT m a

JSON-RPC action

-> m a

Output of action

TCP client transport for JSON-RPC.

Server

jsonrpcTCPServer Source #

Arguments

:: (MonadLoggerIO m, MonadUnliftIO m) 
=> Ver

JSON-RPC version

-> Bool

Ignore incoming requests or notifications

-> ServerSettings

Connection settings

-> JSONRPCT m ()

Action to perform on connecting client thread

-> m a 

TCP server transport for JSON-RPC.

Internal data and functions

processIncoming :: (Functor m, MonadLoggerIO m) => JSONRPCT m () Source #

Process incoming messages. Do not use this directly unless you know what you are doing. This is an internal function.

sendMessage :: MonadLoggerIO m => Message -> JSONRPCT m () Source #

Send any message. Do not use this. Use the other high-level functions instead. Will not track request ids. Incoming responses to requests sent using this method will be ignored.

Requests

data Request Source #

Instances
Eq Request Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

(==) :: Request -> Request -> Bool #

(/=) :: Request -> Request -> Bool #

Show Request Source # 
Instance details

Defined in Network.JSONRPC.Data

Generic Request Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep Request :: Type -> Type #

Methods

from :: Request -> Rep Request x #

to :: Rep Request x -> Request #

Arbitrary Request Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

ToJSON Request Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON Request Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData Request Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: Request -> () #

type Rep Request Source # 
Instance details

Defined in Network.JSONRPC.Data

data BatchRequest Source #

Instances
Eq BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

Show BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

Generic BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep BatchRequest :: Type -> Type #

Arbitrary BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

ToJSON BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: BatchRequest -> () #

type Rep BatchRequest Source # 
Instance details

Defined in Network.JSONRPC.Data

type Rep BatchRequest = D1 (MetaData "BatchRequest" "Network.JSONRPC.Data" "json-rpc-1.0.1-FKOWGatf3508CNIVKBm9kr" False) (C1 (MetaCons "BatchRequest" PrefixI True) (S1 (MetaSel (Just "getBatchRequest") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [Request])) :+: C1 (MetaCons "SingleRequest" PrefixI True) (S1 (MetaSel (Just "getSingleRequest") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Request)))

Parsing

class FromRequest q where Source #

Methods

parseParams :: Method -> Maybe (Value -> Parser q) Source #

Parser for params Value in JSON-RPC request.

Instances
FromRequest () Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

parseParams :: Method -> Maybe (Value -> Parser ()) Source #

FromRequest Value Source # 
Instance details

Defined in Network.JSONRPC.Data

Encoding

class ToRequest q where Source #

Methods

requestMethod :: q -> Method Source #

Method associated with request data to build a request object.

requestIsNotif :: q -> Bool Source #

Is this request to be sent as a notification (no id, no response)?

Instances
ToRequest () Source # 
Instance details

Defined in Network.JSONRPC.Data

ToRequest Value Source # 
Instance details

Defined in Network.JSONRPC.Data

buildRequest Source #

Arguments

:: (ToJSON q, ToRequest q) 
=> Ver

JSON-RPC version

-> q

Request data

-> Id 
-> Request 

Responses

data Response Source #

Constructors

Response 

Fields

ResponseError 

Fields

OrphanError 

Fields

Instances
Eq Response Source # 
Instance details

Defined in Network.JSONRPC.Data

Show Response Source # 
Instance details

Defined in Network.JSONRPC.Data

Generic Response Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep Response :: Type -> Type #

Methods

from :: Response -> Rep Response x #

to :: Rep Response x -> Response #

Arbitrary Response Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

ToJSON Response Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON Response Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData Response Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: Response -> () #

type Rep Response Source # 
Instance details

Defined in Network.JSONRPC.Data

data BatchResponse Source #

Instances
Eq BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

Show BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

Generic BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep BatchResponse :: Type -> Type #

Arbitrary BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

ToJSON BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: BatchResponse -> () #

type Rep BatchResponse Source # 
Instance details

Defined in Network.JSONRPC.Data

type Rep BatchResponse = D1 (MetaData "BatchResponse" "Network.JSONRPC.Data" "json-rpc-1.0.1-FKOWGatf3508CNIVKBm9kr" False) (C1 (MetaCons "BatchResponse" PrefixI True) (S1 (MetaSel (Just "getBatchResponse") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [Response])) :+: C1 (MetaCons "SingleResponse" PrefixI True) (S1 (MetaSel (Just "getSingleResponse") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Response)))

Parsing

class FromResponse r where Source #

Methods

parseResult :: Method -> Maybe (Value -> Parser r) Source #

Parser for result Value in JSON-RPC response. Method corresponds to request to which this response answers.

Instances
FromResponse () Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

parseResult :: Method -> Maybe (Value -> Parser ()) Source #

FromResponse Value Source # 
Instance details

Defined in Network.JSONRPC.Data

fromResponse :: FromResponse r => Method -> Response -> Maybe r Source #

Parse a response knowing the method of the corresponding request.

Encoding

type Respond q m r = q -> m (Either ErrorObj r) Source #

Type of function to make it easy to create a response from a request. Meant to be used in servers.

buildResponse :: (Monad m, FromRequest q, ToJSON r) => Respond q m r -> Request -> m (Maybe Response) Source #

Create a response from a request. Use in servers.

Errors

data ErrorObj Source #

Error object from JSON-RPC 2.0. ErrorVal for backwards compatibility.

Constructors

ErrorObj 
ErrorVal 

Fields

Instances
Eq ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

Show ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

Generic ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep ErrorObj :: Type -> Type #

Methods

from :: ErrorObj -> Rep ErrorObj x #

to :: Rep ErrorObj x -> ErrorObj #

Arbitrary ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

ToJSON ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: ErrorObj -> () #

type Rep ErrorObj Source # 
Instance details

Defined in Network.JSONRPC.Data

type Rep ErrorObj = D1 (MetaData "ErrorObj" "Network.JSONRPC.Data" "json-rpc-1.0.1-FKOWGatf3508CNIVKBm9kr" False) (C1 (MetaCons "ErrorObj" PrefixI True) (S1 (MetaSel (Just "getErrMsg") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 String) :*: (S1 (MetaSel (Just "getErrCode") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Int) :*: S1 (MetaSel (Just "getErrData") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Value))) :+: C1 (MetaCons "ErrorVal" PrefixI True) (S1 (MetaSel (Just "getErrData") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Value)))

fromError :: ErrorObj -> String Source #

Get a user-friendly string with the error information.

Error messages

errorInvalid :: Value -> ErrorObj Source #

Invalid request.

errorParams :: Value -> ErrorObj Source #

Invalid params.

errorMethod :: Method -> ErrorObj Source #

Method not found.

errorId :: Id -> ErrorObj Source #

Id not recognized.

Others

data Message Source #

Constructors

MsgRequest 
MsgResponse 
MsgBatch 

Fields

Instances
Eq Message Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

(==) :: Message -> Message -> Bool #

(/=) :: Message -> Message -> Bool #

Show Message Source # 
Instance details

Defined in Network.JSONRPC.Data

Generic Message Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep Message :: Type -> Type #

Methods

from :: Message -> Rep Message x #

to :: Rep Message x -> Message #

Arbitrary Message Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

ToJSON Message Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON Message Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData Message Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: Message -> () #

type Rep Message Source # 
Instance details

Defined in Network.JSONRPC.Data

type Rep Message = D1 (MetaData "Message" "Network.JSONRPC.Data" "json-rpc-1.0.1-FKOWGatf3508CNIVKBm9kr" False) (C1 (MetaCons "MsgRequest" PrefixI True) (S1 (MetaSel (Just "getMsgRequest") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Request)) :+: (C1 (MetaCons "MsgResponse" PrefixI True) (S1 (MetaSel (Just "getMsgResponse") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Response)) :+: C1 (MetaCons "MsgBatch" PrefixI True) (S1 (MetaSel (Just "getBatch") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 [Message]))))

data Id Source #

Constructors

IdInt 

Fields

IdTxt 

Fields

Instances
Enum Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

succ :: Id -> Id #

pred :: Id -> Id #

toEnum :: Int -> Id #

fromEnum :: Id -> Int #

enumFrom :: Id -> [Id] #

enumFromThen :: Id -> Id -> [Id] #

enumFromTo :: Id -> Id -> [Id] #

enumFromThenTo :: Id -> Id -> Id -> [Id] #

Eq Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

(==) :: Id -> Id -> Bool #

(/=) :: Id -> Id -> Bool #

Read Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Show Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

showsPrec :: Int -> Id -> ShowS #

show :: Id -> String #

showList :: [Id] -> ShowS #

Generic Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep Id :: Type -> Type #

Methods

from :: Id -> Rep Id x #

to :: Rep Id x -> Id #

Arbitrary Id Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

Methods

arbitrary :: Gen Id #

shrink :: Id -> [Id] #

Hashable Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

hashWithSalt :: Int -> Id -> Int #

hash :: Id -> Int #

ToJSON Id Source # 
Instance details

Defined in Network.JSONRPC.Data

FromJSON Id Source # 
Instance details

Defined in Network.JSONRPC.Data

NFData Id Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: Id -> () #

type Rep Id Source # 
Instance details

Defined in Network.JSONRPC.Data

type Rep Id = D1 (MetaData "Id" "Network.JSONRPC.Data" "json-rpc-1.0.1-FKOWGatf3508CNIVKBm9kr" False) (C1 (MetaCons "IdInt" PrefixI True) (S1 (MetaSel (Just "getIdInt") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Int)) :+: C1 (MetaCons "IdTxt" PrefixI True) (S1 (MetaSel (Just "getIdTxt") NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 Text)))

fromId :: Id -> String Source #

Pretty display a message id. Meant for logs.

data Ver Source #

JSON-RPC version.

Constructors

V1

JSON-RPC 1.0

V2

JSON-RPC 2.0

Instances
Eq Ver Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

(==) :: Ver -> Ver -> Bool #

(/=) :: Ver -> Ver -> Bool #

Read Ver Source # 
Instance details

Defined in Network.JSONRPC.Data

Show Ver Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

showsPrec :: Int -> Ver -> ShowS #

show :: Ver -> String #

showList :: [Ver] -> ShowS #

Generic Ver Source # 
Instance details

Defined in Network.JSONRPC.Data

Associated Types

type Rep Ver :: Type -> Type #

Methods

from :: Ver -> Rep Ver x #

to :: Rep Ver x -> Ver #

Arbitrary Ver Source # 
Instance details

Defined in Network.JSONRPC.Arbitrary

Methods

arbitrary :: Gen Ver #

shrink :: Ver -> [Ver] #

NFData Ver Source # 
Instance details

Defined in Network.JSONRPC.Data

Methods

rnf :: Ver -> () #

type Rep Ver Source # 
Instance details

Defined in Network.JSONRPC.Data

type Rep Ver = D1 (MetaData "Ver" "Network.JSONRPC.Data" "json-rpc-1.0.1-FKOWGatf3508CNIVKBm9kr" False) (C1 (MetaCons "V1" PrefixI False) (U1 :: Type -> Type) :+: C1 (MetaCons "V2" PrefixI False) (U1 :: Type -> Type))