[DDW-691] Allow 2nd instance in a specific case – when provided with a web+cardano:// URL

cardano-launcher/app/Main.hs

@@ -13,7 +13,7 @@ import           Data.IORef (newIORef, readIORef, writeIORef)
 import           Data.Text.Lazy.Builder (fromString, fromText)
 import qualified Data.Map as M
 
-import           Distribution.System (OS (Windows), buildOS)
+import           Distribution.System as OS
 import           System.Environment (setEnv)
 import           System.IO.Silently (hSilence)
 import           System.Process (proc, waitForProcess, withCreateProcess)
@@ -29,12 +29,13 @@ import           Cardano.BM.Setup (withTrace)
 import qualified Cardano.BM.Trace as Trace
 import           Cardano.BM.Tracing
 
-import           Cardano.Shell.Application (checkIfApplicationIsRunning)
+import           Cardano.Shell.Application (ApplicationError (ApplicationAlreadyRunningException),
+                                            checkIfApplicationIsRunning)
 import           Cardano.Shell.CLI (LauncherOptionPath, getDefaultConfigPath,
                                     getLauncherOptions, launcherArgsParser)
-import           Cardano.Shell.Configuration (LauncherOptions (..),
-                                              DaedalusBin (..), getUpdaterData,
-                                              getDPath,
+import           Cardano.Shell.Configuration (DaedalusBin (..),
+                                              LauncherOptions (..), getDPath,
+                                              getUpdaterData,
                                               setWorkingDirectory)
 import           Cardano.Shell.Launcher (LoggingDependencies (..), TLSError,
                                          TLSPath (..), WalletRunner (..),
@@ -43,7 +44,7 @@ import           Cardano.Shell.Launcher (LoggingDependencies (..), TLSError,
 import           Cardano.Shell.Update.Lib (UpdaterData (..),
                                            runDefaultUpdateProcess)
 import           Cardano.X509.Configuration (TLSConfiguration)
-import           Control.Exception.Safe (throwM)
+import           Control.Exception.Safe as E
 
 import           System.FilePath ((</>))
 import           System.IO (hClose)
@@ -123,7 +124,7 @@ main = silence $ do
         setEnv "LC_ALL" "en_GB.UTF-8"
         setEnv "LANG"   "en_GB.UTF-8"
 
-        launcherOptions <- do
+        (launcherOptions, mURL) <- do
             eLauncherOptions <- getLauncherOptions loggingDependencies (launcherConfigPath launcherCLI)
             case eLauncherOptions of
                 Left err -> do
@@ -140,9 +141,28 @@ main = silence $ do
 
         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.
-        lockHandle          <- checkIfApplicationIsRunning lockFile
+        -- Check if it's locked or not.
+        --
+        -- XXX: In a special case, when `cardano-launcher` is given a
+        -- `mURL` (web+cardano://…) on the command line, we want to
+        -- allow the second instance. Then, Daedalus will notify its
+        -- first instance to handle this particular URL using internal
+        -- Electron mechanism. This must happen on Linux and Windows,
+        -- since macOS has its own mechanism to notify already running
+        -- applications to open URLs, which Electron implements. But
+        -- it’s nice to have on macOS as well, since the user can
+        -- still run Daedalus from a terminal. In second instance, we
+        -- also skip the TLS setup (Daedalus won’t start 2nd cardano).
+        --
+        -- Otherwise, will throw an exception if the application is
+        -- already running.
+        (isSecondInstanceWithURL, lockHandle) <- E.try (checkIfApplicationIsRunning lockFile) >>= \case
+            Right hndl -> pure (False, Just hndl)
+            Left exception@ApplicationAlreadyRunningException ->
+                if isJust mURL then
+                    pure (True, Nothing)
+                else
+                    throwM exception
 
         let workingDir = loWorkingDirectory launcherOptions
 
@@ -155,7 +175,7 @@ main = silence $ do
 
         -- Configuration from the launcher options.
         let mTlsConfig :: Maybe TLSConfiguration
-            mTlsConfig = loTlsConfig launcherOptions
+            mTlsConfig = if isSecondInstanceWithURL then Nothing else loTlsConfig launcherOptions
 
         let daedalusBin :: DaedalusBin
             daedalusBin = getDPath launcherOptions
@@ -195,9 +215,10 @@ main = silence $ do
                         updaterExecutionFunction
                         updaterData
                         stateDir
+                        mURL
 
         -- release the lock on the lock file
-        hClose lockHandle
+        mapM_ hClose lockHandle
 
         -- Exit the program with exit code.
         exitWith exitCode
@@ -292,9 +313,9 @@ instance Show LauncherExceptions where
 instance Exception LauncherExceptions
 
 silence :: IO a -> IO a
-silence runAction = case buildOS of
-    Windows -> hSilence [stdout, stderr] runAction
-    _       -> runAction
+silence runAction = case OS.buildOS of
+    OS.Windows -> hSilence [stdout, stderr] runAction
+    _          -> runAction
 
 -- | Log error message
 -- |

cardano-launcher/cardano-launcher.cabal

@@ -67,6 +67,7 @@ library
                        -Wincomplete-uni-patterns
                        -Wredundant-constraints
                        -Wpartial-fields
+                       -Wno-name-shadowing
 
 executable cardano-launcher
   main-is: Main.hs

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

@@ -1,5 +1,6 @@
 module Cardano.Shell.Application
     ( checkIfApplicationIsRunning
+    , ApplicationError(ApplicationAlreadyRunningException)
     ) where
 
 import           Cardano.Prelude

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

@@ -17,7 +17,7 @@ import           Control.Monad.Except (liftEither)
 import           Data.Aeson (Result (..), fromJSON)
 import           Data.Yaml (ParseException, decodeFileEither)
 import           Options.Applicative (Parser, help, long, metavar, short,
-                                      strOption, value)
+                                      strOption, strArgument, value)
 
 import           System.Directory (XdgDirectory (XdgData), getXdgDirectory)
 import           System.Environment (getExecutablePath, setEnv)
@@ -27,8 +27,9 @@ import           Cardano.Shell.Configuration (LauncherOptions)
 import           Cardano.Shell.Launcher.Types (LoggingDependencies (..))
 
 -- | Path to launcher-config.yaml file
-newtype LauncherOptionPath = LauncherOptionPath
+data LauncherOptionPath = LauncherOptionPath
     { getLauncherOptionPath  :: FilePath
+    , getUriToOpen :: Maybe Text
     } deriving (Eq, Show)
 
 -- | Default path to the launcher-config.yaml file
@@ -44,13 +45,18 @@ getDefaultConfigPath = do
 
 -- | CLI for @LauncherOptionPath@
 launcherArgsParser :: FilePath -> Parser LauncherOptionPath
-launcherArgsParser defaultPath = LauncherOptionPath <$> strOption (
+launcherArgsParser defaultPath = LauncherOptionPath
+  <$> strOption (
     short   'c' <>
     long    "config" <>
     help    ("Path to the launcher configuration file. If not provided, it'll\
         \ instead use\n" <> defaultPath) <>
     metavar "PATH" <>
     value defaultPath )
+  <*> (optional $ strArgument (
+    help ("a URL to forward on to daedalus un-altered")
+    <> metavar "URL")
+  )
 
 data LauncherOptionError
     = FailedToParseLauncherOption Text
@@ -65,15 +71,15 @@ data LauncherOptionError
 getLauncherOptions
     :: LoggingDependencies
     -> LauncherOptionPath
-    -> IO (Either LauncherOptionError LauncherOptions)
+    -> IO (Either LauncherOptionError (LauncherOptions, Maybe Text))
 getLauncherOptions logDeps loPath = do
 
     setupEnvVars loPath
 
     eLauncherOption <- decodeLauncherOption logDeps loPath
     case eLauncherOption of
         Left decodeError      -> return . Left $ decodeError
-        Right launcherOptions -> return . Right $ launcherOptions
+        Right launcherOptions -> return . Right $ (launcherOptions, getUriToOpen loPath)
 
 -- There a lot of @withExceptT@ 's since all these function returns different
 -- types of @Either@ so I have to make the types align
@@ -99,7 +105,7 @@ decodeLauncherOption logDeps loPath = runExceptT $ do
 -- Set environment variables that we need in order for launcher to perform
 -- env var substitution
 setupEnvVars :: LauncherOptionPath -> IO ()
-setupEnvVars (LauncherOptionPath configPath) = do
+setupEnvVars (LauncherOptionPath configPath _) = do
     daedalusDir <- takeDirectory <$> getExecutablePath
     setEnv "DAEDALUS_INSTALL_DIRECTORY" daedalusDir
     getXdgDirectory XdgData "" >>= setEnv "XDG_DATA_HOME"

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards            #-}
 
 module Cardano.Shell.Configuration
     ( WalletArguments (..)
@@ -59,28 +60,18 @@ data LauncherOptions = LauncherOptions
 instance FromJSON LauncherOptions where
     parseJSON = withObject "LauncherOptions" $ \o -> do
 
-        daedalusBin         <- o .: "daedalusBin"
-        updaterPath         <- o .: "updaterPath"
-        updaterArgs         <- o .: "updaterArgs"
-        updateArchive       <- o .: "updateArchive"
-        configuration       <- o .:? "configuration"
-        tlsPath             <- o .:? "tlsPath"
-        tlsConfig           <- o .:? "tlsConfig"
-        workingDir          <- o .: "workingDir"
-        stateDir            <- o .: "stateDir"
-        extraEnvVars        <- o .: "extraEnvVars"
-
-        pure $ LauncherOptions
-            configuration
-            tlsPath
-            tlsConfig
-            updaterPath
-            updaterArgs
-            updateArchive
-            daedalusBin
-            workingDir
-            stateDir
-            extraEnvVars
+        loConfiguration     <- o .:? "configuration"
+        loTlsPath           <- o .:? "tlsPath"
+        loTlsConfig         <- o .:? "tlsConfig"
+        loUpdaterPath       <- o .: "updaterPath"
+        loUpdaterArgs       <- o .: "updaterArgs"
+        loUpdateArchive     <- o .: "updateArchive"
+        loDaedalusBin       <- o .: "daedalusBin"
+        loWorkingDirectory  <- o .: "workingDir"
+        loStateDir          <- o .: "stateDir"
+        loExtraEnvVars      <- o .: "extraEnvVars"
+
+        pure $ LauncherOptions{..}
 
 -- | Configuration yaml file location and the key to use. The file should
 -- parse to a MultiConfiguration and the 'cfoKey' should be one of the keys

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

@@ -207,6 +207,7 @@ runWalletProcess
     -> RunUpdateFunc
     -> UpdaterData
     -> FilePath
+    -> Maybe Text
     -> IO ExitCode
 runWalletProcess
     logDep
@@ -215,7 +216,8 @@ runWalletProcess
     walletRunner
     runUpdateFunc
     updaterData
-    stateDir = do
+    stateDir
+    mURL = do
 
     -- Parametrized by @WalletMode@ so we can change it on restart depending
     -- on the Daedalus exit code.
@@ -230,21 +232,22 @@ runWalletProcess
                         runUpdateFunc
                         updaterData
                         stateDir
+                        mURL
 
     electronExtraArgv <- do
       lookupEnv "ELECTRON_EXTRA_ARGV" >>= \case
         Nothing -> pure []
         Just xs -> pure . T.splitOn "\n" . T.pack $ xs
 
     -- Additional arguments we need to pass if it's a SAFE mode.
-    let walletSafeModeArgs :: WalletArguments
-        walletSafeModeArgs = WalletArguments ([ "--safe-mode" ] ++ electronExtraArgv)
+    let walletSafeModeArgs :: [Text]
+        walletSafeModeArgs = [ "--safe-mode" ]
 
     -- Daedalus safe mode.
     let walletArgs :: WalletArguments
-        walletArgs =    if walletMode == WalletModeSafe
+        walletArgs =  WalletArguments $ (if walletMode == WalletModeSafe
                             then walletSafeModeArgs
-                            else WalletArguments electronExtraArgv
+                            else []) <> electronExtraArgv <> maybeToList mURL
 
     logNotice logDep $ "Starting the wallet with arguments: " <> Cardano.Prelude.show walletArgs
 
@@ -321,8 +324,9 @@ runLauncher
     -> RunUpdateFunc
     -> UpdaterData
     -> FilePath
+    -> Maybe Text
     -> IO ExitCode
-runLauncher loggingDependencies walletRunner daedalusBin runUpdateFunc updaterData stateDir = do
+runLauncher loggingDependencies walletRunner daedalusBin runUpdateFunc updaterData stateDir mURL = do
         safeMode <- readSafeMode stateDir
 
         -- In the case the user wants to avoid installing the update now, we
@@ -342,6 +346,7 @@ runLauncher loggingDependencies walletRunner daedalusBin runUpdateFunc updaterDa
             runUpdateFunc
             updaterData
             stateDir
+            mURL
 
 -- | Generation of the TLS certificates.
 -- This just covers the generation of the TLS certificates and nothing else.

cardano-launcher/test/LauncherSpec.hs

@@ -172,14 +172,14 @@ configurationSpec = describe "configuration files" $ modifyMaxSuccess (const 1)
         it "should fail due to passing wrong file path" $ monadicIO $ do
             eLauncherOption <- run $ do
                 -- Path to the launcher file is incorrect
-                let launcherOptionPath = LauncherOptionPath "this will fail"
+                let launcherOptionPath = LauncherOptionPath "this will fail" Nothing
                 withSystemTempDirectory "test-XXXXXX" $ \tmpDir ->
                     withSetEnvs launcherOptionPath tmpDir $ decodeLauncherOption nullLogging launcherOptionPath
             assert $ isLeft eLauncherOption
 
         it "should fail due to missing env vars" $ monadicIO $ do
             eLauncherOption <- run $ do
-                let launcherOptionPath = LauncherOptionPath (configFullFilePath "launcher-config-mainnet.linux.yaml")
+                let launcherOptionPath = LauncherOptionPath (configFullFilePath "launcher-config-mainnet.linux.yaml") Nothing
                 -- Not environment variables are set!
                 decodeLauncherOption nullLogging launcherOptionPath
             assert $ isLeft eLauncherOption
@@ -191,15 +191,15 @@ configurationSpec = describe "configuration files" $ modifyMaxSuccess (const 1)
                     let val = String "this is not launcher option"
                     let yamlPath = tmpDir </> "launcher.yaml"
                     encodeFile yamlPath val
-                    let launcherOptionPath = LauncherOptionPath yamlPath
+                    let launcherOptionPath = LauncherOptionPath yamlPath Nothing
                     withSetEnvs launcherOptionPath tmpDir $ decodeLauncherOption nullLogging launcherOptionPath
             assert $ isLeft eLauncherOption
 
 -- | Test that env var substitution works as expected on actual config files
 testGetLauncherOption :: FilePath -> Spec
 testGetLauncherOption configPath = it ("should be able to perform env substitution on config: " <> configPath) $ monadicIO $ do
     eLauncherOption <- run $ do
-        let launcherOptionPath = LauncherOptionPath (configFullFilePath configPath)
+        let launcherOptionPath = LauncherOptionPath (configFullFilePath configPath) Nothing
         withSystemTempDirectory "test-XXXXXX" $ \tmpDir ->
             withSetEnvs launcherOptionPath tmpDir $ decodeLauncherOption nullLogging launcherOptionPath
     run $ putTextLn $ show eLauncherOption

shell.nix

@@ -24,7 +24,9 @@ let
 
     # These programs will be available inside the nix-shell.
     buildInputs = (with haskellPackages; [
+      hindent
       profiteur
+      stylish-haskell
       weeder
     ]) ++ (with pkgs; [
       cabal-install