Move Options to own module in source tree

Also add some tests checking parsing of IP

Author: abailly

db-server.cabal

@@ -54,6 +54,7 @@ library
   hs-source-dirs: src
   exposed-modules:
     Cardano.Tools.DBServer
+    Cardano.Tools.DBServer.Options
 
   build-depends:
     aeson,
@@ -92,6 +93,7 @@ library
     network,
     network-mux,
     nothunks,
+    optparse-applicative,
     ouroboros-consensus ^>= 0.21,
     ouroboros-consensus-cardano,
     ouroboros-consensus-diffusion,
@@ -128,8 +130,7 @@ executable db-server
     optparse-applicative,
     db-server,
     with-utf8,
-  other-modules:
-    DBServer.Options
+
 
 test-suite db-server-test
   import: common-test
@@ -138,21 +139,23 @@ test-suite db-server-test
   main-is: Main.hs
   other-modules:
     Cardano.Tools.DBServerSpec
+    Cardano.Tools.DBServer.OptionsSpec
     Cardano.Tools.TestHelper
   build-depends:
-    QuickCheck,
-    aeson,
-    base,
-    db-server,
-    directory,
-    filepath,
-    hspec,
-    http-types,
-    mtl,
-    temporary,
-    text,
-    unix,
-    wai,
-    wai-extra
+                QuickCheck,
+                aeson,
+                base,
+                db-server,
+                directory,
+                filepath,
+                hspec,
+                http-types,
+                mtl,
+                temporary,
+                text,
+                unix,
+                wai,
+                wai-extra,
+                warp
   build-tool-depends:
     hspec-discover:hspec-discover

src/Cardano/Tools/DBServer/Options.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Cardano.Tools.DBServer.Options (Options (..), optsParser, parseArgs) where
+
+import qualified Network.Socket as Socket
+import Options.Applicative (
+  Parser,
+  ParserInfo,
+  ParserResult (..),
+  auto,
+  defaultPrefs,
+  execParserPure,
+  fullDesc,
+  help,
+  helper,
+  info,
+  long,
+  metavar,
+  option,
+  progDesc,
+  showDefault,
+  strOption,
+  value,
+ )
+
+-- * Options
+data Options = Options
+  { databaseDirectory :: FilePath
+  , port :: Socket.PortNumber
+  , host :: String
+  , configurationFile :: FilePath
+  }
+  deriving stock (Eq, Show)
+
+optsParser :: ParserInfo Options
+optsParser =
+  info (helper <*> parse) $ fullDesc <> progDesc desc
+ where
+  desc = "Serve a ChainDB directory over HTTP"
+
+  parse :: Parser Options
+  parse = do
+    databaseDirectory <-
+      strOption $
+        mconcat
+          [ long "db"
+          , help "Path to the chain DB"
+          , value "db"
+          , metavar "PATH"
+          ]
+    port <-
+      option auto $
+        mconcat
+          [ long "port"
+          , help "Port to listen on"
+          , value 9003
+          , showDefault
+          ]
+    host <-
+      strOption $
+        mconcat
+          [ long "host"
+          , help "host to listen on"
+          , value "127.0.0.1"
+          , showDefault
+          ]
+    configurationFile <-
+      strOption $
+        mconcat
+          [ long "config"
+          , help "Path to cardano-node config file. Note this file should reference existing genesis files."
+          , metavar "PATH"
+          , value "config.json"
+          , showDefault
+          ]
+    pure Options{databaseDirectory, port, host, configurationFile}
+
+parseArgs :: [String] -> Either String Options
+parseArgs args =
+  case execParserPure defaultPrefs optsParser args of
+    Success opts -> Right opts
+    Failure err -> Left (show err)
+    CompletionInvoked _ -> Left "Unexpected completion invocation"

test/Cardano/Tools/DBServer/OptionsSpec.hs

@@ -0,0 +1,19 @@
+module Cardano.Tools.DBServer.OptionsSpec where
+
+import Cardano.Tools.DBServer.Options (Options (..), parseArgs)
+import Data.String (IsString (..))
+import Network.Wai.Handler.Warp (HostPreference)
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+spec :: Spec
+spec = do
+  describe "optsParser" $ do
+    it "can parse --host options" $ do
+      parseArgs ["--host", "0.0.0.0"] `shouldBe` Right (Options "db" 9003 "0.0.0.0" "config.json")
+
+    it "parses host catch-all expressions" $ do
+      -- NOTE: for some reason the constructors of HostPreference are not
+      -- exported so we need to show them to be able to parse them 🤡
+      show (fromString "!4" :: HostPreference) `shouldBe` "HostIPv4Only"
+      show (fromString "*" :: HostPreference) `shouldBe` "HostAny"
+      show (fromString "0.0.0.0" :: HostPreference) `shouldBe` "Host \"0.0.0.0\""