diff --git a/.weeder.yaml b/.weeder.yaml index 75e3ecbfe95..95a3a424a5e 100644 --- a/.weeder.yaml +++ b/.weeder.yaml @@ -124,5 +124,4 @@ - name: library - message: - name: Module not compiled - - module: Cardano.Launcher.Windows - + - module: Cardano.Startup.Windows diff --git a/default.nix b/default.nix index d66a1b8c39f..94d0676ae75 100644 --- a/default.nix +++ b/default.nix @@ -31,6 +31,8 @@ let haskellBuildUtils = haskellBuildUtils.package; }; + inherit (haskellPackages.cardano-wallet-byron.components.exes) cardano-wallet-byron; + # `tests` are the test suites which have been built. tests = collectComponents "tests" isCardanoWallet haskellPackages; # `checks` are the result of executing the tests. diff --git a/lib/byron/cardano-wallet-byron.cabal b/lib/byron/cardano-wallet-byron.cabal index 68c2640a7f8..0808aea0102 100644 --- a/lib/byron/cardano-wallet-byron.cabal +++ b/lib/byron/cardano-wallet-byron.cabal @@ -38,7 +38,6 @@ library , cardano-crypto-wrapper , cardano-ledger , cardano-wallet-core - , cardano-wallet-launcher , cborg , contra-tracer , cryptonite @@ -88,6 +87,7 @@ executable cardano-wallet-byron , cardano-wallet-cli , cardano-wallet-core , cardano-wallet-launcher + , contra-tracer , iohk-monitoring , network , optparse-applicative diff --git a/lib/byron/exe/cardano-wallet-byron.hs b/lib/byron/exe/cardano-wallet-byron.hs index aed231f134a..5b82a758dd8 100644 --- a/lib/byron/exe/cardano-wallet-byron.hs +++ b/lib/byron/exe/cardano-wallet-byron.hs @@ -27,7 +27,7 @@ import Prelude import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Trace - ( Trace, appendName, logDebug, logInfo ) + ( Trace, appendName, logDebug, logInfo, logNotice ) import Cardano.CLI ( LoggingOptions (..) , cli @@ -50,8 +50,12 @@ import Cardano.CLI , syncToleranceOption , withLogging ) -import Cardano.Launcher - ( withUtf8Encoding ) +import Cardano.Startup + ( ShutdownHandlerLog + , installSignalHandlers + , withShutdownHandler + , withUtf8Encoding + ) import Cardano.Wallet.Api.Server ( HostPreference, Listen (..) ) import Cardano.Wallet.Byron @@ -66,7 +70,7 @@ import Cardano.Wallet.Byron import Cardano.Wallet.Byron.Network ( localSocketAddrInfo ) import Cardano.Wallet.Logging - ( transformTextTrace ) + ( trMessage, transformTextTrace ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.Types @@ -75,6 +79,10 @@ import Cardano.Wallet.Version ( GitRevision, Version, gitRevision, showFullVersion, version ) import Control.Applicative ( Const (..), optional ) +import Control.Monad + ( void ) +import Control.Tracer + ( contramap ) import Data.Text ( Text ) import Data.Text.Class @@ -160,16 +168,18 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty exec args@(ServeArgs hostPreference listen nodeSocket databaseDir sTolerance logOpt) = do let addrInfo = localSocketAddrInfo nodeSocket withTracers logOpt $ \tr tracers -> do - logDebug tr $ MsgServeArgs args - whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases) - exitWith =<< serveWallet @'Mainnet - tracers - sTolerance - databaseDir - hostPreference - listen - addrInfo - (beforeMainLoop tr) + installSignalHandlers (logNotice tr MsgSigTerm) + void $ withShutdownHandler (trMessage (contramap (fmap MsgShutdownHandler) tr)) $ do + logDebug tr $ MsgServeArgs args + whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases) + exitWith =<< serveWallet @'Mainnet + tracers + sTolerance + databaseDir + hostPreference + listen + addrInfo + (beforeMainLoop tr) whenJust m fn = case m of Nothing -> pure () @@ -212,6 +222,8 @@ data MainLog | MsgSetupDatabases Text | MsgServeArgs ServeArgs | MsgListenAddress SockAddr + | MsgSigTerm + | MsgShutdownHandler ShutdownHandlerLog deriving (Show, Eq) instance ToText MainLog where @@ -228,6 +240,10 @@ instance ToText MainLog where T.pack $ show args MsgListenAddress addr -> "Wallet backend server listening on " <> T.pack (show addr) + MsgSigTerm -> + "Terminated by signal." + MsgShutdownHandler msg' -> + toText msg' withTracers :: LoggingOptions TracerSeverities diff --git a/lib/byron/src/Cardano/Wallet/Byron.hs b/lib/byron/src/Cardano/Wallet/Byron.hs index 1f417a1e632..4b8aa07aacc 100644 --- a/lib/byron/src/Cardano/Wallet/Byron.hs +++ b/lib/byron/src/Cardano/Wallet/Byron.hs @@ -50,8 +50,6 @@ import Cardano.BM.Trace ( Trace, appendName ) import Cardano.DB.Sqlite ( DBLog ) -import Cardano.Launcher - ( installSignalHandlers ) import Cardano.Wallet ( WalletLog ) import Cardano.Wallet.Api @@ -166,7 +164,6 @@ serveWallet -- ^ Callback to run before the main loop -> IO ExitCode serveWallet Tracers{..} sTolerance databaseDir hostPref listen addrInfo beforeMainLoop = do - installSignalHandlers (traceWith applicationTracer MsgSigTerm) traceWith applicationTracer $ MsgStarting addrInfo traceWith applicationTracer $ MsgNetworkName $ networkDiscriminantVal @n Server.withListeningSocket hostPref listen $ \case @@ -245,7 +242,6 @@ exitCodeApiServer = \case data ApplicationLog = MsgStarting AddrInfo | MsgNetworkName NetworkDiscriminant - | MsgSigTerm | MsgServerStartupError ListenError | MsgDatabaseStartup DatabasesStartupLog deriving (Generic, Show, Eq) @@ -256,8 +252,6 @@ instance ToText ApplicationLog where "Wallet backend server starting. " <> T.pack (show info) <> "..." MsgNetworkName n -> "Node is Haskell Node on " <> toText n - MsgSigTerm -> - "Terminated by signal." MsgDatabaseStartup dbMsg -> toText dbMsg MsgServerStartupError startupErr -> case startupErr of @@ -281,7 +275,6 @@ instance DefinePrivacyAnnotation ApplicationLog instance DefineSeverity ApplicationLog where defineSeverity = \case MsgStarting _ -> Info - MsgSigTerm -> Notice MsgNetworkName _ -> Info MsgDatabaseStartup ev -> defineSeverity ev MsgServerStartupError _ -> Alert diff --git a/lib/cli/cardano-wallet-cli.cabal b/lib/cli/cardano-wallet-cli.cabal index a289449afcc..07a170ecc0b 100644 --- a/lib/cli/cardano-wallet-cli.cabal +++ b/lib/cli/cardano-wallet-cli.cabal @@ -44,6 +44,7 @@ library , fmt , http-client , iohk-monitoring + , memory , servant-client , servant-client-core , text @@ -69,12 +70,14 @@ test-suite unit -Werror build-depends: base + , bytestring , cardano-wallet-cli , cardano-wallet-core , filepath , hspec , optparse-applicative , QuickCheck + , silently , temporary , text , text-class diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index 86336756c5f..bd895f99d3d 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/lib/cli/src/Cardano/CLI.hs @@ -1,18 +1,22 @@ {-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | -- Copyright: © 2018-2020 IOHK @@ -34,6 +38,7 @@ module Cardano.CLI , cmdStakePool , cmdNetwork , cmdVersion + , cmdKey -- * Option & Argument Parsers , optionT @@ -57,6 +62,15 @@ module Cardano.CLI , TxId , MnemonicSize (..) , Port (..) + , CliKeyScheme (..) + , CliWalletStyle (..) + + , newCliKeyScheme + , hexTextToXPrv + , xPrvToHexText + , hoistKeyScheme + , mapKey + -- * Logging , withLogging @@ -95,13 +109,14 @@ import Cardano.BM.Data.Tracer import Cardano.BM.Setup ( setupTrace_, shutdown ) import Cardano.BM.Trace - ( Trace, logDebug ) + ( Trace, appendName, logDebug ) import Cardano.Wallet.Api.Client ( WalletClient (..), walletClient ) import Cardano.Wallet.Api.Server ( HostPreference, Listen (..) ) import Cardano.Wallet.Api.Types ( AddressAmount + , AllowedMnemonics , ApiEpochNumber , ApiMnemonicT (..) , ApiT (..) @@ -120,13 +135,22 @@ import Cardano.Wallet.Api.Types import Cardano.Wallet.Network ( ErrNetworkUnavailable (..) ) import Cardano.Wallet.Primitive.AddressDerivation - ( FromMnemonic (..) + ( ErrUnXPrvStripPub (..) + , ErrXPrvFromStrippedPubXPrv (..) + , FromMnemonic (..) + , FromMnemonicError (..) + , NatVals (..) , Passphrase (..) , PassphraseMaxLength , PassphraseMinLength + , SomeMnemonic (..) , WalletKey (..) + , XPrv , deriveRewardAccount + , hex , unXPrv + , unXPrvStripPub + , xPrvFromStrippedPubXPrv ) import Cardano.Wallet.Primitive.AddressDiscovery.Sequential ( AddressPoolGap, defaultAddressPoolGap ) @@ -143,27 +167,40 @@ import Control.Arrow import Control.Exception ( bracket, catch ) import Control.Monad - ( join, unless, void, when ) + ( join, unless, void, when, (>=>) ) import Control.Tracer ( Tracer, traceWith ) import Data.Aeson ( (.:) ) import Data.Bifunctor ( bimap ) +import Data.ByteArray.Encoding + ( Base (Base16), convertFromBase ) import Data.Char ( toLower ) +import Data.List + ( intercalate ) import Data.List.Extra ( enumerate ) import Data.List.NonEmpty ( NonEmpty (..) ) import Data.Maybe ( fromMaybe ) +import Data.Proxy + ( Proxy (..) ) import Data.String ( IsString ) import Data.Text ( Text ) import Data.Text.Class - ( FromText (..), TextDecodingError (..), ToText (..), showT ) + ( CaseStyle (..) + , FromText (..) + , TextDecodingError (..) + , ToText (..) + , fromTextToBoundedEnum + , showT + , toTextFromBoundedEnum + ) import Data.Text.Read ( decimal ) import Data.Void @@ -198,6 +235,7 @@ import Options.Applicative , footer , header , help + , helpDoc , helper , hidden , info @@ -213,6 +251,8 @@ import Options.Applicative , subparser , value ) +import Options.Applicative.Help.Pretty + ( string, vsep ) import Options.Applicative.Types ( ReadM (..), readerAsk ) import Servant.Client @@ -249,6 +289,7 @@ import System.IO , hGetEcho , hIsTerminalDevice , hPutChar + , hPutStrLn , hSetBuffering , hSetEcho , stderr @@ -258,6 +299,8 @@ import System.IO import qualified Cardano.BM.Configuration.Model as CM import qualified Cardano.BM.Data.BackendKind as CM +import qualified Cardano.Wallet.Api.Types as API +import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley import qualified Codec.Binary.Bech32 as Bech32 import qualified Codec.Binary.Bech32.TH as Bech32 @@ -266,6 +309,7 @@ import qualified Data.Aeson.Encode.Pretty as Aeson import qualified Data.Aeson.Types as Aeson import qualified Data.Bifunctor as Bi import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.List.NonEmpty as NE @@ -297,6 +341,169 @@ runCli = join . customExecParser preferences where preferences = prefs showHelpOnEmpty +{------------------------------------------------------------------------------- + Commands - 'HD Derivation' +-------------------------------------------------------------------------------} + +cmdKey :: Mod CommandFields (IO ()) +cmdKey = command "key" $ info (helper <*> cmds) $ mempty + <> progDesc "Derive keys from mnemonics." + where + cmds = subparser $ mempty + <> cmdRootKey + + +-- | Record with mnemonic and key derivation funcionality — /without/ any type +-- parameters related to scheme. +-- +-- This means that we can have a value for byron, a value for icarus, both with +-- the same type @CliKeyScheme@. +-- +-- @CliKeyScheme@ is on the other hand parameterized over @key@ and @m@. +-- @hoistKeyScheme@ is provided for mapping over @m@. @mapKey@ is provided for +-- mapping over @key@. +-- +-- This way we can test mapping @XPrv@s to @Text@ as pure code in +-- @Either String@, rather than @IO@. +data CliKeyScheme key m = CliKeyScheme + { allowedWordLengths :: [Int] + , mnemonicToRootKey :: [Text] -> m key + } + +-- | Change the underlying monad of a @CliKeyScheme@. +hoistKeyScheme + :: (forall a. m1 a -> m2 a) + -> CliKeyScheme key m1 + -> CliKeyScheme key m2 +hoistKeyScheme eta s = CliKeyScheme + { allowedWordLengths = allowedWordLengths s + , mnemonicToRootKey = eta . mnemonicToRootKey s + } + +xPrvToHexText :: XPrv -> Either String Text +xPrvToHexText = left showErr . fmap (T.pack . B8.unpack . hex) . unXPrvStripPub + where + showErr ErrCannotRoundtrip = + "That private key looks weird. Is it encrypted? Or an old Byron key?" + +hexTextToXPrv :: Text -> Either String XPrv +hexTextToXPrv txt = do + bytes <- fromHex $ B8.pack $ T.unpack txt + left showErr $ xPrvFromStrippedPubXPrv bytes + where + showErr (ErrInputLengthMismatch expected actual) = mconcat + [ "Expected extended private key to be " + , show expected + , " bytes but got " + , show actual + , " bytes." + ] + showErr (ErrInternalError msg) = mconcat + [ "Unexpected crypto error: " + , msg + ] + fromHex = left (const "Invalid hex.") + . convertFromBase Base16 + +-- | Map over the key type of a CliKeyScheme. +-- +-- Can be used with e.g @xPrvToHexText@. +mapKey + :: Monad m + => (key1 -> m key2) + -> CliKeyScheme key1 m + -> CliKeyScheme key2 m +mapKey f s = CliKeyScheme + { allowedWordLengths = allowedWordLengths s + , mnemonicToRootKey = (mnemonicToRootKey s) >=> f + } + +eitherToIO :: Either String a -> IO a +eitherToIO (Right a) = return a +eitherToIO (Left e) = hPutStrLn stderr e >> exitFailure + +data CliWalletStyle = Icarus | Ledger | Trezor + deriving (Show, Eq, Generic, Bounded, Enum) + +instance FromText CliWalletStyle where + fromText = fromTextToBoundedEnum SnakeLowerCase + +instance ToText CliWalletStyle where + toText = toTextFromBoundedEnum SnakeLowerCase + +newCliKeyScheme :: CliWalletStyle -> CliKeyScheme XPrv (Either String) +newCliKeyScheme = \case + Icarus -> + let + proxy = Proxy @'API.Icarus + in + CliKeyScheme + (apiAllowedLengths proxy) + (fmap icarusKeyFromSeed . seedFromMnemonic proxy) + Trezor -> + let + proxy = Proxy @'API.Trezor + in + CliKeyScheme + (apiAllowedLengths proxy) + (fmap icarusKeyFromSeed . seedFromMnemonic proxy) + Ledger -> + let + proxy = Proxy @'API.Ledger + in + CliKeyScheme + (apiAllowedLengths proxy) + (fmap ledgerKeyFromSeed . seedFromMnemonic proxy) + + where + seedFromMnemonic + :: forall (s :: API.ByronWalletStyle). + (FromMnemonic (AllowedMnemonics s)) + => Proxy s + -> [Text] + -> Either String SomeMnemonic + seedFromMnemonic _ = + left getFromMnemonicError . fromMnemonic @(AllowedMnemonics s) + + apiAllowedLengths + :: forall (s :: API.ByronWalletStyle). ( NatVals (AllowedMnemonics s)) + => Proxy s + -> [Int] + apiAllowedLengths _ = + (map fromIntegral (natVals $ Proxy @(AllowedMnemonics s))) + + icarusKeyFromSeed :: SomeMnemonic -> XPrv + icarusKeyFromSeed = Icarus.getKey . flip Icarus.generateKeyFromSeed pass + + ledgerKeyFromSeed :: SomeMnemonic -> XPrv + ledgerKeyFromSeed = Icarus.getKey + . flip Icarus.generateKeyFromHardwareLedger pass + + -- We don't use passwords to encrypt the keys here. + pass = mempty + +data KeyRootArgs = KeyRootArgs + { _walletStyle :: CliWalletStyle + , _mnemonicWords :: [Text] + } + +cmdRootKey :: Mod CommandFields (IO ()) +cmdRootKey = + command "root" $ info (helper <*> cmd) $ mempty + <> progDesc "Extract root extended private key from a mnemonic sentence." + where + cmd = fmap exec $ + KeyRootArgs <$> walletStyleOption <*> mnemonicWordsArgument + exec (KeyRootArgs keyType ws) = do + xprv <- mnemonicToRootKey scheme ws + TIO.putStrLn xprv + where + scheme :: CliKeyScheme Text IO + scheme = + hoistKeyScheme eitherToIO + . mapKey xPrvToHexText + $ newCliKeyScheme keyType + {------------------------------------------------------------------------------- Commands - 'mnemonic' -------------------------------------------------------------------------------} @@ -1013,6 +1220,49 @@ loggingSeverityOrOffReader = do "off" -> pure Nothing _ -> Just <$> loggingSeverityReader +-- | [--wallet-style=WALLET_STYLE] +-- +-- Note that we in the future might replace the type @CliWalletStyle@ with +-- another type, to include Shelley keys. +walletStyleOption :: Parser CliWalletStyle +walletStyleOption = option (eitherReader fromTextS) + ( long "wallet-style" + <> metavar "WALLET_STYLE" + <> helpDoc (Just (vsep typeOptions)) + ) + where + typeOptions = string <$> + [ "Any of the following:" + , " icarus (" ++ allowedWords Icarus ++ ")" + , " trezor (" ++ allowedWords Trezor ++ ")" + , " ledger (" ++ allowedWords Ledger ++ ")" + ] + + allowedWords = (++ " words") + . formatEnglishEnumeration + . map show + . allowedWordLengths + . newCliKeyScheme + where + -- >>> formatEnglishEnumeration ["a", "b", "c"] + -- "a, b or c" + -- + -- >>> formatEnglishEnumeration ["a", "b"] + -- "a or b" + -- + -- >>> formatEnglishEnumeration ["a"] + -- "a" + formatEnglishEnumeration = formatEnglishEnumerationRev . reverse + formatEnglishEnumerationRev [ult, penult] + = penult ++ " or " ++ ult + formatEnglishEnumerationRev (ult:penult:revBeginning) + = intercalate ", " (reverse revBeginning) + ++ ", " + ++ penult + ++ " or " + ++ ult + formatEnglishEnumerationRev xs = intercalate ", " (reverse xs) + -- | walletIdArgument :: Parser WalletId walletIdArgument = argumentT $ mempty @@ -1040,6 +1290,10 @@ transactionSubmitPayloadArgument = argumentT $ mempty <> metavar "BINARY_BLOB" <> help "hex-encoded binary blob of externally-signed transaction." +-- | +mnemonicWordsArgument :: Parser [Text] +mnemonicWordsArgument = some (argument str (metavar "MNEMONIC_WORD...")) + -- | Helper for writing an option 'Parser' using a 'FromText' instance. optionT :: FromText a => Mod OptionFields a -> Parser a optionT = option (eitherReader fromTextS) @@ -1203,7 +1457,7 @@ withLogging configFile minSeverity action = bracket before after (action . snd) where before = initTracer configFile minSeverity after (sb, (_, tr)) = do - logDebug tr "Logging shutdown." + logDebug (appendName "main" tr) "Logging shutdown." shutdown sb data LoggingOptions tracers = LoggingOptions diff --git a/lib/cli/test/unit/Cardano/CLISpec.hs b/lib/cli/test/unit/Cardano/CLISpec.hs index 1c85147209d..b4cf1cd7783 100644 --- a/lib/cli/test/unit/Cardano/CLISpec.hs +++ b/lib/cli/test/unit/Cardano/CLISpec.hs @@ -2,7 +2,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Cardano.CLISpec @@ -12,11 +14,14 @@ module Cardano.CLISpec import Prelude import Cardano.CLI - ( MnemonicSize (..) + ( CliKeyScheme (..) + , CliWalletStyle (..) + , MnemonicSize (..) , Port (..) , TxId , cli , cmdAddress + , cmdKey , cmdMnemonic , cmdNetwork , cmdStakePool @@ -24,13 +29,28 @@ import Cardano.CLI , cmdWallet , hGetLine , hGetSensitiveLine + , hexTextToXPrv + , mapKey + , newCliKeyScheme + , xPrvToHexText ) import Cardano.Wallet.Primitive.AddressDerivation - ( NetworkDiscriminant (..) ) + ( NetworkDiscriminant (..), XPrv, unXPrv ) +import Cardano.Wallet.Primitive.Mnemonic + ( ConsistentEntropy + , EntropySize + , Mnemonic + , entropyToMnemonic + , mnemonicToText + ) +import Cardano.Wallet.Unsafe + ( unsafeMkEntropy ) import Control.Concurrent ( forkFinally ) import Control.Concurrent.MVar ( newEmptyMVar, putMVar, takeMVar ) +import Control.Exception + ( SomeException, try ) import Control.Monad ( mapM_ ) import Data.Proxy @@ -39,57 +59,93 @@ import Data.Text ( Text ) import Data.Text.Class ( FromText (..), TextDecodingError (..), toText ) +import GHC.TypeLits + ( natVal ) import Options.Applicative ( ParserResult (..), columns, execParserPure, prefs, renderFailure ) +import System.Exit + ( ExitCode (..) ) import System.FilePath ( () ) import System.IO - ( Handle, IOMode (..), hClose, openFile ) + ( Handle, IOMode (..), hClose, openFile, stderr ) +import System.IO.Silently + ( capture_, hCapture_ ) import System.IO.Temp ( withSystemTempDirectory ) import Test.Hspec - ( Spec, describe, it, shouldBe ) + ( Spec, describe, expectationFailure, it, shouldBe, shouldStartWith ) import Test.QuickCheck ( Arbitrary (..) + , Gen , Large (..) + , Property , arbitraryBoundedEnum , checkCoverage , counterexample , cover + , expectFailure + , forAll , genericShrink + , oneof , property + , vectorOf + , (.&&.) , (===) ) import Test.Text.Roundtrip ( textRoundtrip ) +import qualified Data.ByteString as BS import qualified Data.Text as T import qualified Data.Text.IO as TIO spec :: Spec spec = do - describe "Specification / Usage Overview" $ do - let parser = cli $ mempty - <> cmdMnemonic - <> cmdWallet @'Testnet - <> cmdTransaction @'Testnet - <> cmdAddress @'Testnet - <> cmdStakePool @'Testnet - <> cmdNetwork @'Testnet - let defaultPrefs = prefs (mempty <> columns 65) - - let expectationFailure = flip counterexample False + let defaultPrefs = prefs (mempty <> columns 65) + + let parser = cli $ mempty + <> cmdMnemonic + <> cmdWallet @'Testnet + <> cmdTransaction @'Testnet + <> cmdAddress @'Testnet + <> cmdStakePool @'Testnet + <> cmdNetwork @'Testnet + <> cmdKey + + + let shouldStdOut args expected = it (unwords args) $ + case execParserPure defaultPrefs parser args of + Success x -> capture_ x >>= (`shouldBe` expected) + CompletionInvoked _ -> expectationFailure + "expected parser to show usage but it offered completion" + Failure failure -> + expectationFailure $ "parser failed with: " ++ show failure + let expectStdErr args expectation = it (unwords args) $ + case execParserPure defaultPrefs parser args of + Success x -> + hCapture_ [stderr] (try @SomeException x) >>= (expectation) + CompletionInvoked _ -> expectationFailure + "expected parser to show usage but it offered completion" + Failure failure -> do + let (str, code) = renderFailure failure "" + code `shouldBe` (ExitFailure 1) + expectation str + describe "Specification / Usage Overview" $ do + let expectationFailure' = flip counterexample False let shouldShowUsage args expected = it (unwords args) $ case execParserPure defaultPrefs parser args of - Success _ -> expectationFailure + Success _ -> expectationFailure' "expected parser to show usage but it has succeeded" - CompletionInvoked _ -> expectationFailure + CompletionInvoked _ -> expectationFailure' "expected parser to show usage but it offered completion" Failure failure -> property $ let (usage, _) = renderFailure failure mempty - in counterexample usage $ expected === lines usage + msg = "*** Expected:\n" ++ (unlines expected) + ++ "*** but actual usage is:\n" ++ usage + in counterexample msg $ expected === lines usage ["--help"] `shouldShowUsage` [ "The CLI is a proxy to the wallet server, which is required for" @@ -111,6 +167,7 @@ spec = do , " address Manage addresses." , " stake-pool Manage stake pools." , " network Manage network." + , " key Derive keys from mnemonics." ] ["mnemonic", "--help"] `shouldShowUsage` @@ -147,6 +204,19 @@ spec = do , "!!! Only for the Incentivized Testnet !!!" ] + + ["key", "--help"] `shouldShowUsage` + [ "Usage: key COMMAND" + , " Derive keys from mnemonics." + , "" + , "Available options:" + , " -h,--help Show this help text" + , "" + , "Available commands:" + , " root Extract root extended private key from" + , " a mnemonic sentence." + ] + ["wallet", "--help"] `shouldShowUsage` [ "Usage: wallet COMMAND" , " Manage wallets." @@ -384,9 +454,23 @@ spec = do , " EPOCH_NUMBER epoch number parameter or 'latest'" ] + ["key", "root", "--help"] `shouldShowUsage` + [ "Usage: key root --wallet-style WALLET_STYLE MNEMONIC_WORD..." + , " Extract root extended private key from a mnemonic sentence." + , "" + , "Available options:" + , " -h,--help Show this help text" + , " --wallet-style WALLET_STYLE" + , " Any of the following:" + , " icarus (15 words)" + , " trezor (12, 15, 18, 21 or 24 words)" + , " ledger (12, 15, 18, 21 or 24 words)" + ] + describe "Can perform roundtrip textual encoding & decoding" $ do textRoundtrip $ Proxy @(Port "test") textRoundtrip $ Proxy @MnemonicSize + textRoundtrip $ Proxy @CliWalletStyle describe "Transaction ID decoding from text" $ do @@ -473,10 +557,128 @@ spec = do , expectedStdout = "Prompt: ******\ESC[1D \ESC[1D\ESC[1D \ESC[1D**\n" , expectedResult = "pata14" :: Text } + + let mw15 = words "message mask aunt wheel ten maze between tomato slow \ + \analyst ladder such report capital produce" + let mw12 = words "broccoli side goddess shaft alarm victory sheriff \ + \combine birth deny train outdoor" + describe "key derivation from mnemonics" $ do + (["key", "root", "--wallet-style", "icarus"] ++ mw15) `shouldStdOut` + "00aa5f5f364980f4ac6295fd0fbf65643390d6bb1cf76536c2ebb02713c8ba50d8\ + \903bee774b7bf8678ea0d6fded6d876db3b42bef687640cc514eb73f767537a8c7\ + \54f89bc9cc83533eab257d7c94625c95f0d749710428f5aa2404eeb6499b\n" + (["key", "root", "--wallet-style", "trezor"] ++ mw15) `shouldStdOut` + "00aa5f5f364980f4ac6295fd0fbf65643390d6bb1cf76536c2ebb02713c8ba50d8\ + \903bee774b7bf8678ea0d6fded6d876db3b42bef687640cc514eb73f767537a8c7\ + \54f89bc9cc83533eab257d7c94625c95f0d749710428f5aa2404eeb6499b\n" + (["key", "root", "--wallet-style", "ledger"] ++ mw15) `shouldStdOut` + "003a914372e711b910a75b87e98695929b6960bd5380cfd766b572ea844ea14080\ + \9eb7ad13f798d06ce550a9f6c48dd2151db4593e67dbd2821d75378c7350f1366b\ + \85e0be9cdec2213af2084d462cc11e85c215e0f003acbeb996567e371502\n" + + describe "key derivation (negative tests)" $ do + (["key", "root", "--wallet-style", "icarus"] ++ mw12) `expectStdErr` + (`shouldBe` "Invalid number of words: 15 words are expected.\n") + + (["key", "root", "--wallet-style", "icarus"]) `expectStdErr` + (`shouldStartWith` "Missing: MNEMONIC_WORD...") + + let shrug = "¯\\_(ツ)_/¯" + (["key", "root", "--wallet-style", "icarus"] ++ (replicate 15 shrug)) + `expectStdErr` (`shouldBe` + "Found an unknown word not present in the pre-defined dictionary. \ + \The full dictionary is available here:\ + \ https://github.com/input-output-hk/cardano-wallet/tree/master/spe\ + \cifications/mnemonic/english.txt\n") + + describe "CliKeyScheme" $ do + it "all allowedWordLengths are supported" + $ property prop_allowedWordLengthsAllWork + + it "scheme == scheme (reflexivity)" $ property $ \s -> + propCliKeySchemeEquality + (newCliKeyScheme s) + (newCliKeyScheme s) + + -- This tests provides a stronger guarantee than merely knowing that + -- unsafeHexTextToXPrv and xPrvToHexText roundtrips. + it "scheme == mapKey (fromHex . toHex) scheme" + $ property prop_roundtripCliKeySchemeKeyViaHex + + it "random /= icarus" $ do + expectFailure $ propCliKeySchemeEquality + (newCliKeyScheme Ledger) + (newCliKeyScheme Icarus) + where backspace :: Text backspace = T.singleton (toEnum 127) +prop_roundtripCliKeySchemeKeyViaHex :: CliWalletStyle -> Property +prop_roundtripCliKeySchemeKeyViaHex style = + propCliKeySchemeEquality + (newCliKeyScheme style) + (mapKey hexTextToXPrv + . mapKey xPrvToHexText + $ newCliKeyScheme style) + +prop_allowedWordLengthsAllWork :: CliWalletStyle -> Property +prop_allowedWordLengthsAllWork style = do + (forAll (genAllowedMnemonic s) propCanRetrieveRootKey) + where + s :: CliKeyScheme XPrv (Either String) + s = newCliKeyScheme style + + propCanRetrieveRootKey :: [Text] -> Property + propCanRetrieveRootKey mw = case mnemonicToRootKey s mw of + Right _ -> property True + Left e -> counterexample + (show (length mw) ++ " words, failed with: " ++ e) + (property False) + +propCliKeySchemeEquality + :: CliKeyScheme XPrv (Either String) + -> CliKeyScheme XPrv (Either String) + -> Property +propCliKeySchemeEquality s1 s2 = do + (forAll (genAllowedMnemonic s1) propSameMnem) + .&&. + (allowedWordLengths s1) === (allowedWordLengths s2) + where + propSameMnem :: [Text] -> Property + propSameMnem mw = (mnemonicToRootKey s1 mw) === (mnemonicToRootKey s2 mw) + +genAllowedMnemonic :: CliKeyScheme key m -> Gen [Text] +genAllowedMnemonic s = oneof (map genMnemonicOfSize $ allowedWordLengths s) + +genMnemonicOfSize :: Int -> Gen [Text] +genMnemonicOfSize = \case + 12 -> mnemonicToText <$> genMnemonic @12 + 15 -> mnemonicToText <$> genMnemonic @15 + 18 -> mnemonicToText <$> genMnemonic @18 + 21 -> mnemonicToText <$> genMnemonic @21 + 24 -> mnemonicToText <$> genMnemonic @24 + n -> error $ "when this test was written, " ++ show n ++ + " was not a valid length of a mnemonic" + +instance Show XPrv where + show = show . unXPrv + +instance Eq XPrv where + a == b = unXPrv a == unXPrv b + +genMnemonic + :: forall mw ent csz. + ( ConsistentEntropy ent mw csz + , EntropySize mw ~ ent + ) + => Gen (Mnemonic mw) +genMnemonic = do + let n = fromIntegral (natVal $ Proxy @(EntropySize mw)) `div` 8 + bytes <- BS.pack <$> vectorOf n arbitrary + let ent = unsafeMkEntropy @(EntropySize mw) bytes + return $ entropyToMnemonic ent + {------------------------------------------------------------------------------- hGetSensitiveLine -------------------------------------------------------------------------------} @@ -532,6 +734,10 @@ instance Arbitrary MnemonicSize where arbitrary = arbitraryBoundedEnum shrink = genericShrink +instance Arbitrary CliWalletStyle where + arbitrary = arbitraryBoundedEnum + shrink = genericShrink + instance Arbitrary (Port "test") where arbitrary = arbitraryBoundedEnum shrink p diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs index 3cf0957a7e3..37b6689aaf6 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -55,8 +55,15 @@ module Cardano.Wallet.Primitive.AddressDerivation , unXPrv , xprv , xpub + + -- * Helpers , hex , fromHex + , unXPrvStripPub + , xPrvFromStrippedPubXPrv + , ErrXPrvFromStrippedPubXPrv (..) + , ErrUnXPrvStripPub (..) + , NatVals (..) -- * Network Discrimination , NetworkDiscriminant (..) @@ -107,7 +114,7 @@ import Control.Arrow import Control.DeepSeq ( NFData ) import Control.Monad - ( unless ) + ( unless, when ) import Crypto.Hash ( Digest, HashAlgorithm ) import Crypto.KDF.PBKDF2 @@ -153,6 +160,7 @@ import GHC.TypeLits import Type.Reflection ( typeOf ) +import qualified Cardano.Crypto.Wallet.Encrypted as CC import qualified Data.ByteArray as BA import qualified Data.ByteString as BS import qualified Data.Text as T @@ -346,7 +354,7 @@ toChimericAccount = -- readability in function signatures. newtype Passphrase (purpose :: Symbol) = Passphrase ScrubbedBytes deriving stock (Eq, Show) - deriving newtype (Semigroup, Monoid, NFData) + deriving newtype (Semigroup, Monoid, NFData, ByteArrayAccess) type role Passphrase phantom @@ -720,3 +728,67 @@ hex = convertToBase Base16 -- | Decode a 'ByteString' from base16 fromHex :: ByteArray bout => ByteString -> Either String bout fromHex = convertFromBase Base16 + +data ErrUnXPrvStripPub + = ErrCannotRoundtrip + -- ^ The resulting bytestring would have been unable to roundtrip using + -- @xPrvFromStrippedPubXPrv@. Most likely because the input @XPrv@ was + -- encrypted, or because it was an old (Byron) key. + deriving (Eq, Show) + +-- | Convert a @XPrv@ to a 96-byte long extended private key that does /not/ +-- include the public key. +-- +-- The format is: +-- > Extended Private Key (64 bytes) <> ChainCode (32 bytes) +-- +-- Returns @Left@ if the resulting bytestring fails to roundtrip back to the +-- original @XPrv@. This can happen: +-- - If the @XPrv@ was encrypted +-- - If a DerivationScheme1 (Byron) key was used (that does not conform to the +-- "tweak") +unXPrvStripPub :: XPrv -> Either ErrUnXPrvStripPub ByteString +unXPrvStripPub k = do + let res = stripPub . unXPrv $ k + + -- Check that it roundtrips. + case (fmap unXPrv . xPrvFromStrippedPubXPrv $ res) of + Right bytes + | bytes == unXPrv k -> Right res + | otherwise -> Left ErrCannotRoundtrip + Left _ -> error "unXPrvStripPub: this state cannot be \ + \reached from a rightfully crafted XPrv" + where + -- Converts xprv <> pub <> cc + -- To xprv <> cc + stripPub :: ByteString -> ByteString + stripPub xprv' = prv <> chainCode + where + (prv, rest) = BS.splitAt 64 xprv' + (_pub, chainCode) = BS.splitAt 32 rest + +data ErrXPrvFromStrippedPubXPrv + = ErrInputLengthMismatch Int Int -- ^ Expected, Actual + | ErrInternalError String + deriving (Eq, Show) + +-- | Create a @XPrv@ from a 96-byte long extended private key +-- +-- The format is: +-- +-- > Extended Private Key (64 bytes) <> ChainCode (32 bytes) +xPrvFromStrippedPubXPrv :: ByteString -> Either ErrXPrvFromStrippedPubXPrv XPrv +xPrvFromStrippedPubXPrv x = do + when (BS.length x /= expectedInputLength) $ + Left $ ErrInputLengthMismatch expectedInputLength (BS.length x) + toXPrv $ CC.encryptedCreateDirectWithTweak x pass + where + pass :: ByteString + pass = "" + + expectedInputLength = 96 + + -- @xprv@ can fail. But because it is calling @encryptedKey@ internally, + -- and we are feeding it the output of @unEncryptedKey@, it really shouldn't. + toXPrv :: CC.EncryptedKey -> Either ErrXPrvFromStrippedPubXPrv XPrv + toXPrv = left ErrInternalError . xprv . CC.unEncryptedKey diff --git a/lib/core/test/bench/db/Main.hs b/lib/core/test/bench/db/Main.hs index aa0b1489bde..0854c637887 100644 --- a/lib/core/test/bench/db/Main.hs +++ b/lib/core/test/bench/db/Main.hs @@ -43,7 +43,7 @@ import Cardano.BM.Data.Tracer ( nullTracer ) import Cardano.DB.Sqlite ( SqliteContext, destroyDBLayer ) -import Cardano.Launcher +import Cardano.Startup ( withUtf8Encoding ) import Cardano.Wallet.DB ( DBLayer (..), PrimaryKey (..), cleanDB ) diff --git a/lib/core/test/unit/Cardano/Wallet/Gen.hs b/lib/core/test/unit/Cardano/Wallet/Gen.hs index 59357f9eb38..2ffbeda3d88 100644 --- a/lib/core/test/unit/Cardano/Wallet/Gen.hs +++ b/lib/core/test/unit/Cardano/Wallet/Gen.hs @@ -13,7 +13,9 @@ module Cardano.Wallet.Gen import Prelude import Cardano.Wallet.Primitive.Mnemonic - ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic, mkEntropy ) + ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic ) +import Cardano.Wallet.Unsafe + ( unsafeMkEntropy ) import Data.Proxy ( Proxy (..) ) import GHC.TypeLits @@ -36,5 +38,5 @@ genMnemonic genMnemonic = do let n = fromIntegral (natVal $ Proxy @(EntropySize mw)) `div` 8 bytes <- BS.pack <$> vectorOf n arbitrary - let ent = either (error . show) id $ mkEntropy @(EntropySize mw) bytes + let ent = unsafeMkEntropy @(EntropySize mw) bytes return $ entropyToMnemonic ent diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs index 0f10eccea48..cf9eb876ef9 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs @@ -25,6 +25,7 @@ import Cardano.Wallet.Gen import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..) , DerivationType (..) + , ErrUnXPrvStripPub (..) , ErrWrongPassphrase (..) , FromMnemonic (..) , FromMnemonicError (..) @@ -42,6 +43,8 @@ import Cardano.Wallet.Primitive.AddressDerivation , checkPassphrase , encryptPassphrase , getIndex + , unXPrvStripPub + , xPrvFromStrippedPubXPrv ) import Cardano.Wallet.Primitive.AddressDerivation.Byron ( ByronKey (..) ) @@ -51,12 +54,16 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( KnownNetwork (..), ShelleyKey (..) ) import Cardano.Wallet.Primitive.Types ( Address (..), Hash (..) ) +import Control.Arrow + ( left ) import Control.Monad - ( replicateM ) + ( replicateM, (>=>) ) import Control.Monad.IO.Class ( liftIO ) import Data.Either - ( isRight ) + ( isLeft, isRight ) +import Data.Function + ( (&) ) import Data.Proxy ( Proxy (..) ) import Test.Hspec @@ -65,12 +72,16 @@ import Test.QuickCheck ( Arbitrary (..) , Gen , InfiniteList (..) + , NonNegative (..) , Property , arbitraryBoundedEnum , arbitraryPrintableChar , choose + , classify + , counterexample , expectFailure , genericShrink + , label , oneof , property , vectorOf @@ -213,6 +224,13 @@ spec = do it "XPub IcarusKey" (property $ prop_roundtripXPub @IcarusKey) + describe "unXPrvStripPub & xPrvFromStrippedPubXPrv" $ do + it "either roundtrips or fails (if xprv is encrypted)" + (property prop_unXPrvStripRoundtrip) + + it "(xPrvFromStrippedPubXPrv bs) fails if (BS.length bs) /= 96" + (property prop_xPrvFromStrippedPubXPrvLengthRequirement) + {------------------------------------------------------------------------------- Properties -------------------------------------------------------------------------------} @@ -281,6 +299,44 @@ prop_passphraseHashMalformed prop_passphraseHashMalformed pwd = monadicIO $ liftIO $ do checkPassphrase pwd (Hash mempty) `shouldBe` Left ErrWrongPassphrase +-- NOTE: Instead of testing +-- > encrypted => fails +-- we are testing +-- > fails => encrypted +-- +-- This /should/ be enough. If a key were to be encrypted, but still roundtrip, +-- we would not care. +prop_unXPrvStripRoundtrip :: XPrvWithPass -> Property +prop_unXPrvStripRoundtrip (XPrvWithPass k enc) = do + let res = unXPrvStripPub k + case res of + Right k' -> + xPrvFromStrippedPubXPrv k' === Right k + & label "roundtrip" + Left ErrCannotRoundtrip -> + enc /= Passphrase "" + & label "mismatch" + & counterexample "XPrv should be encrypted for the roundtrip to\ + \fail" +prop_xPrvFromStrippedPubXPrvLengthRequirement + :: Unencrypted XPrv + -> NonNegative Int + -> Property +prop_xPrvFromStrippedPubXPrvLengthRequirement (Unencrypted k) (NonNegative n) = do + let f = toStripped >=> (return . BS.take n) >=> fromStripped + let k' = f k + -- A reason for writing the test using BS.take n instead of say vectorOf + -- was guarding against + -- https://github.com/input-output-hk/cardano-crypto/issues/67 + n < 96 ==> property $ isLeft k' + & counterexample ("n = " ++ show n) + & counterexample ("result = " ++ show k') + & classify (n == 96) "== 96" + & classify (n < 96) "< 96" + where + toStripped = left show . unXPrvStripPub + fromStripped = left show . xPrvFromStrippedPubXPrv + {------------------------------------------------------------------------------- Arbitrary Instances -------------------------------------------------------------------------------} @@ -342,11 +398,11 @@ instance Eq XPrv where instance Arbitrary (ShelleyKey 'RootK XPrv) where shrink _ = [] - arbitrary = genRootKeysSeq + arbitrary = genRootKeysSeqWithPass =<< genPassphrase (0, 16) instance Arbitrary (ShelleyKey 'AccountK XPub) where shrink _ = [] - arbitrary = publicKey <$> genRootKeysSeq + arbitrary = publicKey <$> (genRootKeysSeqWithPass =<< genPassphrase (0, 16)) instance Arbitrary (ShelleyKey 'RootK XPub) where shrink _ = [] @@ -354,37 +410,72 @@ instance Arbitrary (ShelleyKey 'RootK XPub) where instance Arbitrary (ByronKey 'RootK XPrv) where shrink _ = [] - arbitrary = genRootKeysRnd + arbitrary = genRootKeysRndWithPass =<< genPassphrase (0, 16) instance Arbitrary (IcarusKey 'RootK XPrv) where shrink _ = [] - arbitrary = genRootKeysIca + arbitrary = genRootKeysIcaWithPass =<< genPassphrase (0, 16) instance Arbitrary (IcarusKey 'AccountK XPub) where shrink _ = [] - arbitrary = publicKey <$> genRootKeysIca + arbitrary = publicKey <$> (genRootKeysIcaWithPass =<< genPassphrase (0, 16)) instance Arbitrary NetworkDiscriminant where arbitrary = arbitraryBoundedEnum shrink = genericShrink -genRootKeysSeq :: Gen (ShelleyKey depth XPrv) -genRootKeysSeq = do - (s, g, e) <- (,,) - <$> (SomeMnemonic <$> genMnemonic @15) - <*> (Just . SomeMnemonic <$> genMnemonic @12) - <*> genPassphrase @"encryption" (0, 16) - return $ Seq.unsafeGenerateKeyFromSeed (s, g) e +newtype Unencrypted a = Unencrypted { getUnencrypted :: a } + deriving (Eq, Show) + +instance Arbitrary (Unencrypted XPrv) where + shrink _ = [] + arbitrary = Unencrypted <$> genAnyKeyWithPass mempty + +data XPrvWithPass = XPrvWithPass XPrv (Passphrase "encryption") + deriving (Eq, Show) + +instance Arbitrary XPrvWithPass where + shrink _ = [] + arbitrary = do + pwd <- oneof + [ genPassphrase (0, 16) + , return $ Passphrase "" + ] + flip XPrvWithPass pwd <$> genAnyKeyWithPass pwd + +genAnyKeyWithPass + :: Passphrase "encryption" + -> Gen XPrv +genAnyKeyWithPass pwd = oneof + [ getRawKey + <$> genRootKeysSeqWithPass pwd + , getRawKey + <$> genRootKeysRndWithPass pwd + , getRawKey + <$> genRootKeysIcaWithPass pwd + ] -genRootKeysRnd :: Gen (ByronKey 'RootK XPrv) -genRootKeysRnd = Rnd.generateKeyFromSeed +genRootKeysSeqWithPass + :: Passphrase "encryption" + -> Gen (ShelleyKey depth XPrv) +genRootKeysSeqWithPass encryptionPass = do + s <- SomeMnemonic <$> genMnemonic @15 + g <- Just . SomeMnemonic <$> genMnemonic @12 + return $ Seq.unsafeGenerateKeyFromSeed (s, g) encryptionPass + +genRootKeysRndWithPass + :: Passphrase "encryption" + -> Gen (ByronKey 'RootK XPrv) +genRootKeysRndWithPass encryptionPass = Rnd.generateKeyFromSeed <$> (SomeMnemonic <$> genMnemonic @12) - <*> genPassphrase @"encryption" (0, 16) + <*> (pure encryptionPass) -genRootKeysIca :: Gen (IcarusKey depth XPrv) -genRootKeysIca = Ica.unsafeGenerateKeyFromSeed +genRootKeysIcaWithPass + :: Passphrase "encryption" + -> Gen (IcarusKey depth XPrv) +genRootKeysIcaWithPass encryptionPass = Ica.unsafeGenerateKeyFromSeed <$> (SomeMnemonic <$> genMnemonic @15) - <*> genPassphrase @"encryption" (0, 16) + <*> (pure encryptionPass) genPassphrase :: (Int, Int) -> Gen (Passphrase purpose) genPassphrase range = do diff --git a/lib/core/test/unit/Main.hs b/lib/core/test/unit/Main.hs index 2f34fd10a1d..f39d23bc141 100644 --- a/lib/core/test/unit/Main.hs +++ b/lib/core/test/unit/Main.hs @@ -1,6 +1,6 @@ module Main where -import Cardano.Launcher +import Cardano.Startup ( withUtf8Encoding ) import Prelude import qualified Spec diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index d67ff3e7b78..436676a8cef 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/lib/jormungandr/cardano-wallet-jormungandr.cabal @@ -99,6 +99,7 @@ executable cardano-wallet-jormungandr , cardano-wallet-core , cardano-wallet-jormungandr , cardano-wallet-launcher + , contra-tracer , filepath , iohk-monitoring , network @@ -251,10 +252,11 @@ test-suite integration Test.Integration.Jormungandr.Scenario.API.StakePools Test.Integration.Jormungandr.Scenario.API.Transactions Test.Integration.Jormungandr.Scenario.CLI.Launcher + Test.Integration.Jormungandr.Scenario.CLI.Keys + Test.Integration.Jormungandr.Scenario.CLI.Mnemonics Test.Integration.Jormungandr.Scenario.CLI.Server Test.Integration.Jormungandr.Scenario.CLI.StakePools Test.Integration.Jormungandr.Scenario.CLI.Transactions - Test.Integration.Jormungandr.Scenario.CLI.Mnemonics Test.Utils.Ports benchmark latency diff --git a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs index 23f4a2a0076..4777b376a73 100644 --- a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs +++ b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs @@ -27,12 +27,13 @@ import Prelude import Cardano.BM.Data.Severity ( Severity (..) ) import Cardano.BM.Trace - ( Trace, appendName, logDebug, logInfo ) + ( Trace, appendName, logInfo, logNotice ) import Cardano.CLI ( LoggingOptions (..) , Port (..) , cli , cmdAddress + , cmdKey , cmdMnemonic , cmdNetwork , cmdStakePool @@ -58,7 +59,13 @@ import Cardano.CLI , withLogging ) import Cardano.Launcher - ( StdStream (..), withUtf8Encoding ) + ( StdStream (..) ) +import Cardano.Startup + ( ShutdownHandlerLog + , installSignalHandlers + , withShutdownHandler + , withUtf8Encoding + ) import Cardano.Wallet.Api.Server ( HostPreference, Listen (..) ) import Cardano.Wallet.Jormungandr @@ -78,7 +85,7 @@ import Cardano.Wallet.Jormungandr.Network , JormungandrConnParams (..) ) import Cardano.Wallet.Logging - ( transformTextTrace ) + ( trMessage, transformTextTrace ) import Cardano.Wallet.Primitive.AddressDerivation ( NetworkDiscriminant (..) ) import Cardano.Wallet.Primitive.Types @@ -87,6 +94,10 @@ import Cardano.Wallet.Version ( GitRevision, Version, gitRevision, showFullVersion, version ) import Control.Applicative ( Const (..), optional, (<|>) ) +import Control.Monad + ( void ) +import Control.Tracer + ( contramap ) import Data.List ( isPrefixOf ) import Data.Maybe @@ -159,6 +170,7 @@ main = withUtf8Encoding $ do <> cmdStakePool @'Testnet <> cmdNetwork @'Testnet <> cmdVersion + <> cmdKey beforeMainLoop :: Trace IO MainLog @@ -228,29 +240,32 @@ cmdLaunch dataDir = command "launch" $ info (helper <*> helper' <*> cmd) $ mempt <*> extraArguments) exec args@(LaunchArgs hostPreference listen nodePort mStateDir sTolerance logOpt jArgs) = do withTracers logOpt $ \tr tracers -> do - logDebug tr $ MsgLaunchArgs args - case genesisBlock jArgs of - Right block0File -> requireFilePath block0File - Left _ -> pure () - let stateDir = fromMaybe (dataDir "testnet") mStateDir - let databaseDir = stateDir "wallets" - let cp = JormungandrConfig - { _stateDir = stateDir - , _genesisBlock = genesisBlock jArgs - , _restApiPort = fromIntegral . getPort <$> nodePort - , _outputStream = Inherit - , _extraArgs = extraJormungandrArgs jArgs - } - setupDirectory (logInfo tr . MsgSetupStateDir) stateDir - setupDirectory (logInfo tr . MsgSetupDatabases) databaseDir - exitWith =<< serveWallet @'Testnet - tracers - sTolerance - (Just databaseDir) - hostPreference - listen - (Launch cp) - (beforeMainLoop tr) + installSignalHandlers (logNotice tr MsgSigTerm) + let trShutdown = trMessage (contramap (fmap MsgShutdownHandler) tr) + void $ withShutdownHandler trShutdown $ do + logInfo tr $ MsgLaunchArgs args + case genesisBlock jArgs of + Right block0File -> requireFilePath block0File + Left _ -> pure () + let stateDir = fromMaybe (dataDir "testnet") mStateDir + let databaseDir = stateDir "wallets" + let cp = JormungandrConfig + { _stateDir = stateDir + , _genesisBlock = genesisBlock jArgs + , _restApiPort = fromIntegral . getPort <$> nodePort + , _outputStream = Inherit + , _extraArgs = extraJormungandrArgs jArgs + } + setupDirectory (logInfo tr . MsgSetupStateDir) stateDir + setupDirectory (logInfo tr . MsgSetupDatabases) databaseDir + exitWith =<< serveWallet @'Testnet + tracers + sTolerance + (Just databaseDir) + hostPreference + listen + (Launch cp) + (beforeMainLoop tr) {------------------------------------------------------------------------------- Command - 'serve' @@ -287,18 +302,21 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty -> IO () exec args@(ServeArgs hostPreference listen nodePort databaseDir sTolerance block0H logOpt) = do withTracers logOpt $ \tr tracers -> do - logDebug tr $ MsgServeArgs args - let baseUrl = localhostBaseUrl $ getPort nodePort - let cp = JormungandrConnParams block0H baseUrl - whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases) - exitWith =<< serveWallet @'Testnet - tracers - sTolerance - databaseDir - hostPreference - listen - (UseRunning cp) - (beforeMainLoop tr) + installSignalHandlers (logNotice tr MsgSigTerm) + let trShutdown = trMessage (contramap (fmap MsgShutdownHandler) tr) + void $ withShutdownHandler trShutdown $ do + logInfo tr $ MsgServeArgs args + let baseUrl = localhostBaseUrl $ getPort nodePort + let cp = JormungandrConnParams block0H baseUrl + whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases) + exitWith =<< serveWallet @'Testnet + tracers + sTolerance + databaseDir + hostPreference + listen + (UseRunning cp) + (beforeMainLoop tr) whenJust m fn = case m of Nothing -> pure () @@ -379,6 +397,8 @@ data MainLog | MsgLaunchArgs LaunchArgs | MsgServeArgs ServeArgs | MsgListenAddress SockAddr + | MsgSigTerm + | MsgShutdownHandler ShutdownHandlerLog deriving (Show, Eq) instance ToText MainLog where @@ -393,6 +413,8 @@ instance ToText MainLog where MsgServeArgs args -> T.pack $ show args MsgListenAddress addr -> "Wallet backend server listening on " <> T.pack (show addr) + MsgSigTerm -> "Terminated by signal." + MsgShutdownHandler msg' -> toText msg' withTracers :: LoggingOptions TracerSeverities diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs index f00f7f49292..f89ceb49457 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs @@ -61,7 +61,7 @@ import Cardano.CLI import Cardano.DB.Sqlite ( DBLog ) import Cardano.Launcher - ( ProcessHasExited (..), installSignalHandlers ) + ( ProcessHasExited (..) ) import Cardano.Pool.Metrics ( StakePoolLayer, StakePoolLog, monitorStakePools, newStakePoolLayer ) import Cardano.Wallet @@ -206,7 +206,6 @@ serveWallet -- ^ Callback to run before the main loop -> IO ExitCode serveWallet Tracers{..} sTolerance databaseDir hostPref listen backend beforeMainLoop = do - installSignalHandlers (traceWith applicationTracer MsgSigTerm) traceWith applicationTracer $ MsgStarting backend traceWith applicationTracer $ MsgNetworkName $ networkDiscriminantVal @n Server.withListeningSocket hostPref listen $ \case @@ -342,7 +341,6 @@ toWLBlock = J.convertBlock data ApplicationLog = MsgStarting JormungandrBackend | MsgNetworkName NetworkDiscriminant - | MsgSigTerm | MsgWalletStartupError ErrStartup | MsgServerStartupError ListenError | MsgDatabaseStartup DatabasesStartupLog @@ -353,7 +351,6 @@ instance ToText ApplicationLog where MsgStarting backend -> "Wallet backend server starting. " <> toText backend <> "..." MsgNetworkName n -> "Node is Jörmungandr on " <> toText n - MsgSigTerm -> "Terminated by signal." MsgDatabaseStartup dbMsg -> toText dbMsg MsgWalletStartupError startupErr -> case startupErr of ErrStartupGetBlockchainParameters e -> case e of @@ -407,7 +404,6 @@ instance DefinePrivacyAnnotation ApplicationLog instance DefineSeverity ApplicationLog where defineSeverity ev = case ev of MsgStarting _ -> Info - MsgSigTerm -> Notice MsgNetworkName _ -> Info MsgDatabaseStartup dbEv -> defineSeverity dbEv MsgWalletStartupError _ -> Alert diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs index bed35ccf826..b7403648af3 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs @@ -522,7 +522,7 @@ withJormungandr tr (JormungandrConfig stateDir block0 mPort output extraArgs) cb [ "--rest-listen", "127.0.0.1:" <> show apiPort , "--storage", stateDir "chain" ] ++ extraArgs - let cmd = Command "jormungandr" args (return ()) output + let cmd = Command "jormungandr" args (return ()) Inherit output res <- withBackendProcess (contramap MsgLauncher tr) cmd $ do waitForPort defaultRetryPolicy apiPort >>= \case True -> Right <$> cb (JormungandrConnParams block0H baseUrl) diff --git a/lib/jormungandr/test/bench/Latency.hs b/lib/jormungandr/test/bench/Latency.hs index 44d40bcc264..e000cf179ec 100644 --- a/lib/jormungandr/test/bench/Latency.hs +++ b/lib/jormungandr/test/bench/Latency.hs @@ -32,7 +32,9 @@ import Cardano.BM.Trace import Cardano.Faucet ( initFaucet, sockAddrPort ) import Cardano.Launcher - ( ProcessHasExited (..), withUtf8Encoding ) + ( ProcessHasExited (..) ) +import Cardano.Startup + ( withUtf8Encoding ) import Cardano.Wallet.Api.Server ( Listen (..) ) import Cardano.Wallet.Api.Types diff --git a/lib/jormungandr/test/integration/Main.hs b/lib/jormungandr/test/integration/Main.hs index 9cf515a17a5..138d46e1e9d 100644 --- a/lib/jormungandr/test/integration/Main.hs +++ b/lib/jormungandr/test/integration/Main.hs @@ -23,9 +23,11 @@ import Cardano.CLI import Cardano.Faucet ( initFaucet, sockAddrPort ) import Cardano.Launcher - ( ProcessHasExited (..), withUtf8Encoding ) + ( ProcessHasExited (..) ) import Cardano.Pool.Metadata ( envVarMetadataRegistry ) +import Cardano.Startup + ( withUtf8Encoding ) import Cardano.Wallet.Api.Server ( Listen (..) ) import Cardano.Wallet.Jormungandr @@ -84,6 +86,7 @@ import qualified Cardano.Wallet.Jormungandr.NetworkSpec as NetworkLayer import qualified Data.Text as T import qualified Test.Integration.Jormungandr.Scenario.API.StakePools as StakePoolsApiJormungandr import qualified Test.Integration.Jormungandr.Scenario.API.Transactions as TransactionsApiJormungandr +import qualified Test.Integration.Jormungandr.Scenario.CLI.Keys as KeysCLI import qualified Test.Integration.Jormungandr.Scenario.CLI.Launcher as LauncherCLI import qualified Test.Integration.Jormungandr.Scenario.CLI.Mnemonics as MnemonicsJormungandr import qualified Test.Integration.Jormungandr.Scenario.CLI.Server as ServerCLI @@ -117,6 +120,7 @@ main = withUtf8Encoding $ withLogging Nothing Info $ \(_, tr) -> do describe "Miscellaneous CLI tests" $ parallel (MiscellaneousCLI.spec @t) describe "Launcher CLI tests" $ parallel (LauncherCLI.spec @t) describe "Stake Pool Metrics" MetricsSpec.spec + describe "Key CLI tests" KeysCLI.spec describe "API Specifications" $ specWithServer tr $ do Addresses.spec diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Keys.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Keys.hs new file mode 100644 index 00000000000..2d6079866f2 --- /dev/null +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Keys.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Test.Integration.Jormungandr.Scenario.CLI.Keys + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (..) + , Passphrase (..) + , SomeMnemonic (..) + , WalletKey (..) + , XPrv + , hex + , unXPrv + , unXPrvStripPub + ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Shelley + ( ShelleyKey ) +import Cardano.Wallet.Primitive.Mnemonic + ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic ) +import Cardano.Wallet.Unsafe + ( unsafeMkEntropy ) +import Data.Proxy + ( Proxy (..) ) +import GHC.TypeLits + ( natVal ) +import System.Process + ( readProcessWithExitCode ) +import Test.Hspec + ( Spec, describe, it ) +import Test.QuickCheck + ( Arbitrary (..) + , Gen + , Property + , counterexample + , frequency + , property + , vectorOf + ) +import Test.QuickCheck.Monadic + ( assert, monadicIO, monitor, run ) + +import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron +import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus +import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 + +spec :: Spec +spec = + describe "unXPrvStripPub" $ do + it "is compatible with jcli (Shelley)" $ + property $ prop_keyToHexTextJcliCompatible @ShelleyKey + it "is compatible with jcli (Icarus)" $ + property $ prop_keyToHexTextJcliCompatible @IcarusKey + it "is compatible with jcli (Byron)" $ + property $ prop_keyToHexTextJcliCompatible @ByronKey + +prop_keyToHexTextJcliCompatible + :: WalletKey k + => k 'RootK XPrv + -> Property +prop_keyToHexTextJcliCompatible k = monadicIO $ do + let Right hexXPrv = fmap (B8.unpack . hex) . unXPrvStripPub . getRawKey $ k + monitor (counterexample $ "\nkey bytes = " ++ hexXPrv) + (code, stdout, stderr) <- run $ jcliKeyFromHex hexXPrv + monitor (counterexample $ "\n" ++ show code) + monitor (counterexample $ "Stdout: " ++ show stdout) + monitor (counterexample $ "Stderr: " ++ show stderr) + assert (stderr == "") + where + jcliKeyFromHex = readProcessWithExitCode + "jcli" + ["key", "from-bytes", "--type", "ed25519bip32"] + +instance Arbitrary (ShelleyKey 'RootK XPrv) where + shrink _ = [] + arbitrary = do + s <- SomeMnemonic <$> genMnemonic @15 + g <- fmap SomeMnemonic <$> genSecondFactor + return $ Shelley.unsafeGenerateKeyFromSeed (s, g) encryptionPass + where + encryptionPass = Passphrase "" + genSecondFactor = frequency + [ (30, return Nothing) + , (70, Just <$> genMnemonic @12) + ] + +instance Arbitrary (ByronKey 'RootK XPrv) where + shrink _ = [] + arbitrary = Byron.unsafeGenerateKeyFromSeed () + <$> (SomeMnemonic <$> genMnemonic @12) + <*> (pure mempty) + +instance Arbitrary (IcarusKey 'RootK XPrv) where + shrink _ = [] + arbitrary = Icarus.unsafeGenerateKeyFromSeed + <$> (SomeMnemonic <$> genMnemonic @12) + <*> (pure mempty) + +instance Show XPrv where + show = show . unXPrv + +instance Eq XPrv where + a == b = unXPrv a == unXPrv b + +-- | Generates an arbitrary mnemonic of a size according to the type parameter. +-- +-- E.g: +-- >>> arbitrary = SomeMnemonic <$> genMnemonic @12 +-- +-- NOTE: Duplicated with "Cardano.Wallet.Gen". +genMnemonic + :: forall mw ent csz. + ( ConsistentEntropy ent mw csz + , EntropySize mw ~ ent + ) + => Gen (Mnemonic mw) +genMnemonic = do + let n = fromIntegral (natVal $ Proxy @(EntropySize mw)) `div` 8 + bytes <- BS.pack <$> vectorOf n arbitrary + let ent = unsafeMkEntropy @(EntropySize mw) bytes + return $ entropyToMnemonic ent diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs index be42d688b1c..8f17cb1c402 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs @@ -110,6 +110,7 @@ spec = do ] (pure ()) Inherit + Inherit void $ withBackendProcess nullTracer cmd $ do expectPathEventuallyExist d expectPathEventuallyExist (d "chain") @@ -128,6 +129,7 @@ spec = do ] (pure ()) Inherit + Inherit void $ withBackendProcess nullTracer cmd $ do expectPathEventuallyExist dir expectPathEventuallyExist (dir "chain") diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs index 33164f8f44a..fe2463f6989 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs @@ -14,7 +14,12 @@ import Cardano.BM.Trace import Cardano.CLI ( Port (..) ) import Cardano.Launcher - ( Command (..), StdStream (..), withBackendProcess ) + ( Command (..) + , ProcessHasExited (..) + , StdStream (..) + , withBackendProcess + , withBackendProcessHandle + ) import Control.Concurrent ( threadDelay ) import Control.Exception @@ -25,6 +30,8 @@ import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Generics.Product.Typed ( typed ) +import Data.Text + ( Text ) import System.Command ( Exit (..), Stderr (..), Stdout (..) ) import System.Exit @@ -113,9 +120,6 @@ spec = do waitForProcess ph `shouldReturn` ExitSuccess describe "LOGGING - cardano-wallet serve logging [SERIAL]" $ do - let grep str = filter (T.isInfixOf str) - grepNot str = filter (not . T.isInfixOf str) - it "LOGGING - Serve default logs Info" $ \ctx -> do withTempFile $ \logs hLogs -> do let cmd = Command @@ -126,12 +130,13 @@ spec = do , "--genesis-block-hash", block0H ] (pure ()) + Inherit (UseHandle hLogs) void $ withBackendProcess nullTracer cmd $ do threadDelay (10 * oneSecond) hClose hLogs logged <- T.lines <$> TIO.readFile logs - let loggedNotMain = grepNot "cardano-wallet.main:Debug" logged + let loggedNotMain = grepNot "cardano-wallet.main:" logged grep "Debug" loggedNotMain `shouldBe` [] grep "Info" loggedNotMain `shouldNotBe` [] @@ -146,6 +151,7 @@ spec = do , "--trace-pools-db", "debug" ] (pure ()) + Inherit (UseHandle hLogs) void $ withBackendProcess nullTracer cmd $ do threadDelay (5 * oneSecond) @@ -153,7 +159,7 @@ spec = do logged <- T.lines <$> TIO.readFile logs let poolsDebugLogs = grep "cardano-wallet.pools-db:Debug" logged let netDebugLogs = grep "cardano-wallet.network:Debug" logged - length poolsDebugLogs `shouldNotBe` 0 + length poolsDebugLogs `shouldBe` 0 length netDebugLogs `shouldBe` 0 it "LOGGING - Serve disable logs for one component" $ \ctx -> do @@ -167,6 +173,7 @@ spec = do , "--trace-network", "off" ] (pure ()) + Inherit (UseHandle hLogs) void $ withBackendProcess nullTracer cmd $ do threadDelay (5 * oneSecond) @@ -194,6 +201,7 @@ spec = do , "--genesis-block-hash", block0H ] (pure ()) + Inherit (UseHandle hLogs) void $ withBackendProcess nullTracer cmd $ do threadDelay (10 * oneSecond) @@ -237,6 +245,32 @@ spec = do "Invalid genesis hash: expecting a hex-encoded \ \value that is 32 bytes in length" + describe "SERVER - Clean shutdown" $ do + it "SERVER - shuts down on command" $ \ctx -> do + logged <- withLogCollection $ \stream -> do + let cmd = Command + (commandName @t) + ["serve" + , "--node-port", show (ctx ^. typed @(Port "node")) + , "--random-port" + , "--genesis-block-hash", block0H + ] + (pure ()) + CreatePipe + stream + + res <- withBackendProcessHandle nullTracer cmd $ \(Just hStdin) _ -> do + threadDelay oneSecond + hClose hStdin + threadDelay oneSecond -- give handler a chance to run + + res `shouldBe` Left (ProcessHasExited "cardano-wallet-jormungandr" ExitSuccess) + + let enabledLogs = grep "shutdown handler is enabled" logged + let shutdownLogs = grep "Starting clean shutdown" logged + length enabledLogs `shouldBe` 1 + length shutdownLogs `shouldBe` 1 + oneSecond :: Int oneSecond = 1000000 @@ -245,3 +279,15 @@ withTempDir = withSystemTempDirectory "integration-state" withTempFile :: (FilePath -> Handle -> IO a) -> IO a withTempFile = withSystemTempFile "temp-file" + +withLogCollection :: (StdStream -> IO a) -> IO [Text] +withLogCollection action = withTempFile $ \logs hLogs -> do + _ <- action (UseHandle hLogs) + hClose hLogs + T.lines <$> TIO.readFile logs + +grep :: Text -> [Text] -> [Text] +grep str = filter (T.isInfixOf str) + +grepNot :: Text -> [Text] -> [Text] +grepNot str = filter (not . T.isInfixOf str) diff --git a/lib/jormungandr/test/integration/js/mock-daedalus.js b/lib/jormungandr/test/integration/js/mock-daedalus.js index 66ffe3b901a..8f88c4bd8ca 100755 --- a/lib/jormungandr/test/integration/js/mock-daedalus.js +++ b/lib/jormungandr/test/integration/js/mock-daedalus.js @@ -27,19 +27,34 @@ function main() { console.log("JS: i did not expect that"); process.exit(5); } else if (msg.ReplyPort) { - http.get({ - hostname: "localhost", - port: msg.ReplyPort, - path: "/v2/wallets", - agent: false - }, (res) => { - console.log("JS: response from wallet: " + res.statusCode); - res.resume(); - res.on("end", () => { - console.log("JS: request response from wallet finished, disconnecting."); - proc.disconnect(); - }); - }); + let action = $onError => http.get({ + hostname: "localhost", + port: msg.ReplyPort, + path: "/v2/wallets", + agent: false + }, (res) => { + console.log("JS: response from wallet: " + res.statusCode); + res.resume(); + res.on("end", () => { + console.log("JS: request response from wallet finished, disconnecting."); + proc.disconnect(); + }); + }).on("error", $onError); + + let retryOnce = err => { + if (err.code != 'ECONNREFUSED') { + console.log("JS:", err); + process.exit(1); + } else { + console.log("JS: Connection refused. Retrying once in a bit..."); + setTimeout(() => action(err => { + console.log("JS:", err); + process.exit(1); + }), 500); + } + }; + + action(retryOnce); } }); }, @@ -49,19 +64,34 @@ function main() { proc.on("message", function(msg) { console.log("JS: message received", msg); if (msg.ReplyPort) { - http.get({ - hostname: "localhost", - port: msg.ReplyPort, - path: "/v2/wallets", - agent: false - }, (res) => { - console.log("JS: response from wallet: " + res.statusCode); - res.resume(); - res.on("end", () => { - console.log("JS: request response from wallet finished, disconnecting."); - proc.disconnect(); - }); - }); + let action = $onError => http.get({ + hostname: "localhost", + port: msg.ReplyPort, + path: "/v2/wallets", + agent: false + }, (res) => { + console.log("JS: response from wallet: " + res.statusCode); + res.resume(); + res.on("end", () => { + console.log("JS: request response from wallet finished, disconnecting."); + proc.disconnect(); + }); + }).on("error", $onError); + + let retryOnce = err => { + if (err.code != 'ECONNREFUSED') { + console.log("JS:", err); + process.exit(1); + } else { + console.log("JS: Connection refused. Retrying once in a bit..."); + setTimeout(() => action(err => { + console.log("JS:", err); + process.exit(1); + }), 500); + } + }; + + action(retryOnce); } }); } diff --git a/lib/jormungandr/test/migration/migration-test.hs b/lib/jormungandr/test/migration/migration-test.hs index 91c3603fd0c..ebd220b4f35 100644 --- a/lib/jormungandr/test/migration/migration-test.hs +++ b/lib/jormungandr/test/migration/migration-test.hs @@ -97,7 +97,7 @@ testMain -> IO ExitCode testMain tr serverPort testAction launchArgs = do let apiBase = mkApiBase serverPort - let cmd = Command "cardano-wallet-jormungandr" launchArgs (pure ()) Inherit + let cmd = Command "cardano-wallet-jormungandr" launchArgs (pure ()) Inherit Inherit res <- withBackendProcess (trMessageText tr) cmd $ do waitForWalletServer serverPort testAction tr apiBase diff --git a/lib/launcher/cardano-wallet-launcher.cabal b/lib/launcher/cardano-wallet-launcher.cabal index 021905945cc..60376f5d5a1 100644 --- a/lib/launcher/cardano-wallet-launcher.cabal +++ b/lib/launcher/cardano-wallet-launcher.cabal @@ -32,8 +32,10 @@ library base , aeson , async + , bytestring , code-page , contra-tracer + , extra , fmt , iohk-monitoring , process @@ -43,13 +45,14 @@ library src exposed-modules: Cardano.Launcher + , Cardano.Startup if os(windows) build-depends: Win32 - other-modules: Cardano.Launcher.Windows + other-modules: Cardano.Startup.Windows cpp-options: -DWINDOWS else build-depends: unix - other-modules: Cardano.Launcher.POSIX + other-modules: Cardano.Startup.POSIX test-suite unit default-language: @@ -68,6 +71,7 @@ test-suite unit build-depends: base , async + , bytestring , cardano-wallet-launcher , cardano-wallet-test-utils , contra-tracer @@ -89,3 +93,4 @@ test-suite unit Main.hs other-modules: Cardano.LauncherSpec + , Cardano.StartupSpec diff --git a/lib/launcher/src/Cardano/Launcher.hs b/lib/launcher/src/Cardano/Launcher.hs index 43216a9b8a0..e524ed5ad1e 100644 --- a/lib/launcher/src/Cardano/Launcher.hs +++ b/lib/launcher/src/Cardano/Launcher.hs @@ -17,10 +17,6 @@ module Cardano.Launcher , withBackendProcess , withBackendProcessHandle - -- * Program startup - , installSignalHandlers - , withUtf8Encoding - -- * Logging , LauncherLog(..) ) where @@ -67,9 +63,7 @@ import GHC.Generics import System.Exit ( ExitCode (..) ) import System.IO - ( hSetEncoding, mkTextEncoding, stderr, stdin, stdout ) -import System.IO.CodePage - ( withCP65001 ) + ( Handle ) import System.Process ( CreateProcess (..) , ProcessHandle @@ -80,14 +74,6 @@ import System.Process , withCreateProcess ) -#ifdef WINDOWS -import Cardano.Launcher.Windows - ( installSignalHandlers ) -#else -import Cardano.Launcher.POSIX - ( installSignalHandlers ) -#endif - import qualified Data.Text as T -- | Represent a command to execute. Args are provided as a list where options @@ -100,12 +86,15 @@ import qualified Data.Text as T -- , "--network", "mainnet" -- ] (return ()) -- Inherit +-- Inherit -- @ data Command = Command { cmdName :: String , cmdArgs :: [String] , cmdSetup :: IO () -- ^ An extra action to run _before_ the command + , cmdInput :: StdStream + -- ^ Input to supply to command , cmdOutput :: StdStream -- ^ What to do with stdout & stderr } deriving (Generic) @@ -125,7 +114,7 @@ instance Eq Command where -- --port 8080 -- --network mainnet instance Buildable Command where - build (Command name args _ _) = build name + build (Command name args _ _ _) = build name <> "\n" <> indentF 4 (blockListF' "" build $ snd $ foldl buildOptions ("", []) args) @@ -160,24 +149,25 @@ withBackendProcess -> IO a -- ^ Action to execute while process is running. -> IO (Either ProcessHasExited a) -withBackendProcess tr cmd = withBackendProcessHandle tr cmd . const +withBackendProcess tr cmd = withBackendProcessHandle tr cmd . const . const --- | A variant of 'withBackendProcess' which also provides the 'ProcessHandle' to the --- given action. +-- | A variant of 'withBackendProcess' which also provides the 'ProcessHandle' +-- and stdin 'Handle' to the given action. withBackendProcessHandle :: Tracer IO LauncherLog -- ^ Logging -> Command -- ^ 'Command' description - -> (ProcessHandle -> IO a) + -> (Maybe Handle -> ProcessHandle -> IO a) -- ^ Action to execute while process is running. -> IO (Either ProcessHasExited a) -withBackendProcessHandle tr cmd@(Command name args before output) action = do +withBackendProcessHandle tr cmd@(Command name args before input output) action = do before traceWith tr $ MsgLauncherStart cmd - let process = (proc name args) { std_out = output, std_err = output } + let process = (proc name args) + { std_in = input, std_out = output, std_err = output } res <- fmap join $ tryJust spawnPredicate $ - withCreateProcess process $ \_ _ _ h -> do + withCreateProcess process $ \mstdin _ _ h -> do pid <- maybe "-" (T.pack . show) <$> getPid h let tr' = contramap (WithProcessInfo name pid) tr traceWith tr' MsgLauncherStarted @@ -186,7 +176,7 @@ withBackendProcessHandle tr cmd@(Command name args before output) action = do ProcessHasExited name <$> interruptibleWaitForProcess tr' h let runAction = do traceWith tr' MsgLauncherAction - action h `finally` traceWith tr' MsgLauncherCleanup + action mstdin h `finally` traceWith tr' MsgLauncherCleanup race waitForExit runAction either (traceWith tr . MsgLauncherFinish) (const $ pure ()) res @@ -242,7 +232,7 @@ data LaunchedProcessLog deriving (Show, Eq, Generic, ToJSON) instance ToJSON Command where - toJSON (Command name args _ _) = toJSON (name:args) + toJSON (Command name args _ _ _) = toJSON (name:args) instance ToJSON ProcessHasExited where toJSON (ProcessDidNotStart name e) = @@ -294,20 +284,3 @@ launchedProcessText (MsgLauncherWaitAfter status) = "waitForProcess returned "+| launchedProcessText MsgLauncherCancel = "There was an exception waiting for the process" launchedProcessText MsgLauncherAction = "Running withBackend action" launchedProcessText 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. -withUtf8Encoding :: IO a -> IO a -withUtf8Encoding action = withCP65001 (setUtf8EncodingHandles >> action) - -setUtf8EncodingHandles :: IO () -setUtf8EncodingHandles = do - utf8' <- mkTextEncoding "UTF-8//TRANSLIT" - mapM_ (`hSetEncoding` utf8') [stdin, stdout, stderr] diff --git a/lib/launcher/src/Cardano/Startup.hs b/lib/launcher/src/Cardano/Startup.hs new file mode 100644 index 00000000000..3bbfba3731f --- /dev/null +++ b/lib/launcher/src/Cardano/Startup.hs @@ -0,0 +1,146 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Copyright: © 2018-2020 IOHK +-- License: Apache-2.0 +-- +-- This module contains functions relating to startup and shutdown of the +-- @cardano-wallet serve@ program. + +module Cardano.Startup + ( + -- * Program startup + withUtf8Encoding + + -- * Clean shutdown + , withShutdownHandler + , withShutdownHandler' + , installSignalHandlers + + -- * Logging + , ShutdownHandlerLog(..) + ) where + +import Prelude + +import Cardano.BM.Data.Severity + ( Severity (..) ) +import Cardano.BM.Data.Tracer + ( DefinePrivacyAnnotation (..), DefineSeverity (..) ) +import Control.Concurrent.Async + ( race ) +import Control.Exception + ( IOException, handle ) +import Control.Tracer + ( Tracer, traceWith ) +import Data.Either.Extra + ( eitherToMaybe ) +import Data.Text.Class + ( ToText (..) ) +import System.IO + ( Handle + , hIsOpen + , hSetEncoding + , mkTextEncoding + , stderr + , stderr + , stdin + , stdin + , stdout + , stdout + ) +import System.IO.CodePage + ( withCP65001 ) + +#ifdef WINDOWS +import Cardano.Startup.Windows + ( installSignalHandlers ) +#else +import Cardano.Startup.POSIX + ( installSignalHandlers ) +#endif + +import qualified Data.ByteString as BS +import qualified Data.Text as T + + +{------------------------------------------------------------------------------- + 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. +withUtf8Encoding :: IO a -> IO a +withUtf8Encoding action = withCP65001 (setUtf8EncodingHandles >> action) + +setUtf8EncodingHandles :: IO () +setUtf8EncodingHandles = do + utf8' <- mkTextEncoding "UTF-8//TRANSLIT" + mapM_ (`hSetEncoding` utf8') [stdin, stdout, stderr] + +{------------------------------------------------------------------------------- + Shutdown handlers +-------------------------------------------------------------------------------} + +-- | Runs the given action with a cross-platform clean shutdown handler. +-- +-- This is necessary when running cardano-wallet as a subprocess of Daedalus. +-- For more details, see +-- +-- +-- It works simply by reading from 'stdin', which is otherwise unused by the API +-- server. Once end-of-file is reached, it cancels the action, causing the +-- program to shut down. +-- +-- So, when running @cardano-wallet@ as a subprocess, the parent process should +-- pass a pipe for 'stdin', then close the pipe when it wants @cardano-wallet@ +-- to shut down. +-- +-- TODO: may need to add 'forkIO' if 'hGet' blocks on windows +withShutdownHandler :: Tracer IO ShutdownHandlerLog -> IO a -> IO (Maybe a) +withShutdownHandler tr = withShutdownHandler' tr stdin + +-- | A variant of 'withShutdownHandler' where the handle to read can be chosen. +withShutdownHandler' :: Tracer IO ShutdownHandlerLog -> Handle -> IO a -> IO (Maybe a) +withShutdownHandler' tr h action = do + enabled <- hIsOpen h + traceWith tr $ MsgShutdownHandler enabled + let with + | enabled = fmap eitherToMaybe . race readerLoop + | otherwise = fmap Just + with action + where + readerLoop = do + handle (traceWith tr . MsgShutdownError) readerLoop' + traceWith tr MsgShutdownEOF + readerLoop' = BS.hGet h 1000 >>= \case + "" -> pure () -- EOF + _ -> readerLoop + +data ShutdownHandlerLog + = MsgShutdownHandler Bool + | MsgShutdownEOF + | MsgShutdownError IOException + deriving (Show, Eq) + +instance ToText ShutdownHandlerLog where + toText = \case + MsgShutdownHandler enabled -> + "Cross-platform subprocess shutdown handler is " + <> if enabled then "enabled." else "disabled." + MsgShutdownEOF -> + "Starting clean shutdown..." + MsgShutdownError e -> + "Error waiting for shutdown: " <> T.pack (show e) + <> ". Shutting down..." + +instance DefinePrivacyAnnotation ShutdownHandlerLog +instance DefineSeverity ShutdownHandlerLog where + defineSeverity = \case + MsgShutdownHandler _ -> Debug + MsgShutdownEOF -> Notice + MsgShutdownError _ -> Error diff --git a/lib/launcher/src/Cardano/Launcher/POSIX.hs b/lib/launcher/src/Cardano/Startup/POSIX.hs similarity index 95% rename from lib/launcher/src/Cardano/Launcher/POSIX.hs rename to lib/launcher/src/Cardano/Startup/POSIX.hs index 0b3f7e79ba6..737b110cfc8 100644 --- a/lib/launcher/src/Cardano/Launcher/POSIX.hs +++ b/lib/launcher/src/Cardano/Startup/POSIX.hs @@ -4,7 +4,7 @@ -- Portability: POSIX -- -module Cardano.Launcher.POSIX +module Cardano.Startup.POSIX ( installSignalHandlers ) where diff --git a/lib/launcher/src/Cardano/Launcher/Windows.hs b/lib/launcher/src/Cardano/Startup/Windows.hs similarity index 88% rename from lib/launcher/src/Cardano/Launcher/Windows.hs rename to lib/launcher/src/Cardano/Startup/Windows.hs index 66543880a6f..35c46d1ea58 100644 --- a/lib/launcher/src/Cardano/Launcher/Windows.hs +++ b/lib/launcher/src/Cardano/Startup/Windows.hs @@ -4,7 +4,7 @@ -- Portability: Windows -- -module Cardano.Launcher.Windows +module Cardano.Startup.Windows ( installSignalHandlers ) where diff --git a/lib/launcher/test/unit/Cardano/LauncherSpec.hs b/lib/launcher/test/unit/Cardano/LauncherSpec.hs index cec502c6d94..3301bee9c50 100644 --- a/lib/launcher/test/unit/Cardano/LauncherSpec.hs +++ b/lib/launcher/test/unit/Cardano/LauncherSpec.hs @@ -91,6 +91,7 @@ spec = beforeAll setupMockCommands $ do , "--template", "mainnet" ] (pure ()) Inherit + Inherit pretty @_ @Text command `shouldBe` "server\n\ @@ -151,7 +152,7 @@ spec = beforeAll setupMockCommands $ do it "Handles command not found" $ \MockCommands{..} -> withTestLogging $ \tr -> do let commands = - [ Command "foobar" [] (pure ()) Inherit + [ Command "foobar" [] (pure ()) Inherit Inherit ] (phs, ProcessDidNotStart name _exc) <- launch tr commands name `shouldBe` "foobar" @@ -159,7 +160,7 @@ spec = beforeAll setupMockCommands $ do it "Backend process is terminated when Async thread is cancelled" $ \MockCommands{..} -> withTestLogging $ \tr -> do mvar <- newEmptyMVar - let backend = withBackendProcessHandle tr foreverCommand $ \ph -> do + let backend = withBackendProcessHandle tr foreverCommand $ \_ ph -> do putMVar mvar ph forever $ threadDelay maxBound before <- getCurrentTime @@ -189,20 +190,20 @@ setupMockCommands mockCommandsShell = MockCommands { mockCommand = \success before -> let exitStatus = if success then 0 else 1 :: Int - in Command "sh" ["-c", "sleep 1; exit " ++ show exitStatus] before Inherit - , foreverCommand = Command "sleep" ["20"] (pure ()) Inherit + in Command "sh" ["-c", "sleep 1; exit " ++ show exitStatus] before Inherit Inherit + , foreverCommand = Command "sleep" ["20"] (pure ()) Inherit Inherit } setupWin False = MockCommands { mockCommand = \success before -> if success - then Command "TIMEOUT" ["1"] before Inherit - else Command "CHOICE" ["/T", "1", "/C", "wat", "/D", "w"] before Inherit - , foreverCommand = Command "TIMEOUT" ["20"] (pure ()) Inherit + then Command "TIMEOUT" ["1"] before Inherit Inherit + else Command "CHOICE" ["/T", "1", "/C", "wat", "/D", "w"] before Inherit Inherit + , foreverCommand = Command "TIMEOUT" ["20"] (pure ()) Inherit Inherit } setupWin True = MockCommands { mockCommand = \success before -> if success - then Command "PING" ["/n", "1", "/w", "1000", "127.0.0.1"] before Inherit - else Command "START" ["/wait", "xyzzy"] before Inherit - , foreverCommand = Command "PING" ["/n", "20", "/w", "1000", "127.0.0.1"] (pure ()) Inherit + then Command "PING" ["/n", "1", "/w", "1000", "127.0.0.1"] before Inherit Inherit + else Command "START" ["/wait", "xyzzy"] before Inherit Inherit + , foreverCommand = Command "PING" ["/n", "20", "/w", "1000", "127.0.0.1"] (pure ()) Inherit Inherit } -- | Use the presence of @winepath.exe@ to detect when running tests under Wine. @@ -218,7 +219,7 @@ launch :: Tracer IO LauncherLog -> [Command] -> IO ([ProcessHandle], ProcessHasE launch tr cmds = do phsVar <- newMVar [] let - waitForOthers ph = do + waitForOthers _ ph = do modifyMVar_ phsVar (pure . (ph:)) forever $ threadDelay maxBound start = async . flip (withBackendProcessHandle tr) waitForOthers diff --git a/lib/launcher/test/unit/Cardano/StartupSpec.hs b/lib/launcher/test/unit/Cardano/StartupSpec.hs new file mode 100644 index 00000000000..27756006069 --- /dev/null +++ b/lib/launcher/test/unit/Cardano/StartupSpec.hs @@ -0,0 +1,112 @@ +-- | +-- Copyright: © 2018-2020 IOHK +-- License: Apache-2.0 +-- +-- Unit tests for 'withShutdownHandler' using pipes within a single process. + +module Cardano.StartupSpec + ( spec + ) where + +import Prelude + +import Cardano.Startup + ( ShutdownHandlerLog (..), withShutdownHandler' ) +import Control.Concurrent + ( threadDelay ) +import Control.Concurrent.Async + ( race ) +import Control.Exception + ( bracket, throwIO ) +import Control.Tracer + ( Tracer, nullTracer ) +import qualified Data.ByteString as BS +import System.IO + ( Handle, IOMode (..), hClose, stdin, withFile ) +import System.IO.Error + ( isUserError ) +import System.Process + ( createPipe ) +import Test.Hspec + ( Spec, describe, it, shouldBe, shouldContain, shouldReturn, shouldThrow ) +import Test.Utils.Trace + ( captureLogging ) +import Test.Utils.Windows + ( nullFileName ) + +spec :: Spec +spec = describe "withShutdownHandler" $ do + let decisecond = 100000 + + describe "sanity tests" $ do + it "race stdin" $ do + res <- race (BS.hGet stdin 1000) (threadDelay decisecond) + res `shouldBe` Right () + + it "race pipe" $ withPipe $ \(a, _) -> do + res <- race (BS.hGet a 1000) (threadDelay decisecond) + res `shouldBe` Right () + + it "action completes immediately" $ withPipe $ \(a, _) -> do + logs <- captureLogging' $ \tr -> do + withShutdownHandler' tr a (pure ()) + `shouldReturn` Just () + logs `shouldContain` [MsgShutdownHandler True] + + it "action completes with delay" $ withPipe $ \(a, _) -> do + res <- withShutdownHandler' nullTracer a $ do + threadDelay decisecond + pure () + res `shouldBe` Just () + + it "handle is closed immediately" $ withPipe $ \(a, b) -> do + logs <- captureLogging' $ \tr -> do + res <- withShutdownHandler' tr a $ do + hClose b + threadDelay decisecond -- give handler a chance to run + pure () + res `shouldBe` Nothing + logs `shouldContain` [MsgShutdownEOF] + + it "handle is closed with delay" $ withPipe $ \(a, b) -> do + res <- withShutdownHandler' nullTracer a $ do + threadDelay decisecond + hClose b + threadDelay decisecond -- give handler a chance to run + pure () + res `shouldBe` Nothing + + it "action throws exception" $ withPipe $ \(a, _) -> do + let bomb = userError "bomb" + logs <- captureLogging' $ \tr -> do + withShutdownHandler' tr a (throwIO bomb) + `shouldThrow` isUserError + logs `shouldBe` [MsgShutdownHandler True] + + it ("handle is " ++ nullFileName ++ " (immediate EOF)") $ do + logs <- captureLogging' $ \tr -> + withFile nullFileName ReadMode $ \h -> do + res <- withShutdownHandler' tr h $ do + threadDelay decisecond -- give handler a chance to run + pure () + res `shouldBe` Nothing + logs `shouldContain` [MsgShutdownEOF] + + it "handle is already closed" $ withPipe $ \(a, b) -> do + hClose a + hClose b + logs <- captureLogging' $ \tr -> do + res <- withShutdownHandler' tr a $ do + threadDelay decisecond + hClose b + threadDelay decisecond -- give handler a chance to run + pure () + res `shouldBe` Just () + logs `shouldContain` [MsgShutdownHandler False] + +withPipe :: ((Handle, Handle) -> IO a) -> IO a +withPipe = bracket createPipe closePipe + where closePipe (a, b) = hClose a >> hClose b + +captureLogging' :: (Tracer IO msg -> IO a) -> IO [msg] +captureLogging' = fmap fst . captureLogging diff --git a/lib/test-utils/src/Test/Utils/Windows.hs b/lib/test-utils/src/Test/Utils/Windows.hs index 920b4d986c3..7c491d96b2f 100644 --- a/lib/test-utils/src/Test/Utils/Windows.hs +++ b/lib/test-utils/src/Test/Utils/Windows.hs @@ -11,6 +11,7 @@ module Test.Utils.Windows , pendingOnWindows , whenWindows , isWindows + , nullFileName ) where import Prelude @@ -37,3 +38,6 @@ whenWindows = when isWindows isWindows :: Bool isWindows = os == "mingw32" + +nullFileName :: FilePath +nullFileName = if isWindows then "NUL" else "/dev/null" diff --git a/nix/.stack.nix/cardano-wallet-byron.nix b/nix/.stack.nix/cardano-wallet-byron.nix index 187854b1d6e..bf6ff8dfcc7 100644 --- a/nix/.stack.nix/cardano-wallet-byron.nix +++ b/nix/.stack.nix/cardano-wallet-byron.nix @@ -65,7 +65,6 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) (hsPkgs."cardano-wallet-core" or (buildDepError "cardano-wallet-core")) - (hsPkgs."cardano-wallet-launcher" or (buildDepError "cardano-wallet-launcher")) (hsPkgs."cborg" or (buildDepError "cborg")) (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) (hsPkgs."cryptonite" or (buildDepError "cryptonite")) @@ -98,6 +97,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: (hsPkgs."cardano-wallet-cli" or (buildDepError "cardano-wallet-cli")) (hsPkgs."cardano-wallet-core" or (buildDepError "cardano-wallet-core")) (hsPkgs."cardano-wallet-launcher" or (buildDepError "cardano-wallet-launcher")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) (hsPkgs."iohk-monitoring" or (buildDepError "iohk-monitoring")) (hsPkgs."network" or (buildDepError "network")) (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) diff --git a/nix/.stack.nix/cardano-wallet-cli.nix b/nix/.stack.nix/cardano-wallet-cli.nix index 688a76c21d2..f630896faf9 100644 --- a/nix/.stack.nix/cardano-wallet-cli.nix +++ b/nix/.stack.nix/cardano-wallet-cli.nix @@ -72,6 +72,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: (hsPkgs."fmt" or (buildDepError "fmt")) (hsPkgs."http-client" or (buildDepError "http-client")) (hsPkgs."iohk-monitoring" or (buildDepError "iohk-monitoring")) + (hsPkgs."memory" or (buildDepError "memory")) (hsPkgs."servant-client" or (buildDepError "servant-client")) (hsPkgs."servant-client-core" or (buildDepError "servant-client-core")) (hsPkgs."text" or (buildDepError "text")) @@ -84,12 +85,14 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: "unit" = { depends = [ (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) (hsPkgs."cardano-wallet-cli" or (buildDepError "cardano-wallet-cli")) (hsPkgs."cardano-wallet-core" or (buildDepError "cardano-wallet-core")) (hsPkgs."filepath" or (buildDepError "filepath")) (hsPkgs."hspec" or (buildDepError "hspec")) (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."silently" or (buildDepError "silently")) (hsPkgs."temporary" or (buildDepError "temporary")) (hsPkgs."text" or (buildDepError "text")) (hsPkgs."text-class" or (buildDepError "text-class")) diff --git a/nix/.stack.nix/cardano-wallet-jormungandr.nix b/nix/.stack.nix/cardano-wallet-jormungandr.nix index 5874ee416fb..8e1f08b88b3 100644 --- a/nix/.stack.nix/cardano-wallet-jormungandr.nix +++ b/nix/.stack.nix/cardano-wallet-jormungandr.nix @@ -106,6 +106,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: (hsPkgs."cardano-wallet-core" or (buildDepError "cardano-wallet-core")) (hsPkgs."cardano-wallet-jormungandr" or (buildDepError "cardano-wallet-jormungandr")) (hsPkgs."cardano-wallet-launcher" or (buildDepError "cardano-wallet-launcher")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) (hsPkgs."filepath" or (buildDepError "filepath")) (hsPkgs."iohk-monitoring" or (buildDepError "iohk-monitoring")) (hsPkgs."network" or (buildDepError "network")) diff --git a/nix/.stack.nix/cardano-wallet-launcher.nix b/nix/.stack.nix/cardano-wallet-launcher.nix index d93cda82b49..802d3ddee0a 100644 --- a/nix/.stack.nix/cardano-wallet-launcher.nix +++ b/nix/.stack.nix/cardano-wallet-launcher.nix @@ -60,8 +60,10 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: (hsPkgs."base" or (buildDepError "base")) (hsPkgs."aeson" or (buildDepError "aeson")) (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) (hsPkgs."code-page" or (buildDepError "code-page")) (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."extra" or (buildDepError "extra")) (hsPkgs."fmt" or (buildDepError "fmt")) (hsPkgs."iohk-monitoring" or (buildDepError "iohk-monitoring")) (hsPkgs."process" or (buildDepError "process")) @@ -77,6 +79,7 @@ in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: depends = [ (hsPkgs."base" or (buildDepError "base")) (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) (hsPkgs."cardano-wallet-launcher" or (buildDepError "cardano-wallet-launcher")) (hsPkgs."cardano-wallet-test-utils" or (buildDepError "cardano-wallet-test-utils")) (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) diff --git a/release.nix b/release.nix index bc625dc0b2e..6b48f7db83f 100644 --- a/release.nix +++ b/release.nix @@ -64,6 +64,30 @@ let (filterAttrs (n: _: n != "dockerImage" && n != "shell") project)); } // { + # This aggregate job is what IOHK Hydra uses to update + # the CI status in GitHub. + required = mkRequiredJob ( + collectTests jobs.native.tests ++ + collectTests jobs.native.benchmarks ++ + [ jobs.native.shell.x86_64-linux + jobs.native.shell.x86_64-darwin + + # jormungandr + jobs.native.cardano-wallet-jormungandr.x86_64-linux + jobs.native.cardano-wallet-jormungandr.x86_64-darwin + jobs.x86_64-pc-mingw32.cardano-wallet-jormungandr.x86_64-linux + + jobs.cardano-wallet-jormungandr-win64 + jobs.cardano-wallet-jormungandr-macos64 + jobs.cardano-wallet-jormungandr-tests-win64 + + + # cardano-node (Byron) + jobs.native.cardano-wallet-byron.x86_64-linux + jobs.native.cardano-wallet-byron.x86_64-darwin + ] + ); + # These derivations are used for the Daedalus installer. daedalus-jormungandr = with jobs; { linux = native.cardano-wallet-jormungandr.x86_64-linux;