Merge #914

914: Fix text locale encoding issues on windows r=KtorZ a=rvl

Relates to #703.

# Overview

- Forces the current windows console into UTF-8 mode.
- UTF-8 is far from standard on windows. But it shouldn't be assumed on any platform.
- This fixes strange characters appearing on windows and test failures with exceptions related to encoding.


Co-authored-by: Rodney Lorrimar <[email protected]>

lib/cli/src/Cardano/CLI.hs

@@ -57,9 +57,6 @@ module Cardano.CLI
     , verbosityToArgs
     , verbosityToMinSeverity
 
-    -- * Unicode Terminal Helpers
-    , setUtf8Encoding
-
     -- * ANSI Terminal Helpers
     , putErrLn
     , hPutErrLn
@@ -173,8 +170,6 @@ import Fmt
     ( Buildable, pretty )
 import GHC.Generics
     ( Generic )
-import GHC.IO.Encoding
-    ( setLocaleEncoding )
 import GHC.TypeLits
     ( Symbol )
 import Network.HTTP.Client
@@ -244,11 +239,8 @@ import System.IO
     , hPutChar
     , hSetBuffering
     , hSetEcho
-    , hSetEncoding
     , stderr
     , stdin
-    , stdout
-    , utf8
     )
 
 import qualified Cardano.BM.Configuration.Model as CM
@@ -375,9 +367,9 @@ cmdWalletCreate = command "create" $ info (helper <*> cmd) $ mempty
             getLine prompt parser
         wSndFactor <- do
             let prompt =
-                    "(Enter a blank line if you do not wish to use a second \
-                    \factor.)\n\
-                    \Please enter a 9–12 word mnemonic second factor: "
+                    "(Enter a blank line if you do not wish to use a second " <>
+                    "factor.)\n" <>
+                    "Please enter a 9–12 word mnemonic second factor: "
             let parser =
                     optionalE (fromMnemonic @'[9,12] @"generation") . T.words
             getLine prompt parser <&> \case
@@ -837,8 +829,8 @@ paymentOption = optionT $ mempty
     <> long "payment"
     <> metavar "PAYMENT"
     <> help
-        "address to send to and amount to send separated by @\
-        \, e.g. '<amount>@<address>'"
+        ("address to send to and amount to send separated by @" <>
+        ", e.g. '<amount>@<address>'")
 
 -- | [--address-pool-gap=INT], default: 20
 poolGapOption :: Parser AddressPoolGap
@@ -1226,18 +1218,6 @@ withLogging configFile minSeverity action = bracket before after (action . snd)
         logDebug tr "Logging shutdown."
         shutdown sb
 
-{-------------------------------------------------------------------------------
-                            Unicode Terminal Helpers
--------------------------------------------------------------------------------}
-
--- | Override the system output encoding setting. This is needed because the CLI
--- prints UTF-8 characters regardless of the @LANG@ environment variable.
-setUtf8Encoding :: IO ()
-setUtf8Encoding = do
-    setLocaleEncoding utf8
-    hSetEncoding stdout utf8
-    hSetEncoding stderr utf8
-
 {-------------------------------------------------------------------------------
                             ANSI Terminal Helpers
 -------------------------------------------------------------------------------}

lib/core/cardano-wallet-core.cabal

@@ -152,6 +152,7 @@ test-suite unit
     , bytestring
     , cardano-crypto
     , cardano-wallet-core
+    , cardano-wallet-launcher
     , cardano-wallet-test-utils
     , cborg
     , containers
@@ -238,6 +239,7 @@ test-suite unit
       Data.Time.TextSpec
       Data.Time.UtilsSpec
       Network.Wai.Middleware.LoggingSpec
+      Spec
 
 benchmark db
   default-language:

lib/core/test/unit/Main.hs

@@ -1 +1,12 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+module Main where
+
+import Cardano.Launcher
+    ( setUtf8Encoding )
+import Prelude
+import qualified Spec
+import Test.Hspec.Runner
+
+main :: IO ()
+main = do
+    setUtf8Encoding
+    hspecWith defaultConfig Spec.spec

lib/core/test/unit/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

lib/jormungandr/exe/cardano-wallet-jormungandr.hs

@@ -47,15 +47,14 @@ import Cardano.CLI
     , optionT
     , requireFilePath
     , runCli
-    , setUtf8Encoding
     , setupDirectory
     , stateDirOption
     , verbosityOption
     , verbosityToMinSeverity
     , withLogging
     )
 import Cardano.Launcher
-    ( StdStream (..) )
+    ( StdStream (..), setUtf8Encoding )
 import Cardano.Wallet.Api.Server
     ( HostPreference, Listen (..) )
 import Cardano.Wallet.Jormungandr

lib/launcher/cardano-wallet-launcher.cabal

@@ -44,6 +44,7 @@ library
   if os(windows)
     build-depends: Win32
     other-modules: Cardano.Launcher.Windows
+    cpp-options:   -DWINDOWS
   else
     build-depends: unix
     other-modules: Cardano.Launcher.POSIX

lib/launcher/src/Cardano/Launcher.hs

@@ -7,17 +7,19 @@
 -- Copyright: © 2018-2019 IOHK
 -- License: Apache-2.0
 --
--- This module contains a mechanism for launching external processes together,
--- and provides the functionality needed to kill them all if one goes down.
--- (would be achieved using @monitor@ and @kill@ in combination)
+-- This module contains a mechanism for launching external processes, ensuring
+-- that they are terminated on exceptions.
 
 module Cardano.Launcher
     ( Command (..)
     , StdStream(..)
     , ProcessHasExited(..)
     , launch
     , withBackendProcess
+
+    -- * Program startup
     , installSignalHandlers
+    , setUtf8Encoding
 
     -- * Logging
     , LauncherLog(..)
@@ -65,6 +67,9 @@ import GHC.Generics
     ( Generic )
 import System.Exit
     ( ExitCode (..) )
+import System.IO
+    ( hSetEncoding, mkTextEncoding, stderr, stdin, stdout )
+
 import System.Process
     ( CreateProcess (..)
     , StdStream (..)
@@ -74,9 +79,11 @@ import System.Process
     , withCreateProcess
     )
 
-#ifdef mingw32_HOST_OS
+#ifdef WINDOWS
 import Cardano.Launcher.Windows
     ( installSignalHandlers )
+import System.Win32.Console
+    ( setConsoleCP, setConsoleOutputCP )
 #else
 import Cardano.Launcher.POSIX
     ( installSignalHandlers )
@@ -233,3 +240,28 @@ launcherLogText (MsgLauncherFinish (ProcessHasExited name code)) =
 launcherLogText (MsgLauncherFinish (ProcessDidNotStart name _e)) =
     "Could not start "+|name|+""
 launcherLogText MsgLauncherCleanup = "Terminating child process"
+
+{-------------------------------------------------------------------------------
+                            Unicode Terminal Helpers
+-------------------------------------------------------------------------------}
+
+-- | Force the locale text encoding to UTF-8. This is needed because the CLI
+-- prints UTF-8 characters regardless of the @LANG@ environment variable or any
+-- other settings.
+--
+-- On Windows the current console code page is changed to UTF-8.
+setUtf8Encoding :: IO ()
+#if WINDOWS
+setUtf8Encoding = do
+    let utf8CodePage = 65001
+    setConsoleCP utf8CodePage
+    setConsoleOutputCP utf8CodePage
+    setUtf8EncodingHandles
+#else
+setUtf8Encoding = setUtf8EncodingHandles
+#endif
+
+setUtf8EncodingHandles :: IO ()
+setUtf8EncodingHandles = do
+    utf8' <- mkTextEncoding "UTF-8//TRANSLIT"
+    mapM_ (`hSetEncoding` utf8') [stdin, stdout, stderr]