Merge #361

361: allow persisting safemode flag r=disassembler a=cleverca22



Co-authored-by: Michael Bishop <[email protected]>

Author: iohk-bors[bot]

cardano-launcher/app/Main.hs

@@ -46,6 +46,7 @@ import           Cardano.X509.Configuration (TLSConfiguration)
 import           Control.Exception.Safe (throwM)
 
 import           System.FilePath ((</>))
+import           System.IO (hClose)
 
 --------------------------------------------------------------------------------
 -- Main
@@ -131,11 +132,14 @@ main = silence $ do
                     throwM $ LauncherOptionsError (show err)
                 Right lo -> pure lo
 
-        let lockFile = loStateDir launcherOptions </> "daedalus_lockfile"
+        let stateDir :: FilePath
+            stateDir = loStateDir launcherOptions
+
+        let lockFile = stateDir </> "daedalus_lockfile"
         Trace.logNotice baseTrace $ "Locking file so that multiple applications won't run at same time"
         -- Check if it's locked or not. Will throw an exception if the
         -- application is already running.
-        _                   <- checkIfApplicationIsRunning lockFile
+        lockHandle          <- checkIfApplicationIsRunning lockFile
 
         let workingDir = loWorkingDirectory launcherOptions
 
@@ -187,6 +191,10 @@ main = silence $ do
                         daedalusBin
                         updaterExecutionFunction
                         updaterData
+                        stateDir
+
+        -- release the lock on the lock file
+        hClose lockHandle
 
         -- Exit the program with exit code.
         exitWith exitCode

cardano-launcher/src/Cardano/Shell/Application.hs

@@ -53,7 +53,7 @@ instance Show ApplicationError where
 -- it can find the app state dir by config, or from the server environment. It can release
 -- the lock file on shutdown (ok, that's actually automatic, but it fits
 -- into the framework as a nice example).
-checkIfApplicationIsRunning :: FilePath -> IO ()
+checkIfApplicationIsRunning :: FilePath -> IO Handle
 checkIfApplicationIsRunning lockFilePath = do
 
     fileExist <- doesFileExist lockFilePath
@@ -71,4 +71,4 @@ checkIfApplicationIsRunning lockFilePath = do
         throwM ApplicationAlreadyRunningException
 
     -- Otherwise, all is good.
-    return ()
+    return lockfileHandle

cardano-launcher/src/Cardano/Shell/Launcher.hs

@@ -11,6 +11,8 @@ module Cardano.Shell.Launcher
     -- * Functions
     , runLauncher
     , runWalletProcess
+    , saveSafeMode
+    , readSafeMode
     -- * Critical exports (testing)
     , DaedalusExitCode (..)
     , handleDaedalusExitCode
@@ -27,6 +29,8 @@ module Cardano.Shell.Launcher
 import           Cardano.Prelude hiding (onException)
 
 import           Prelude (Show (..))
+import           Data.Aeson (FromJSON, ToJSON(toJSON), genericParseJSON, genericToJSON, defaultOptions)
+import           Data.Yaml as Y
 import qualified System.Process as Process
 import           Turtle (system)
 
@@ -74,6 +78,25 @@ data WalletMode
     | WalletModeSafe
     deriving (Eq, Show)
 
+instance FromJSON WalletMode where
+  parseJSON (String "safe") = pure WalletModeSafe
+  parseJSON (String "normal") = pure WalletModeNormal
+  parseJSON _ = pure WalletModeNormal
+
+instance ToJSON WalletMode where
+  toJSON WalletModeNormal = String "normal"
+  toJSON WalletModeSafe = String "safe"
+
+data SafeModeConfig = SafeModeConfig
+  { smcSafeMode :: WalletMode
+  } deriving (Generic, Show)
+
+instance FromJSON SafeModeConfig where
+  parseJSON = genericParseJSON defaultOptions
+
+instance ToJSON SafeModeConfig where
+  toJSON = genericToJSON defaultOptions
+
 -- | All the important exit codes. Since we cover "other" cases as well, this is a total mapping.
 -- That is good.
 -- TODO(KS): We could extend this to try to encode some interesting properties about it.
@@ -125,6 +148,22 @@ instance Isomorphism DaedalusExitCode ExitCode where
 -- Functions
 --------------------------------------------------------------------------------
 
+readSafeMode :: FilePath -> IO WalletMode
+readSafeMode stateDir = do
+  let safeModeConfigFile = getSafeModeConfigPath stateDir
+  decoded <- liftIO $ Y.decodeFileEither safeModeConfigFile
+  case decoded of
+    Right value -> pure $ smcSafeMode value
+    Left _      -> pure WalletModeNormal
+
+saveSafeMode :: FilePath -> WalletMode -> IO ()
+saveSafeMode stateDir mode = do
+  let safeModeConfigFile = getSafeModeConfigPath stateDir
+  Y.encodeFile safeModeConfigFile $ SafeModeConfig mode
+
+getSafeModeConfigPath :: FilePath -> FilePath
+getSafeModeConfigPath stateDir = stateDir </> "safemode.yaml"
+
 -- | Here we handle the exit codes.
 -- It's a simple mapping from exit code to actions that the launcher takes.
 --
@@ -165,25 +204,30 @@ runWalletProcess
     -> WalletRunner
     -> RunUpdateFunc
     -> UpdaterData
+    -> FilePath
     -> IO ExitCode
 runWalletProcess
     logDep
     walletMode
     daedalusBin
     walletRunner
     runUpdateFunc
-    updaterData = do
+    updaterData
+    stateDir = do
 
     -- Parametrized by @WalletMode@ so we can change it on restart depending
     -- on the Daedalus exit code.
     let restart :: WalletMode -> IO ExitCode
-        restart =  \walletMode' -> runWalletProcess
+        restart =  \walletMode' -> do
+              saveSafeMode stateDir walletMode'
+              runWalletProcess
                         logDep
                         walletMode'
                         daedalusBin
                         walletRunner
                         runUpdateFunc
                         updaterData
+                        stateDir
 
     -- Additional arguments we need to pass if it's a SAFE mode.
     let walletSafeModeArgs :: WalletArguments
@@ -269,8 +313,10 @@ runLauncher
     -> DaedalusBin
     -> RunUpdateFunc
     -> UpdaterData
+    -> FilePath
     -> IO ExitCode
-runLauncher loggingDependencies walletRunner daedalusBin runUpdateFunc updaterData = do
+runLauncher loggingDependencies walletRunner daedalusBin runUpdateFunc updaterData stateDir = do
+        safeMode <- readSafeMode stateDir
 
         -- In the case the user wants to avoid installing the update now, we
         -- run the update (if there is one) when we have it downloaded.
@@ -283,11 +329,12 @@ runLauncher loggingDependencies walletRunner daedalusBin runUpdateFunc updaterDa
         -- You still want to run the wallet even if the update fails
         runWalletProcess
             loggingDependencies
-            WalletModeNormal
+            safeMode
             daedalusBin
             walletRunner
             runUpdateFunc
             updaterData
+            stateDir
 
 -- | Generation of the TLS certificates.
 -- This just covers the generation of the TLS certificates and nothing else.

cardano-launcher/test/LauncherSpec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module LauncherSpec where
 
@@ -21,9 +22,10 @@ import           Cardano.Shell.CLI (LauncherOptionPath (..),
                                     decodeLauncherOption, setupEnvVars)
 import           Cardano.Shell.Configuration (LauncherOptions (..),
                                               setWorkingDirectory)
-import           Cardano.Shell.Launcher (DaedalusExitCode (..),
+import           Cardano.Shell.Launcher (DaedalusExitCode (..), WalletMode (..),
                                          RestartRunner (..), UpdateRunner (..),
-                                         handleDaedalusExitCode)
+                                         handleDaedalusExitCode,
+                                         readSafeMode, saveSafeMode)
 import           Cardano.Shell.Launcher.Types (nullLogging)
 
 -- | The simple launcher spec.
@@ -32,8 +34,18 @@ launcherSpec = do
     configurationSpec
     launcherSystemSpec
     setWorkingDirectorySpec
+    safeModeSpec
     --generateTLSCertSpec
 
+safeModeSpec :: Spec
+safeModeSpec =
+    describe "safemode persisting system" $ modifyMaxSuccess (const 10000) $ do
+
+        prop "safemode roundtrips" $ \(mode :: WalletMode) -> monadicIO $ do
+            run $ saveSafeMode "/tmp" mode
+            readback <- run $ readSafeMode "/tmp"
+            assert $ mode == readback
+
 -- | The launcher system spec.
 launcherSystemSpec :: Spec
 launcherSystemSpec =
@@ -86,6 +98,9 @@ newtype ExitCodeNumber = ExitCodeNumber { getExitCodeNumber :: Int }
 instance Arbitrary ExitCodeNumber where
     arbitrary = ExitCodeNumber <$> elements [1, 2, 126, 127, 128, 130, 255]
 
+instance Arbitrary WalletMode where
+  arbitrary = elements [ WalletModeSafe, WalletModeNormal ]
+
 -- | List of files we want to test on
 -- These are config files downloaded from Daedalus CI
 --