Add servant server

Author: tweag-ev-ak

app/App.hs

@@ -3,12 +3,14 @@
 --------------------------------------------------------------------------------
 
 import Cardano.Api qualified as C
+import Control.Concurrent.Async
 import Data.Function ((&))
 import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Yaml (decodeFileThrow)
 import Options
 import Options.Applicative
+import qualified PSR.Web as Web
 import PSR.Chain
 import PSR.ConfigMap qualified as CM
 import PSR.ContextBuilder
@@ -36,18 +38,21 @@ main = do
     -- TODO: Use a logging interface instead of using putStrLn.
     putStrLn "Started..."
 
-    let confPolicyMap = Map.fromList [(CM.script_hash x, x) | x <- scripts]
-        conn = mkLocalNodeConnectInfo networkId socketPath
-    streamChainSyncEvents conn points
-        & Stream.filter (not . isByron)
-        & fmap getEventTransactions
-        & Stream.postscanl trackPreviousChainPoint
-        -- TODO: Try to replace "concatMap" with "unfoldEach".
-        & Stream.concatMap (Stream.fromList . (\(a, b) -> (a,) <$> b))
-        & Stream.mapM (mkContext1 conn . uncurry mkContext0)
-        & Stream.filter
-            ( \ctx1@Context1{..} ->
-                not . Map.null . Map.restrictKeys confPolicyMap $
-                    Set.union (getMintPolicies context0) (getSpendPolicies ctx1)
-            )
-        & Stream.fold (Fold.drainMapM print)
+    withAsync (Web.run webServerPort) $ \serverAsync -> do
+      link serverAsync
+
+      let confPolicyMap = Map.fromList [(CM.script_hash x, x) | x <- scripts]
+          conn = mkLocalNodeConnectInfo networkId socketPath
+      streamChainSyncEvents conn points
+          & Stream.filter (not . isByron)
+          & fmap getEventTransactions
+          & Stream.postscanl trackPreviousChainPoint
+          -- TODO: Try to replace "concatMap" with "unfoldEach".
+          & Stream.concatMap (Stream.fromList . (\(a, b) -> (a,) <$> b))
+          & Stream.mapM (mkContext1 conn . uncurry mkContext0)
+          & Stream.filter
+              ( \ctx1@Context1{..} ->
+                  not . Map.null . Map.restrictKeys confPolicyMap $
+                      Set.union (getMintPolicies context0) (getSpendPolicies ctx1)
+              )
+          & Stream.fold (Fold.drainMapM print)

app/Options.hs

@@ -2,6 +2,7 @@ module Options where
 
 import Cardano.Api
 import Options.Applicative
+import Network.Wai.Handler.Warp (Port)
 
 --------------------------------------------------------------------------------
 -- Options
@@ -17,6 +18,7 @@ data Options = Options
     { socketPath :: SocketPath
     , networkId :: NetworkId
     , scriptYaml :: FilePath
+    , webServerPort :: Port 
     }
     deriving (Show, Eq)
 
@@ -26,6 +28,7 @@ parseOptions =
         <$> optSocketPath
         <*> optNetworkId
         <*> optScriptYaml
+        <*> optWebServerPort
   where
     optSocketPath =
         File
@@ -51,6 +54,13 @@ parseOptions =
                 <> metavar "PATH"
                 <> help "Path to script.yaml"
             )
+    optWebServerPort =
+        option auto 
+          ( long "web-server-port"
+            <> metavar "WEB_SERVER_PORT"
+            <> help "Port of the web server API"
+            <> value 8080 
+          )
 
 psrOpts :: ParserInfo Options
 psrOpts =

lib/PSR/Web.hs

@@ -0,0 +1,31 @@
+module PSR.Web (
+  run
+  ) where
+
+import Data.Text (Text)
+import Data.Aeson (FromJSON, ToJSON)
+import GHC.Generics
+import qualified Network.Wai.Handler.Warp as Warp
+import Servant
+import Servant.Server.Generic ()
+
+data Event = Event {
+  content :: Text
+} deriving (Generic, Show)
+
+instance FromJSON Event 
+instance ToJSON Event 
+
+type ServerAPI = "events" :> Get '[JSON] [Event]
+
+serverApi :: Proxy ServerAPI
+serverApi = Proxy
+
+server :: Server ServerAPI 
+server = eventsH
+  where
+    eventsH = do
+      pure []
+
+run :: Warp.Port -> IO ()
+run port = Warp.run port (serve serverApi server)

plutus-script-reexecutor.cabal

@@ -51,9 +51,11 @@ library
     PSR.ConfigMap
     PSR.ContextBuilder
     PSR.Streaming
+    PSR.Web
 
   build-depends:
     , base                         >=4.9 && <5
+    , aeson
     , cardano-api
     , cardano-ledger-alonzo
     , cardano-ledger-core
@@ -62,9 +64,14 @@ library
     , ouroboros-consensus
     , ouroboros-consensus-cardano
     , ouroboros-network-protocols
+    , servant
+    , servant-server
     , streamly
     , streamly-core
+    , text
     , yaml
+    , wai
+    , warp
 
 executable exec
   import:         lang
@@ -73,13 +80,15 @@ executable exec
   hs-source-dirs: app
   build-depends:
     , base                      >=4.9 && <5
+    , async
     , cardano-api
     , containers
     , optparse-applicative
     , plutus-script-reexecutor
     , streamly
     , streamly-core
     , yaml
+    , warp
 
 benchmark bench
   import:         lang