cli: Add --state-dir argument to cardano-wallet-launcher

cardano-foundation · Jun 6, 2019 · 0cf0f46 · 0cf0f46
1 parent 09572c3
commit 0cf0f46
Show file tree

Hide file tree

Showing 2 changed files with 41 additions and 23 deletions.
diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal
@@ -66,7 +66,9 @@ executable cardano-wallet-launcher
     , cardano-wallet-cli
     , cardano-wallet-http-bridge
     , cardano-wallet-launcher
+    , directory
     , docopt
+    , filepath
     , fmt
     , process
     , say

diff --git a/exe/launcher/Main.hs b/exe/launcher/Main.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuasiQuotes #-}
 
 module Main where
@@ -25,7 +26,7 @@ import Data.Text.Class
 import Fmt
     ( blockListF, fmt )
 import Say
-    ( sayErr )
+    ( sayErr, sayString )
 import System.Console.Docopt
     ( Arguments
     , Docopt
@@ -37,10 +38,14 @@ import System.Console.Docopt
     , parseArgsOrExit
     , shortOption
     )
+import System.Directory
+    ( createDirectory, doesDirectoryExist )
 import System.Environment
     ( getArgs )
 import System.Exit
     ( exitWith )
+import System.FilePath
+    ( (</>) )
 
 import qualified Data.Text as T
 
@@ -66,6 +71,7 @@ Options:
   --network <STRING>           testnet, staging, mainnet, or local [default: testnet]
   --wallet-server-port <PORT>  port used for serving the wallet API [default: 8090]
   --http-bridge-port <PORT>    port used for communicating with the http-bridge [default: 8080]
+  --state-dir <DIR>            write wallet state (blockchain and database) to this directory
 |]
 
 main :: IO ()
@@ -75,15 +81,17 @@ main = do
     when (args `isPresent` (shortOption 'h')) $ help cli
     when (args `isPresent` (longOption "version")) $ putStrLn getVersion
 
+    let stateDir = args `getArg` (longOption "state-dir")
     let network = fromMaybe "testnet" $ args `getArg` (longOption "network")
     bridgePort <- args `parseArg` longOption "http-bridge-port"
     walletPort <- args `parseArg` longOption "wallet-server-port"
 
     sayErr "Starting..."
     installSignalHandlers
+    maybe (pure ()) setupStateDir stateDir
     let commands =
-            [ nodeHttpBridgeOn bridgePort network
-            , walletOn walletPort bridgePort network
+            [ nodeHttpBridgeOn stateDir bridgePort network
+            , walletOn stateDir walletPort bridgePort network
             ]
     sayErr $ fmt $ blockListF commands
     (ProcessHasExited name code) <- launch commands
@@ -93,25 +101,33 @@ main = do
     parseArg :: FromText a => Arguments -> Option -> IO a
     parseArg = parseArgWith cli
 
-nodeHttpBridgeOn :: Port "Node" -> String -> Command
-nodeHttpBridgeOn port net = Command
-    "cardano-http-bridge"
-    [ "start"
-    , "--port", T.unpack (toText port)
-    , "--template", net
-    ]
-    (return ())
-    Inherit
-
-walletOn :: Port "Wallet" -> Port "Node" -> String -> Command
-walletOn wp np net = Command
-    "cardano-wallet"
-    [ "server"
-    , "--network", if net == "local" then "testnet" else net
-    , "--port", T.unpack (toText wp)
-    , "--bridge-port", T.unpack (toText np)
-    ]
-    (threadDelay oneSecond)
-    Inherit
+nodeHttpBridgeOn :: Maybe FilePath -> Port "Node" -> String -> Command
+nodeHttpBridgeOn stateDir port net =
+    Command "cardano-http-bridge" args (return ()) Inherit
   where
+    args =
+        [ "start"
+        , "--port", T.unpack (toText port)
+        , "--template", net
+        ] ++ networkArg
+    networkArg = maybe [] (\d -> ["--networks-dir", d]) stateDir
+
+walletOn :: Maybe FilePath -> Port "Wallet" -> Port "Node" -> String -> Command
+walletOn stateDir wp np net =
+    Command "cardano-wallet" args (threadDelay oneSecond) Inherit
+  where
+    args =
+        [ "server"
+        , "--network", if net == "local" then "testnet" else net
+        , "--port", T.unpack (toText wp)
+        , "--bridge-port", T.unpack (toText np)
+        ] ++ dbArg
+    dbArg = maybe [] (\d -> ["--database", d </> "wallet.db"]) stateDir
     oneSecond = 1000000
+
+setupStateDir :: FilePath -> IO ()
+setupStateDir dir = doesDirectoryExist dir >>= \case
+    True -> sayString $ "Using state directory: " ++ dir
+    False -> do
+        sayString $ "Creating state directory: " ++ dir
+        createDirectory dir