allow persisting safemode flag

Author: cleverca22

cardano-launcher/app/Main.hs

@@ -131,7 +131,10 @@ 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.
@@ -187,6 +190,7 @@ main = silence $ do
                         daedalusBin
                         updaterExecutionFunction
                         updaterData
+                        stateDir
 
         -- Exit the program with exit code.
         exitWith exitCode

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,8 +29,11 @@ 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)
+import           Test.QuickCheck (Arbitrary (arbitrary), elements)
 
 import           Cardano.Shell.Configuration (WalletArguments (..),
                                               DaedalusBin (..))
@@ -74,6 +79,29 @@ data WalletMode
     | WalletModeSafe
     deriving (Eq, Show)
 
+instance Arbitrary WalletMode where
+  arbitrary = elements [ WalletModeSafe, WalletModeNormal ]
+
+instance FromJSON WalletMode where
+  parseJSON (Bool True) = pure WalletModeSafe
+  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 +153,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 +209,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 +318,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 +334,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

@@ -21,9 +21,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 +33,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 =