feat: introduce 'serve' and 'query' commands

only 'serve' is implemented for now

Author: abailly

README.md

@@ -36,7 +36,7 @@ To run `db-server` over a `preprod` network database:
 Then from the source directory of `db-server`, starts the server with the following command:
 
 ```
-cabal run db-server -- --db db --config config/config.json
+cabal run db-server -- serve --db db --config config/config.json
 ```
 
 In the terminal, one should start seeing JSON-formatted log entries like:
@@ -55,7 +55,7 @@ The last entry above with the `HttpServerListening` signals the database is open
 
 #### Retrieve header bytes
 
-* `GET /:slot/:hash/header`: Retrieves raw hex-encoded bytes of a block header at given `:slot` and with given `:hash` (aka. _point_)
+* `GET /blocks/:slot/:hash/header`: Retrieves raw hex-encoded bytes of a block header at given `:slot` and with given `:hash` (aka. _point_)
   * `200` : Returns the raw hex-encoded bytes for header
   * `400` : Wrongly formatted `:slot` or `:hash` paths
   * `404` : No block exists at given point
@@ -69,7 +69,7 @@ The last entry above with the `HttpServerListening` signals the database is open
 
 #### Retrieve block bytes
 
-* `GET /:slot/:hash`: Retrieves raw hex-encoded CBOR bytes of a block at given `:slot` and with given `:hash` (aka. _point_)
+* `GET /blocks/:slot/:hash`: Retrieves raw hex-encoded CBOR bytes of a block at given `:slot` and with given `:hash` (aka. _point_)
   * `200` : Returns hex-encoded bytes for the block serialised as CBOR
   * `400` : Wrongly formatted `:slot` or `:hash` paths
   * `404` : No block exists at given point

app/DBServer/Options.hs

@@ -1,11 +1,14 @@
-{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 
 module Main (main) where
 
 import Cardano.Crypto.Init (cryptoInit)
+import qualified Cardano.Tools.DBQuery as DBQuery
 import qualified Cardano.Tools.DBServer as DBServer
-import DBServer.Options (Options (..), optsParser)
+import Cardano.Tools.DBServer.Options (Options (..), QueryOptions (..), ServeOptions (..), optsParser)
+import Control.Tracer (nullTracer)
 import Main.Utf8 (withStdTerminalHandles)
 import Options.Applicative
 import System.IO (stdout)
@@ -14,5 +17,8 @@ main :: IO ()
 main = withStdTerminalHandles $
   DBServer.withLog stdout $ \tracer -> do
     cryptoInit
-    Options{configurationFile, host, port, databaseDirectory} <- execParser optsParser
-    DBServer.run tracer port host configurationFile databaseDirectory
+    execParser optsParser >>= \case
+      Serve ServeOptions {configurationFile, host, port, databaseDirectory} ->
+        DBServer.run tracer port host configurationFile databaseDirectory
+      Query QueryOptions {configurationFile, databaseDirectory, query} ->
+        DBQuery.runQuery nullTracer configurationFile databaseDirectory query

app/db-server.hs

@@ -53,6 +53,7 @@ library
   import: common-lib
   hs-source-dirs: src
   exposed-modules:
+    Cardano.Tools.DBQuery
     Cardano.Tools.DBServer
     Cardano.Tools.DBServer.Options
 
@@ -62,60 +63,24 @@ library
     base16-bytestring >=1.0,
     base64-bytestring,
     bytestring >=0.10 && <0.13,
-    cardano-crypto,
     cardano-crypto-class,
-    cardano-crypto-wrapper,
-    cardano-git-rev ^>=0.2.1,
-    cardano-ledger-allegra,
-    cardano-ledger-alonzo,
     cardano-ledger-api,
-    cardano-ledger-babbage,
     cardano-ledger-binary,
-    cardano-ledger-byron,
-    cardano-ledger-conway,
-    cardano-ledger-core,
-    cardano-ledger-mary,
-    cardano-ledger-shelley,
-    cardano-prelude,
-    cardano-protocol-tpraos,
     cardano-slotting,
-    cardano-strict-containers,
-    cborg ^>=0.2.2,
-    compact,
-    containers >=0.5 && <0.8,
     contra-tracer,
-    directory,
-    filepath,
-    fs-api,
-    githash,
     http-types,
-    microlens,
-    mtl,
     network,
-    network-mux,
-    nothunks,
     optparse-applicative,
     ouroboros-consensus ^>= 0.21,
     ouroboros-consensus-cardano,
     ouroboros-consensus-diffusion,
-    ouroboros-consensus-protocol:unstable-protocol-testlib,
     ouroboros-consensus-cardano:unstable-cardano-tools,
-    ouroboros-consensus-protocol,
-    ouroboros-network,
     ouroboros-network-api,
-    ouroboros-network-framework,
-    ouroboros-network-protocols,
-    resource-registry,
-    serialise,
-    singletons,
+    QuickCheck,
     sop-core,
     sop-extras,
-    strict-sop-core,
     text,
-    text-builder,
     time,
-    transformers,
-    transformers-except,
     wai,
     warp
 
@@ -151,7 +116,6 @@ test-suite db-server-test
                 filepath,
                 hspec,
                 http-types,
-                mtl,
                 temporary,
                 text,
                 unix,

db-server.cabal

@@ -0,0 +1,23 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+module Cardano.Tools.DBQuery (runQuery) where
+
+import Ouroboros.Consensus.Storage.ChainDB (TraceEvent)
+import Cardano.Tools.DBServer (StandardBlock)
+import GHC.Generics (Generic)
+import Data.Aeson (ToJSON (..), (.=), object)
+import Data.Text (Text)
+import Control.Tracer (Tracer)
+
+data DBQueryLog = DBLog (TraceEvent StandardBlock)
+  deriving stock (Eq, Show, Generic)
+
+instance ToJSON DBQueryLog where
+  toJSON = \case
+    DBLog l -> object ["tag" .= ("ChainDB" :: Text), "log" .= show l]
+
+runQuery :: Tracer IO DBQueryLog -> FilePath -> FilePath -> String -> IO ()
+runQuery tracer configurationFile databaseDirectory query =
+  undefined

src/Cardano/Tools/DBQuery.hs

@@ -20,6 +20,7 @@ module Cardano.Tools.DBServer (
   run,
   DBServerLog (..),
   StandardPoint,
+  StandardBlock,
   asInteger,
   pattern StandardPoint,
   withLog,