play nicely with stderr & stdout outputs in the CLI

exe/wallet/Main.hs

@@ -87,7 +87,7 @@ import System.Environment
 import System.Exit
     ( exitFailure )
 import System.IO
-    ( BufferMode (NoBuffering), hSetBuffering, stdout )
+    ( BufferMode (NoBuffering), hSetBuffering, stderr, stdout )
 import Text.Regex.Applicative
     ( anySym, few, match, string, sym )
 
@@ -135,6 +135,7 @@ Options:
 main :: IO ()
 main = do
     hSetBuffering stdout NoBuffering
+    hSetBuffering stderr NoBuffering
     manager <- newManager defaultManagerSettings
     getArgs >>= parseArgsOrExit cli >>= exec manager
 
@@ -268,7 +269,7 @@ exec manager args
             Left e ->
                 putErrLn $ T.pack $ show e
             Right a -> do
-                TIO.putStrLn "Ok."
+                TIO.hPutStrLn stderr "Ok."
                 BL8.putStrLn (encode a)
 
 -- | Namespaces for commands. Only 'Wallet' for now, 'Address' & 'Transaction'
@@ -287,8 +288,8 @@ execServer (Port port) (Port bridgePort) = do
   where
     settings = Warp.defaultSettings
         & Warp.setPort port
-        & Warp.setBeforeMainLoop (do
-            TIO.putStrLn $ "Wallet backend server listening on: " <> toText port
+        & Warp.setBeforeMainLoop (TIO.hPutStrLn stderr $
+            "Wallet backend server listening on: " <> toText port
         )
 
 -- | Generate a random mnemonic of the given size 'n' (n = number of words),
@@ -302,7 +303,9 @@ execGenerateMnemonic n = do
         18 -> mnemonicToText @18 . entropyToMnemonic <$> genEntropy
         21 -> mnemonicToText @21 . entropyToMnemonic <$> genEntropy
         24 -> mnemonicToText @24 . entropyToMnemonic <$> genEntropy
-        _  -> fail "Invalid mnemonic size. Expected one of: 9,12,15,18,21,24"
+        _  -> do
+            putErrLn "Invalid mnemonic size. Expected one of: 9,12,15,18,21,24"
+            exitFailure
     TIO.putStrLn $ T.unwords m
 
 {-------------------------------------------------------------------------------

lib/cli/src/Cardano/CLI.hs

@@ -68,8 +68,8 @@ import System.IO
     , hPutChar
     , hSetBuffering
     , hSetEcho
+    , stderr
     , stdin
-    , stdout
     )
 
 import qualified Data.Text as T
@@ -114,9 +114,9 @@ hPutErrLn :: Handle -> Text -> IO ()
 hPutErrLn h msg = withSGR h (SetColor Foreground Vivid Red) $ do
     TIO.hPutStrLn h msg
 
--- | Like 'hPutErrLn' but with provided default _stdout_ 'Handle'
+-- | Like 'hPutErrLn' but with provided default 'Handle'
 putErrLn :: Text -> IO ()
-putErrLn = hPutErrLn stdout
+putErrLn = hPutErrLn stderr
 
 {-------------------------------------------------------------------------------
                          Processing of Sensitive Data
@@ -129,23 +129,23 @@ hGetLine
     -> Text
     -> (Text -> Either e a)
     -> IO (a, Text)
-hGetLine (hstdin, hstdout) prompt fromT = do
-    TIO.hPutStr hstdout prompt
+hGetLine (hstdin, hstderr) prompt fromT = do
+    TIO.hPutStr hstderr prompt
     txt <- TIO.hGetLine hstdin
     case fromT txt of
         Right a ->
             return (a, txt)
         Left e -> do
-            hPutErrLn hstdout (pretty e)
-            hGetLine (hstdin, hstdout) prompt fromT
+            hPutErrLn hstderr (pretty e)
+            hGetLine (hstdin, hstderr) prompt fromT
 
 -- | Like 'hGetLine' but with default handles
 getLine
     :: Buildable e
     => Text
     -> (Text -> Either e a)
     -> IO (a, Text)
-getLine = hGetLine (stdin, stdout)
+getLine = hGetLine (stdin, stderr)
 
 -- | Gather user inputs until a newline is met, hiding what's typed with a
 -- placeholder character.
@@ -155,18 +155,18 @@ hGetSensitiveLine
     -> Text
     -> (Text -> Either e a)
     -> IO (a, Text)
-hGetSensitiveLine (hstdin, hstdout) prompt fromT =
-    withBuffering hstdout NoBuffering $
+hGetSensitiveLine (hstdin, hstderr) prompt fromT =
+    withBuffering hstderr NoBuffering $
     withBuffering hstdin NoBuffering $
     withEcho hstdin False $ do
-        TIO.hPutStr hstdout prompt
+        TIO.hPutStr hstderr prompt
         txt <- getLineProtected '*'
         case fromT txt of
             Right a ->
                 return (a, txt)
             Left e -> do
-                hPutErrLn hstdout (pretty e)
-                hGetSensitiveLine (hstdin, hstdout) prompt fromT
+                hPutErrLn hstderr (pretty e)
+                hGetSensitiveLine (hstdin, hstderr) prompt fromT
   where
     getLineProtected :: Char -> IO Text
     getLineProtected placeholder =
@@ -176,29 +176,29 @@ hGetSensitiveLine (hstdin, hstdout) prompt fromT =
         getLineProtected' line = do
             hGetChar hstdin >>= \case
                 '\n' -> do
-                    hPutChar hstdout '\n'
+                    hPutChar hstderr '\n'
                     return line
                 c | c == backspace ->
                     if T.null line
                         then getLineProtected' line
                         else do
-                            hCursorBackward hstdout  1
-                            hPutChar hstdout ' '
-                            hCursorBackward hstdout 1
+                            hCursorBackward hstderr  1
+                            hPutChar hstderr ' '
+                            hCursorBackward hstderr 1
                             getLineProtected' (T.init line)
                 c -> do
-                    hPutChar hstdout placeholder
+                    hPutChar hstderr placeholder
                     getLineProtected' (line <> T.singleton c)
 
--- | Like 'hGetSensitiveLine' but with default stdin and stdout handles
+-- | Like 'hGetSensitiveLine' but with default handles
 getSensitiveLine
     :: Buildable e
     => Text
     -- ^ A message to prompt the user
     -> (Text -> Either e a)
     -- ^ An explicit parser from 'Text'
     -> IO (a, Text)
-getSensitiveLine = hGetSensitiveLine (stdin, stdout)
+getSensitiveLine = hGetSensitiveLine (stdin, stderr)
 
 {-------------------------------------------------------------------------------
                                 Internals