{-# LANGUAGE OverloadedStrings #-}

module ElectrsClient.RpcRequest
  ( RpcRequest (..),
    Method (..),
  )
where

import Data.Aeson (ToJSON (toJSON), Value (String))
import ElectrsClient.Import.External

data RpcRequest a = RpcRequest
  { forall a. RpcRequest a -> Integer
id :: Integer,
    forall a. RpcRequest a -> Text
jsonrpc :: Text,
    forall a. RpcRequest a -> Method
method :: Method,
    forall a. RpcRequest a -> a
params :: a
  }
  deriving stock ((forall x. RpcRequest a -> Rep (RpcRequest a) x)
-> (forall x. Rep (RpcRequest a) x -> RpcRequest a)
-> Generic (RpcRequest a)
forall x. Rep (RpcRequest a) x -> RpcRequest a
forall x. RpcRequest a -> Rep (RpcRequest a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RpcRequest a) x -> RpcRequest a
forall a x. RpcRequest a -> Rep (RpcRequest a) x
$cto :: forall a x. Rep (RpcRequest a) x -> RpcRequest a
$cfrom :: forall a x. RpcRequest a -> Rep (RpcRequest a) x
Generic, Int -> RpcRequest a -> ShowS
[RpcRequest a] -> ShowS
RpcRequest a -> String
(Int -> RpcRequest a -> ShowS)
-> (RpcRequest a -> String)
-> ([RpcRequest a] -> ShowS)
-> Show (RpcRequest a)
forall a. Show a => Int -> RpcRequest a -> ShowS
forall a. Show a => [RpcRequest a] -> ShowS
forall a. Show a => RpcRequest a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcRequest a] -> ShowS
$cshowList :: forall a. Show a => [RpcRequest a] -> ShowS
show :: RpcRequest a -> String
$cshow :: forall a. Show a => RpcRequest a -> String
showsPrec :: Int -> RpcRequest a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RpcRequest a -> ShowS
Show)

instance ToJSON a => ToJSON (RpcRequest a)

data Method
  = GetBalance
  | Version
  | GetBlockHeader
  deriving stock ((forall x. Method -> Rep Method x)
-> (forall x. Rep Method x -> Method) -> Generic Method
forall x. Rep Method x -> Method
forall x. Method -> Rep Method x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Method x -> Method
$cfrom :: forall x. Method -> Rep Method x
Generic, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show)

instance ToJSON Method where
  toJSON :: Method -> Value
toJSON Method
GetBalance = Text -> Value
String Text
"blockchain.scripthash.get_balance"
  toJSON Method
Version = Text -> Value
String Text
"server.version"
  toJSON Method
GetBlockHeader = Text -> Value
String Text
"blockchain.block.header"