marconi-mamba-JSON-RPC-endpoint PLT-862

Remove all marconi dependecies for the JSON-RPC layer.  This will allow
us to use a generic RPC layer.

marconi-mamba/app/Main.hs

@@ -6,9 +6,9 @@ import Cardano.Api qualified as C
 import Control.Concurrent.Async (race_)
 import Control.Concurrent.STM.TVar (newTVarIO)
 import Data.Map qualified
+import Marconi.Api.HttpServer qualified as Http
+import Marconi.Api.Types (HttpEnv (HttpEnv))
 import Marconi.Indexers qualified as I
-import Marconi.Server.HttpServer qualified as Http
-import Marconi.Server.Types (HttpEnv (HttpEnv))
 import Options.Applicative qualified as Opt
 import Plutus.Streaming (withChainSyncEventStream)
 

marconi-mamba/examples/jsonrpc-server/src/Main.hs → marconi-mamba/examples/json-rpc-server/src/Main.hs

@@ -4,8 +4,8 @@ module Main where
 
 import Control.Concurrent.STM.TVar (newTVarIO)
 import Data.Map.Strict qualified
-import Marconi.Server.HttpServer (httpMain)
-import Marconi.Server.Types (AddressTxOutRefMap, HttpEnv (HttpEnv))
+import Marconi.Api.HttpServer (httpMain)
+import Marconi.Api.Types (HttpEnv (HttpEnv))
 
 
 main :: IO ()
@@ -16,5 +16,3 @@ main = do
         httpEnv = HttpEnv httpPort cache
     httpMain httpEnv
 
-mocTxOutRef :: AddressTxOutRefMap
-mocTxOutRef = undefined

marconi-mamba/json-rpc/src/Marconi/Server/HttpServer.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+
+module Marconi.Server.HttpServer where

marconi-mamba/src/Marconi/Server/Types.hs → marconi-mamba/json-rpc/src/Marconi/Server/Types.hs

@@ -14,27 +14,25 @@
 -- This module provides support for writing handlers for JSON-RPC endpoints
 module Marconi.Server.Types where
 
-import Cardano.Api qualified
 import Control.Concurrent.STM.TVar (TVar)
+import Control.Lens (Bifunctor (bimap), makeClassy)
 import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value)
 import Data.Aeson.Types (parseEither)
 import Data.Map.Strict qualified as Map
 import Data.Proxy (Proxy (Proxy))
 import GHC.TypeLits (KnownSymbol, symbolVal)
-import Ledger (TxOutRef)
-import Servant.API (NoContent (NoContent), Post, ReqBody, (:<|>) ((:<|>)), (:>))
-import Servant.API.ContentTypes (AllCTRender (handleAcceptH))
-
-import Control.Lens (Bifunctor (bimap), makeClassy)
 import Marconi.JsonRpc.Types (JSONRPC, JsonRpc, JsonRpcErr (JsonRpcErr, errorData), JsonRpcNotification,
                               JsonRpcResponse (Errors, Result), RawJsonRpc, Request (Request), invalidParamsCode,
                               invalidRequestCode, methodNotFoundCode)
+import Servant.API (NoContent (NoContent), Post, ReqBody, (:<|>) ((:<|>)), (:>))
+import Servant.API.ContentTypes (AllCTRender (handleAcceptH))
 import Servant.Server (DefaultErrorFormatters, ErrorFormatters, Handler, HasContextEntry,
                        HasServer (hoistServerWithContext, route, type ServerT), type (.++))
 
-
 -- | We need a type that may or man not return content, since we collapsed the entire JSON RPC api to one endpoint.
-data MaybeContent a = SomeContent a | EmptyContent
+data MaybeContent a
+    = SomeContent a
+    | EmptyContent
 
 instance ToJSON a => AllCTRender '[JSONRPC] (MaybeContent a) where
     handleAcceptH px h = \case
@@ -66,7 +64,6 @@ class RouteJsonRpc a where
         -> Map.Map String (Value -> m (MaybeContent (Either (JsonRpcErr Value) Value)))
     hoistRpcRouter :: Proxy a -> (forall x . m x -> n x) -> RpcHandler a m -> RpcHandler a n
 
-
 generalizeResponse
     :: (ToJSON e, ToJSON r)
     => Either (JsonRpcErr e) r
@@ -75,54 +72,40 @@ generalizeResponse = bimap repack toJSON
     where
     repack e = e { errorData = toJSON <$> errorData e }
 
-
 onDecodeFail :: String -> JsonRpcErr e
 onDecodeFail msg = JsonRpcErr invalidParamsCode msg Nothing
 
-
-instance (KnownSymbol method, FromJSON p, ToJSON e, ToJSON r) => RouteJsonRpc (JsonRpc method p e r) where
+instance (KnownSymbol method, FromJSON p, ToJSON e, ToJSON r)
+    => RouteJsonRpc (JsonRpc method p e r) where
     type RpcHandler (JsonRpc method p e r) m = p -> m (Either (JsonRpcErr e) r)
-
     jsonRpcRouter _ _ h = Map.fromList [ (methodName, h') ]
         where
         methodName = symbolVal $ Proxy @method
         onDecode   = fmap generalizeResponse . h
-
         h' = fmap SomeContent
            . either (return . Left . onDecodeFail) onDecode
            . parseEither parseJSON
 
     hoistRpcRouter _ f x = f . x
 
-
 instance (KnownSymbol method, FromJSON p) => RouteJsonRpc (JsonRpcNotification method p) where
     type RpcHandler (JsonRpcNotification method p) m = p -> m NoContent
-
-    jsonRpcRouter _ _ h = Map.fromList [ (methodName, h') ]
-        where
+    jsonRpcRouter _ _ h = Map.fromList [ (methodName, h') ] where
         methodName = symbolVal $ Proxy @method
         onDecode x = EmptyContent <$ h x
-
         h' = either (return . SomeContent . Left . onDecodeFail) onDecode
            . parseEither parseJSON
-
     hoistRpcRouter _ f x = f . x
 
-
 instance (RouteJsonRpc a, RouteJsonRpc b) => RouteJsonRpc (a :<|> b) where
     type RpcHandler (a :<|> b) m = RpcHandler a m :<|> RpcHandler b m
-
     jsonRpcRouter _ pxm (ha :<|> hb) = jsonRpcRouter pxa pxm ha <> jsonRpcRouter pxb pxm hb
         where
         pxa = Proxy @a
         pxb = Proxy @b
-
     hoistRpcRouter _ f (x :<|> y) = hoistRpcRouter (Proxy @a) f x :<|> hoistRpcRouter (Proxy @b) f y
 
-
--- | This function is the glue required to convert a collection of
--- handlers in servant standard style to the handler that 'RawJsonRpc'
--- expects.
+-- | Collapse a to a single handler to handle RawJsonRpc
 serveJsonRpc
     :: (Monad m, RouteJsonRpc a)
     => Proxy a
@@ -142,12 +125,3 @@ serveJsonRpc px pxm hs (Request m v ix')
     missingMethod  = JsonRpcErr methodNotFoundCode ("Unknown method: " <> m) Nothing
     hmap           = jsonRpcRouter px pxm hs
     invalidRequest = JsonRpcErr invalidRequestCode "Missing id" Nothing
-
-type RpcPortNumber = Int
-type AddressTxOutRefMap = (Map.Map(Cardano.Api.Address Cardano.Api.ShelleyAddr) TxOutRef)
-type AddressTxOutRefCache = TVar AddressTxOutRefMap
-data HttpEnv = HttpEnv {
-    _portNumber             :: RpcPortNumber
-    , _addressTxOutRefCache :: AddressTxOutRefCache
-    }
-makeClassy ''HttpEnv

marconi-mamba/marconi-mamba.cabal

@@ -43,16 +43,15 @@ library
   import:          lang
   hs-source-dirs:  src
   exposed-modules:
-    Marconi.Client.Types
-    Marconi.JsonRpc.Types
-    Marconi.Server.HttpServer
-    Marconi.Server.Routes
-    Marconi.Server.Types
+    Marconi.Api.HttpServer
+    Marconi.Api.Routes
+    Marconi.Api.Types
 
   --------------------
   -- Local components
   --------------------
   build-depends:
+    , json-rpc
     , marconi
     , plutus-ledger
 
@@ -83,6 +82,45 @@ library
     , time
     , warp
 
+library json-rpc
+  import:          lang
+  hs-source-dirs:  json-rpc/src
+  exposed-modules:
+    Marconi.Client.Types
+    Marconi.JsonRpc.Types
+    Marconi.Server.HttpServer
+    Marconi.Server.Types
+
+  --------------------
+  -- Local components
+  --------------------
+  build-depends:
+
+  --------------------------
+  -- Other IOG dependencies
+  --------------------------
+  build-depends:
+
+  ------------------------
+  -- Non-IOG dependencies
+  ------------------------
+  build-depends:
+    , aeson
+    , base                  >=4.9 && <5
+    , containers
+    , http-media
+    , lens
+    , mtl
+    , optparse-applicative
+    , servant
+    , servant-client
+    , servant-client-core
+    , servant-server
+    , stm
+    , text
+    , time
+    , warp
+
 executable marconi-mamba
   import:         lang
   hs-source-dirs: app
@@ -92,6 +130,7 @@ executable marconi-mamba
   -- Local components
   --------------------
   build-depends:
+    , json-rpc
     , marconi
     , marconi-mamba
     , plutus-streaming
@@ -113,15 +152,16 @@ executable marconi-mamba
     , optparse-applicative
     , stm
 
-executable examples-jsonrpc-server
+executable examples-json-rpc-server
   import:         lang
-  hs-source-dirs: examples/jsonrpc-server/src
+  hs-source-dirs: examples/json-rpc-server/src
   main-is:        Main.hs
 
   --------------------
   -- Local components
   --------------------
   build-depends:
+    , json-rpc
     , marconi
     , marconi-mamba
     , plutus-streaming
@@ -139,15 +179,16 @@ executable examples-jsonrpc-server
     , containers
     , stm
 
-executable examples-jsonrpc-client
+executable examples-json-rpc-client
   import:         lang
-  hs-source-dirs: examples/jsonrpc-client/src
+  hs-source-dirs: examples/json-rpc-client/src
   main-is:        Main.hs
 
   --------------------
   -- Local components
   --------------------
   build-depends:
+    , json-rpc
     , marconi
     , marconi-mamba
     , plutus-streaming

marconi-mamba/src/Marconi/Server/HttpServer.hs → marconi-mamba/src/Marconi/Api/HttpServer.hs

@@ -5,16 +5,17 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeApplications      #-}
 
-module Marconi.Server.HttpServer where
+module Marconi.Api.HttpServer where
 
 import Control.Lens ((^.))
 import Control.Monad.IO.Class (liftIO)
 import Data.Proxy (Proxy (Proxy))
 import Data.Time (defaultTimeLocale, formatTime, getCurrentTime)
 import Ledger (TxId (TxId), TxOutRef (TxOutRef, txOutRefId, txOutRefIdx))
+import Marconi.Api.Routes (API)
+import Marconi.Api.Types (AddressTxOutRefCache, HasHttpEnv (addressTxOutRefCache, portNumber), HttpEnv)
 import Marconi.JsonRpc.Types (JsonRpcErr)
-import Marconi.Server.Routes (API)
-import Marconi.Server.Types (AddressTxOutRefCache, HasHttpEnv (addressTxOutRefCache, portNumber), HttpEnv)
+import Marconi.Server.Types ()
 import Network.Wai.Handler.Warp (run)
 import Servant.API (NoContent (NoContent), (:<|>) ((:<|>)))
 import Servant.Server (Handler, Server, serve)

marconi-mamba/src/Marconi/Server/Routes.hs → marconi-mamba/src/Marconi/Api/Routes.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DataKinds     #-}
 {-# LANGUAGE TypeOperators #-}
 
-module Marconi.Server.Routes where
+module Marconi.Api.Routes where
 import Ledger.Tx (TxOutRef)
 import Marconi.JsonRpc.Types (JsonRpc, JsonRpcNotification, RawJsonRpc)
 import Servant.API (Get, NoContent, PlainText, Post, ReqBody, (:<|>), (:>))

marconi-mamba/src/Marconi/Api/Types.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE TemplateHaskell       #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE UndecidableInstances  #-}
+
+-- |
+-- This module provides support for writing handlers for JSON-RPC endpoints
+module Marconi.Api.Types where
+
+import Cardano.Api qualified
+import Control.Concurrent.STM.TVar (TVar)
+import Control.Lens
+import Data.Map.Strict qualified as Map
+import Ledger (TxOutRef)
+
+type RpcPortNumber = Int
+
+type AddressTxOutRefMap = (Map.Map(Cardano.Api.Address Cardano.Api.ShelleyAddr) TxOutRef)
+
+type AddressTxOutRefCache = TVar AddressTxOutRefMap
+
+data HttpEnv = HttpEnv {
+    _portNumber             :: RpcPortNumber
+    , _addressTxOutRefCache :: AddressTxOutRefCache
+    }
+makeClassy ''HttpEnv