[GH-78] Create the initial launcher version. (#84)

* [GH-78] Create the initial launcher version.

* [GH-78] Fix the wallet args.

* [GH-78] Add something to run.

Author: ksaric

app/Launcher/Main.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase      #-}
+{-# LANGUAGE RankNTypes      #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Main where
 
@@ -8,12 +10,17 @@ import qualified Prelude
 import           System.Directory (createDirectoryIfMissing)
 import           System.FilePath ((</>))
 
-import           Formatting (build, bprint, formatToString)
+import qualified System.Process as Process
+import           Turtle (system)
+
+import           Formatting (bprint, build, formatToString)
 import           Formatting.Buildable (Buildable (..))
 
 import           Control.Exception.Safe (throwM)
 
-import           Cardano.Shell.Configuration.Types (LauncherConfig (..))
+import           Cardano.Shell.Configuration.Types (LauncherConfig (..),
+                                                    WalletArguments (..),
+                                                    WalletPath (..))
 
 import           Cardano.X509.Configuration (ConfigurationKey (..),
                                              DirConfiguration (..), certChecks,
@@ -39,11 +46,19 @@ main = do
             , lcfgSeed        = Nothing
             }
 
+    -- Really no clue what to put there and how will the wallet work.
+    let walletPath :: WalletPath
+        walletPath = WalletPath "stack"
+
+    let walletArgs :: WalletArguments
+        walletArgs = WalletArguments ["exec", "cardano-shell-exe"]
+
     -- | Yes, this is something we probably need to replace with actual loggging.
     let externalDependencies :: ExternalDependencies
         externalDependencies = ExternalDependencies
             { logInfo       = putTextLn
             , logError      = putTextLn
+            , logNotice     = putTextLn
             }
 
     -- | If we need to, we first check if there are certificates so we don't have
@@ -54,13 +69,63 @@ main = do
         launcherConfig
         (TLSPath "./configuration/") -- where to generate the certificates
 
+    -- With the exit code
+    _ <- runWallet externalDependencies walletPath walletArgs
+
+    pure ()
+
+-- | Launching the wallet.
+-- For now, this is really light since we don't know whether we will reuse the
+-- older configuration and if so, which parts of it.
+-- We passed in the bare minimum and if we require anything else, we will add it.
+runWallet
+    :: ExternalDependencies
+    -> WalletPath
+    -> WalletArguments
+    -> IO ExitCode
+runWallet ed@ExternalDependencies{..} walletPath walletArguments = do
+    logNotice "Starting the wallet"
+
+    -- create the wallet process
+    walletExitStatus <- system (createProc Process.Inherit walletPath walletArguments) mempty
+
+    case walletExitStatus of
+        ExitFailure 21 -> do
+            logNotice "The wallet has exited with code 21"
+            --logInfo "Switching Configuration to safe mode"
+            --saveSafeMode lo True
+            runWallet ed walletPath walletArguments
+
+        ExitFailure 22 -> do
+            logNotice "The wallet has exited with code 22"
+            --logInfo "Switching Configuration to normal mode"
+            --saveSafeMode lo False
+            runWallet ed walletPath walletArguments
+
+        -- Otherwise, return the exit status.
+        _ -> pure walletExitStatus
+  where
+    -- | The creation of the process.
+    createProc
+        :: Process.StdStream
+        -> WalletPath
+        -> WalletArguments
+        -> Process.CreateProcess
+    createProc stdStream (WalletPath commandPath) (WalletArguments commandArguments) =
+        (Process.proc (strConv Lenient commandPath) (map (strConv Lenient) commandArguments))
+            { Process.std_in    = Process.CreatePipe
+            , Process.std_out   = stdStream
+            , Process.std_err   = stdStream
+            }
+
 --------------------------------------------------------------------------------
 -- Types
 --------------------------------------------------------------------------------
 
 data ExternalDependencies = ExternalDependencies
-    { logInfo       :: Text -> IO ()
-    , logError      :: Text -> IO ()
+    { logInfo   :: Text -> IO ()
+    , logError  :: Text -> IO ()
+    , logNotice :: Text -> IO ()
     }
 
 newtype X509ToolPath = X509ToolPath { getX509ToolPath :: FilePath }

cardano-shell.cabal

@@ -145,9 +145,12 @@ executable cardano-launcher
     , cardano-shell
     , cardano-prelude
     , cardano-sl-x509
+    -- conccurency
+    , async
     -- process managment
     , process
     , unix
+    , turtle
     -- directory
     , directory
     , filepath

cardano-shell.nix

@@ -1,9 +1,9 @@
-{ mkDerivation, aeson, base, binary, bytestring, Cabal
+{ mkDerivation, aeson, async, base, binary, bytestring, Cabal
 , cardano-prelude, cardano-sl-x509, concurrency, containers
 , contravariant, dejafu, dhall, directory, ekg-core, filepath
 , formatting, hspec, hspec-contrib, hunit-dejafu, iohk-monitoring
 , process, QuickCheck, safe-exceptions, stdenv, text, transformers
-, unix
+, turtle, unix
 }:
 mkDerivation {
   pname = "cardano-shell";
@@ -18,8 +18,8 @@ mkDerivation {
     transformers unix
   ];
   executableHaskellDepends = [
-    base cardano-prelude cardano-sl-x509 directory filepath formatting
-    iohk-monitoring process safe-exceptions unix
+    async base cardano-prelude cardano-sl-x509 directory filepath
+    formatting iohk-monitoring process safe-exceptions turtle unix
   ];
   testHaskellDepends = [
     aeson base cardano-prelude concurrency dejafu dhall hspec

dhall/features/wallet.dhall

@@ -10,4 +10,4 @@
 , walletRelays   = { getWalletRelays = topology.wallet.wtcfgRelays}
 , walletValency  = { getWalletValency = topology.wallet.wtcfgValency}
 , walletFallback = { getWalletFallback = topology.wallet.wtcfgFallbacks}
-}
+}

src/Cardano/Shell/Configuration/Lib.hs

@@ -78,6 +78,7 @@ mkNetworkConfig os cluster = input auto networkPath
         <> "(" <> toPath "launcher" <> " " <> clusterPath cluster <> " " <>
         "(" <> osPath os <> " " <> clusterPath cluster <> ")" <>")"
 
+-- TODO(KS): This is a bit complicated.
 mkWalletConfig :: OS -> Cluster -> IO WalletConfig
 mkWalletConfig os cluster = input auto walletPath
   where

src/Cardano/Shell/Configuration/Types.hs

@@ -44,6 +44,7 @@ module Cardano.Shell.Configuration.Types
     , Tlsca(..)
     , Tlscert(..)
     , Tlskey(..)
+    , WalletArguments(..)
     , WalletDbPath(..)
     , WalletPath(..)
     , WalletLogging(..)
@@ -59,9 +60,9 @@ import           Cardano.Prelude hiding (evalState, maybe)
 import           Control.Monad.Trans.State.Strict (evalState)
 import           Data.Functor.Contravariant (contramap)
 import qualified Data.Text as T
-import           Dhall (GenericInject, Inject (..), InputType (..), Interpret (..),
-                        InterpretOptions (..), auto, field, genericInjectWith,
-                        record)
+import           Dhall (GenericInject, Inject (..), InputType (..),
+                        Interpret (..), InterpretOptions (..), auto, field,
+                        genericInjectWith, record)
 import           GHC.Generics (from)
 import           Test.QuickCheck (Arbitrary (..), Gen, arbitraryASCIIChar,
                                   elements, listOf, listOf1)
@@ -629,6 +630,17 @@ instance Inject Tlskey
 instance Arbitrary Tlskey where
     arbitrary = Tlskey <$> genSafeText
 
+newtype WalletArguments = WalletArguments
+    { getWalletArguments :: [Text]
+    } deriving (Eq, Show, Generic)
+
+-- Not sure if we will use it in Dhall
+--instance Interpret WalletArguments
+--instance Inject WalletArguments
+
+instance Arbitrary WalletArguments where
+    arbitrary = WalletArguments <$> listOf1 genSafeText
+
 newtype WalletDbPath = WalletDbPath {
     getDbPath :: Text
     } deriving (Eq, Show, Generic)
@@ -816,39 +828,39 @@ instance Arbitrary NetworkConfig where
             }
 
 data WalletConfig = WalletConfig
-    { walletDbPath   :: !WalletDbPath
-    , walletPath     :: !WalletPath
-    , walletLogging  :: !WalletLogging
-    , walletPort     :: !WalletPort
-    , walletAddress  :: !WalletAddress
-    , walletRelays   :: !WalletRelays
-    , walletFallback :: !WalletFallback
-    , walletValency  :: !WalletValency
+    { walletDbPath      :: !WalletDbPath
+    , walletPath        :: !WalletPath
+    , walletLogging     :: !WalletLogging
+    , walletPort        :: !WalletPort
+    , walletAddress     :: !WalletAddress
+    , walletRelays      :: !WalletRelays
+    , walletFallback    :: !WalletFallback
+    , walletValency     :: !WalletValency
     } deriving (Eq, Generic, Show)
 
 instance Interpret WalletConfig
 instance Inject WalletConfig
 
 instance Arbitrary WalletConfig where
     arbitrary = do
-        dbpath   <- arbitrary
-        path     <- arbitrary
-        logging  <- arbitrary
-        port     <- arbitrary
-        address  <- arbitrary
-        relays   <- arbitrary
-        fallback <- arbitrary
-        valency  <- arbitrary
+        dbpath              <- arbitrary
+        path                <- arbitrary
+        logging             <- arbitrary
+        port                <- arbitrary
+        address             <- arbitrary
+        relays              <- arbitrary
+        fallback            <- arbitrary
+        valency             <- arbitrary
 
         pure $ WalletConfig
-            { walletDbPath   = dbpath
-            , walletPath     = path
-            , walletLogging  = logging
-            , walletPort     = port
-            , walletAddress  = address
-            , walletRelays   = relays
-            , walletFallback = fallback
-            , walletValency  = valency
+            { walletDbPath      = dbpath
+            , walletPath        = path
+            , walletLogging     = logging
+            , walletPort        = port
+            , walletAddress     = address
+            , walletRelays      = relays
+            , walletFallback    = fallback
+            , walletValency     = valency
             }
 
 --------------------------------------------------------------------------------

test/DhallConfigSpec.hs

@@ -124,3 +124,4 @@ mkConfigSpec = describe "Cardano configurations" $ do
             \(os :: OS) (cluster :: Cluster) -> monadicIO $ do
                 eWalletConfig <- run $ tryAny $ mkWalletConfig os cluster
                 assert $ isRight eWalletConfig
+