[GH-208] Add node-ipc for wallet.

app/daedalus-ipc.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Main where
+
+import           Cardano.Prelude
+
+import           Cardano.BM.Configuration.Static (defaultConfigStdout)
+import           Cardano.BM.Setup (setupTrace_)
+import           Cardano.Shell.DaedalusIPC
+
+main :: IO ()
+main = fmap readEither <$> getArgs >>= \case
+  [Right port] -> do
+    c <- defaultConfigStdout
+    (tr, _sb) <- setupTrace_ c "daedalus-ipc"
+    daedalusIPC tr port
+  _ -> do
+    putStrLn ("Usage: daedalus-ipc PORT" :: Text)
+    exitFailure

cardano-shell.cabal

@@ -1,3 +1,4 @@
+cabal-version:  2.2
 name:           cardano-shell
 version:        0.1.0.0
 description:    Please see the README on GitHub at <https://github.com/githubuser/cardano-shell#readme>
@@ -10,10 +11,10 @@ copyright:      2018 IOHK
 license:        Apache-2.0
 license-files:  LICENSE, NOTICE
 build-type:     Simple
-cabal-version:  >= 1.10
 extra-source-files:
     ChangeLog.md
     README.md
+    test/js/mock-daedalus.js
 
 source-repository head
   type: git
@@ -28,6 +29,8 @@ library
     , Cardano.Shell.Configuration.Lib
     -- NodeIPC
     , Cardano.Shell.NodeIPC
+    , Cardano.Shell.NodeIPC.General
+    , Cardano.Shell.DaedalusIPC
     -- Update system
     , CardanoShellSpec
     , Cardano.Shell.Update.Types
@@ -66,6 +69,7 @@ library
     , QuickCheck
     , safe-exceptions
     , stm
+    , async
     , text
     , transformers
     , generic-monoid
@@ -139,6 +143,28 @@ executable node-ipc
                        -Wredundant-constraints
                        -Wpartial-fields
 
+executable daedalus-ipc
+  main-is: app/daedalus-ipc.hs
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base >=4.7 && <5
+    , cardano-shell
+    , cardano-prelude
+    , optparse-applicative
+    , safe-exceptions
+    , iohk-monitoring
+  default-language:    Haskell2010
+  default-extensions:  NoImplicitPrelude
+                       OverloadedStrings
+
+  ghc-options:         -Wall
+                       -Werror
+                       -Wcompat
+                       -Wincomplete-record-updates
+                       -Wincomplete-uni-patterns
+                       -Wredundant-constraints
+                       -Wpartial-fields
+
 executable cardano-launcher
   main-is: Main.hs
   other-modules:
@@ -183,6 +209,7 @@ test-suite cardano-shell-test
   other-modules:
       Paths_cardano_shell
       DhallConfigSpec
+      DaedalusIPCSpec
       UpdaterSpec
   if !os(windows)
     other-modules:
@@ -199,6 +226,7 @@ test-suite cardano-shell-test
     , cardano-prelude
     , dhall
     , safe-exceptions
+    , process
     -- quickcheck
     , QuickCheck
     -- SM
@@ -212,6 +240,8 @@ test-suite cardano-shell-test
     , concurrency
     , dejafu
     , hunit-dejafu
+  build-tool-depends:
+      cardano-shell:daedalus-ipc
   default-language:    Haskell2010
   default-extensions:  NoImplicitPrelude
                        OverloadedStrings

nix/iohk-nix-src.json

@@ -1,7 +1,7 @@
 {
   "url": "https://github.com/input-output-hk/iohk-nix",
-  "rev": "eec83e9bba05093c94004a001caebae252c0c83b",
-  "date": "2019-06-26T17:23:10+00:00",
-  "sha256": "00b11qmgr57pm6gg7a8m6fzjj6m5wmh8hnwg16jnqsmf52882y2j",
+  "rev": "3cee475f26458ef113a494b216b1504513fa4d03",
+  "date": "2019-07-05T14:51:43+00:00",
+  "sha256": "04dqb2ii03y1lvyqn3v3xwardym2h6g5zbgvjljam758w768vmii",
   "fetchSubmodules": false
 }

nix/pkgs.nix

@@ -38,6 +38,11 @@ let
         # turtle seems to have the same issue.
         packages.turtle.doExactConfig = true;
       }
+
+      {
+        packages.cardano-shell.src = haskell.cleanSourceHaskell ../.;
+        packages.cardano-shell.components.tests.cardano-shell-test.build-tools = [ pkgs.nodejs ];
+      }
     ];
   };
 

src/Cardano/Shell/DaedalusIPC.hs

@@ -0,0 +1,87 @@
+{-# LANGUAGE LambdaCase          #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- |
+-- Copyright: © 2018-2019 IOHK
+--
+-- Daedalus <-> Wallet child process port discovery protocol.
+-- Provides a mechanism for Daedalus to discover what port the cardano-wallet
+-- server is listening on.
+--
+-- See <https://nodejs.org/api/child_process.html#child_process_child_process_spawn_command_args_options>
+-- for more information about the message protocol.
+
+module Cardano.Shell.DaedalusIPC
+    ( daedalusIPC
+    ) where
+
+import           Cardano.Prelude
+
+import           Cardano.BM.Trace (Trace, logError, logInfo, logNotice)
+import           Cardano.Shell.NodeIPC.General (NodeChannelError (..),
+                                                NodeChannelFinished (..),
+                                                runNodeChannel,
+                                                setupNodeChannel)
+import           Control.Concurrent (threadDelay)
+import           Control.Monad (forever)
+import           Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object,
+                             withObject, (.:), (.=))
+import           Data.Text (Text)
+
+-- | Messages sent from Daedalus -> cardano-wallet
+data MsgIn = QueryPort
+    deriving (Show, Eq)
+
+-- | Messages sent from cardano-wallet -> Daedalus
+data MsgOut = Started | ReplyPort Int | ParseError Text
+    deriving (Show, Eq)
+
+instance FromJSON MsgIn where
+    parseJSON = withObject "MsgIn" $ \v -> do
+        (_ :: [()]) <- v .: "QueryPort"
+        pure QueryPort
+
+instance ToJSON MsgOut where
+    toJSON Started        = object [ "Started" .= Array mempty ]
+    toJSON (ReplyPort p)  = object [ "ReplyPort" .= p ]
+    toJSON (ParseError e) = object [ "ParseError" .= e ]
+
+-- | Start up the Daedalus IPC process. It's called 'daedalusIPC', but this
+-- could be any nodejs program that needs to start cardano-wallet. All it does
+-- is reply with a port number when asked, using a very nodejs-specific IPC
+-- method.
+--
+-- If the IPC channel was successfully set up, this function won't return until
+-- the parent process exits. Otherwise, it will return immediately. Before
+-- returning, it will log an message about why it has exited.
+daedalusIPC
+    :: Trace IO Text
+    -- ^ Logging object
+    -> Int
+    -- ^ Port number to send to Daedalus
+    -> IO ()
+daedalusIPC tr port = setupNodeChannel >>= \case
+    Right chan -> do
+        logInfo tr "Daedalus IPC server starting"
+        runNodeChannel (pure . msg) action chan >>= \case
+            Left (NodeChannelFinished err) ->
+                logNotice tr $ "Daedalus IPC finished for this reason: " <> show err
+            Right () -> logError tr "Unreachable code"
+    Left NodeChannelDisabled -> do
+        logInfo tr "Daedalus IPC is not enabled."
+        sleep
+    Left (NodeChannelBadFD err) ->
+        logError tr $ "Problem starting Daedalus IPC: " <> show err
+  where
+    -- How to respond to an incoming message, or when there is an incoming
+    -- message that couldn't be parsed.
+    msg (Right QueryPort) = Just (ReplyPort port)
+    msg (Left e)          = Just (ParseError e)
+
+    -- What to do in context of runNodeChannel
+    action :: (MsgOut -> IO ()) -> IO ()
+    action send = send Started >> sleep
+
+    sleep = forever $ threadDelay maxBound