diff --git a/cabal.project b/cabal.project index c552e933c72..9a759613ea9 100644 --- a/cabal.project +++ b/cabal.project @@ -1,70 +1,2 @@ packages: lib/*/*.cabal - -package cardano-crypto - tests: False - benchmarks: False - -package contra-tracer - tests: False - benchmarks: False - -package iohk-monitoring - tests: False - benchmarks: False - -package lobemo-backend-aggregation - tests: False - benchmarks: False - -package lobemo-backend-monitoring - tests: False - benchmarks: False - -package ekg-prometheus-adapter - tests: False - benchmarks: False - -package zip - tests: False - benchmarks: False - flags: +disable-bzip2 - -source-repository-package - type: git - location: https://github.com/input-output-hk/cardano-crypto - tag: 3c5db489c71a4d70ee43f5f9b979fcde3c797f2a - -source-repository-package - type: git - location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: b4643defabb23b3d78f4b690a01bb6a41a3cd203 - subdir: contra-tracer - -source-repository-package - type: git - location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: b4643defabb23b3d78f4b690a01bb6a41a3cd203 - subdir: iohk-monitoring - -source-repository-package - type: git - location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: b4643defabb23b3d78f4b690a01bb6a41a3cd203 - subdir: plugins/backend-aggregation - -source-repository-package - type: git - location: https://github.com/input-output-hk/iohk-monitoring-framework - tag: b4643defabb23b3d78f4b690a01bb6a41a3cd203 - subdir: plugins/backend-monitoring - -source-repository-package - type: git - location: https://github.com/CodiePP/ekg-prometheus-adapter - tag: 1a258b6df7d9807d4c4ff3e99722223d31a2c320 - -source-repository-package - type: git - location: https://github.com/mrkkrp/zip - tag: 5a39029cebc9ad5b16ed6a5f2f495714b34b02f8 diff --git a/default.nix b/default.nix index bcbe68175f4..fbcbf8a233a 100644 --- a/default.nix +++ b/default.nix @@ -59,6 +59,7 @@ let cardano-wallet-cli cardano-wallet-core cardano-wallet-core-integration + cardano-wallet-byron cardano-wallet-jormungandr cardano-wallet-launcher cardano-wallet-test-utils diff --git a/lib/byron/cardano-wallet-byron.cabal b/lib/byron/cardano-wallet-byron.cabal new file mode 100644 index 00000000000..68c2640a7f8 --- /dev/null +++ b/lib/byron/cardano-wallet-byron.cabal @@ -0,0 +1,99 @@ +name: cardano-wallet-byron +version: 2020.1.21 +synopsis: Wallet backend protocol-specific bits implemented using byron nodes +description: Please see README.md +homepage: https://github.com/input-output-hk/cardano-wallet +author: IOHK Engineering Team +maintainer: operations@iohk.io +copyright: 2020 IOHK +license: Apache-2.0 +category: Web +build-type: Simple +cabal-version: >=1.10 + +flag development + description: Disable `-Werror` + default: False + manual: True + +library + default-language: + Haskell2010 + default-extensions: + NoImplicitPrelude + OverloadedStrings + ghc-options: + -Wall + -Wcompat + -fwarn-redundant-constraints + if (!flag(development)) + ghc-options: + -Werror + build-depends: + base + , async + , bytestring + , cardano-binary + , cardano-crypto + , cardano-crypto-wrapper + , cardano-ledger + , cardano-wallet-core + , cardano-wallet-launcher + , cborg + , contra-tracer + , cryptonite + , deepseq + , either + , fmt + , io-sim-classes + , iohk-monitoring + , memory + , network + , network-mux + , ouroboros-consensus + , ouroboros-network + , serialise + , text + , text-class + , time + , transformers + , typed-protocols + , typed-protocols-cbor + , warp + hs-source-dirs: + src + exposed-modules: + Cardano.Wallet.Byron + Cardano.Wallet.Byron.Compatibility + Cardano.Wallet.Byron.Network + Cardano.Wallet.Byron.Transaction + Cardano.Wallet.Byron.Transaction.Size + +executable cardano-wallet-byron + default-language: + Haskell2010 + default-extensions: + NoImplicitPrelude + OverloadedStrings + ghc-options: + -threaded -rtsopts + -Wall + -O2 + if (!flag(development)) + ghc-options: + -Werror + build-depends: + base + , cardano-wallet-byron + , cardano-wallet-cli + , cardano-wallet-core + , cardano-wallet-launcher + , iohk-monitoring + , network + , optparse-applicative + , text + , text-class + hs-source-dirs: + exe + main-is: + cardano-wallet-byron.hs diff --git a/lib/byron/exe/cardano-wallet-byron.hs b/lib/byron/exe/cardano-wallet-byron.hs new file mode 100644 index 00000000000..aed231f134a --- /dev/null +++ b/lib/byron/exe/cardano-wallet-byron.hs @@ -0,0 +1,242 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Copyright: © 2018-2020 IOHK +-- License: Apache-2.0 +-- +-- This module parses command line arguments for the wallet and executes +-- corresponding commands. +-- +-- In essence, it's a proxy to the wallet server, which is required for most +-- commands. Commands are turned into corresponding API calls, and submitted +-- to an up-and-running server. Some commands do not require an active server +-- and can be run "offline". + +module Main where + +import Prelude + +import Cardano.BM.Data.Severity + ( Severity (..) ) +import Cardano.BM.Trace + ( Trace, appendName, logDebug, logInfo ) +import Cardano.CLI + ( LoggingOptions (..) + , cli + , cmdAddress + , cmdMnemonic + , cmdNetwork + , cmdTransaction + , cmdVersion + , cmdWallet + , databaseOption + , enableWindowsANSI + , helperTracing + , hostPreferenceOption + , listenOption + , loggingOptions + , loggingSeverityOrOffReader + , optionT + , runCli + , setupDirectory + , syncToleranceOption + , withLogging + ) +import Cardano.Launcher + ( withUtf8Encoding ) +import Cardano.Wallet.Api.Server + ( HostPreference, Listen (..) ) +import Cardano.Wallet.Byron + ( TracerSeverities + , Tracers + , Tracers' (..) + , serveWallet + , setupTracers + , tracerDescriptions + , tracerLabels + ) +import Cardano.Wallet.Byron.Network + ( localSocketAddrInfo ) +import Cardano.Wallet.Logging + ( transformTextTrace ) +import Cardano.Wallet.Primitive.AddressDerivation + ( NetworkDiscriminant (..) ) +import Cardano.Wallet.Primitive.Types + ( SyncTolerance ) +import Cardano.Wallet.Version + ( GitRevision, Version, gitRevision, showFullVersion, version ) +import Control.Applicative + ( Const (..), optional ) +import Data.Text + ( Text ) +import Data.Text.Class + ( ToText (..) ) +import Network.Socket + ( SockAddr ) +import Options.Applicative + ( CommandFields + , Mod + , Parser + , command + , help + , helper + , info + , internal + , long + , metavar + , option + , progDesc + , value + ) +import System.Environment + ( getArgs, getExecutablePath ) +import System.Exit + ( exitWith ) + +import qualified Data.Text as T + +{------------------------------------------------------------------------------- + Main entry point +-------------------------------------------------------------------------------} + +main :: IO () +main = withUtf8Encoding $ do + enableWindowsANSI + runCli $ cli $ mempty + <> cmdServe + <> cmdMnemonic + <> cmdWallet @'Mainnet + <> cmdTransaction @'Mainnet + <> cmdAddress @'Mainnet + <> cmdNetwork @'Mainnet + <> cmdVersion + +beforeMainLoop + :: Trace IO MainLog + -> SockAddr + -> IO () +beforeMainLoop tr = + logInfo tr . MsgListenAddress + +{------------------------------------------------------------------------------- + Command - 'serve' +-------------------------------------------------------------------------------} + +-- | Arguments for the 'serve' command +data ServeArgs = ServeArgs + { _hostPreference :: HostPreference + , _listen :: Listen + , _nodeSocket :: FilePath + , _database :: Maybe FilePath + , _syncTolerance :: SyncTolerance + , _logging :: LoggingOptions TracerSeverities + } deriving (Show, Eq) + +cmdServe + :: Mod CommandFields (IO ()) +cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty + <> progDesc "Serve API that listens for commands/actions." + where + helper' = helperTracing tracerDescriptions + + cmd = fmap exec $ ServeArgs + <$> hostPreferenceOption + <*> listenOption + <*> nodeSocketOption + <*> optional databaseOption + <*> syncToleranceOption + <*> loggingOptions tracerSeveritiesOption + exec + :: ServeArgs + -> IO () + 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) + + whenJust m fn = case m of + Nothing -> pure () + Just a -> fn a + +{------------------------------------------------------------------------------- + Options +-------------------------------------------------------------------------------} + +-- | --node-socket=FILE +nodeSocketOption :: Parser FilePath +nodeSocketOption = optionT $ mempty + <> long "node-socket" + <> metavar "FILE" + <> help "Path to the node's domain socket." + +tracerSeveritiesOption :: Parser TracerSeverities +tracerSeveritiesOption = Tracers + <$> traceOpt applicationTracer (Just Info) + <*> traceOpt apiServerTracer (Just Info) + <*> traceOpt walletEngineTracer (Just Info) + <*> traceOpt walletDbTracer (Just Info) + where + traceOpt field def = fmap Const . option loggingSeverityOrOffReader $ mempty + <> long ("trace-" <> T.unpack (getConst (field tracerLabels))) + <> value def + <> metavar "SEVERITY" + <> internal + +{------------------------------------------------------------------------------- + Logging +-------------------------------------------------------------------------------} + +-- FIXME: reduce duplication. See 'cardano-wallet-jormungandr.hs' + +data MainLog + = MsgCmdLine String [String] + | MsgVersion Version GitRevision + | MsgSetupStateDir Text + | MsgSetupDatabases Text + | MsgServeArgs ServeArgs + | MsgListenAddress SockAddr + deriving (Show, Eq) + +instance ToText MainLog where + toText msg = case msg of + MsgCmdLine exe args -> + T.pack $ unwords ("Command line:":exe:args) + MsgVersion ver rev -> + "Running as v" <> T.pack (showFullVersion ver rev) + MsgSetupStateDir txt -> + "Wallet state: " <> txt + MsgSetupDatabases txt -> + "Wallet databases: " <> txt + MsgServeArgs args -> + T.pack $ show args + MsgListenAddress addr -> + "Wallet backend server listening on " <> T.pack (show addr) + +withTracers + :: LoggingOptions TracerSeverities + -> (Trace IO MainLog -> Tracers IO -> IO a) + -> IO a +withTracers logOpt action = + withLogging Nothing (loggingMinSeverity logOpt) $ \(_, tr) -> do + let trMain = appendName "main" (transformTextTrace tr) + let tracers = setupTracers (loggingTracers logOpt) tr + logInfo trMain $ MsgVersion version gitRevision + logInfo trMain =<< MsgCmdLine <$> getExecutablePath <*> getArgs + action trMain tracers diff --git a/lib/byron/src/Cardano/Wallet/Byron.hs b/lib/byron/src/Cardano/Wallet/Byron.hs new file mode 100644 index 00000000000..6f892885629 --- /dev/null +++ b/lib/byron/src/Cardano/Wallet/Byron.hs @@ -0,0 +1,375 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} + +-- | +-- Copyright: © 2020 IOHK +-- License: Apache-2.0 +-- +-- This module provides the main wallet server function for the Byron-rewrite +-- Haskell node backend. +-- +-- The "Cardano.Wallet.Byron.Network" uses the mini-protocols (ChainSync and +-- TxSubmission) to talk with a core node and synchronize with the network. +-- +-- Functionality specific to this backend for creating transactions is in +-- "Cardano.Wallet.Byron.Transaction" + +module Cardano.Wallet.Byron + ( serveWallet + + -- * Tracing + , Tracers' (..) + , Tracers + , TracerSeverities + , tracerLabels + , tracerDescriptions + , setupTracers + , tracerSeverities + + -- * Logs + , ApplicationLog (..) + ) where + +import Prelude + +import Cardano.BM.Data.Severity + ( Severity (..) ) +import Cardano.BM.Data.Tracer + ( DefinePrivacyAnnotation (..), DefineSeverity (..) ) +import Cardano.BM.Trace + ( Trace, appendName ) +import Cardano.DB.Sqlite + ( DBLog ) +import Cardano.Launcher + ( installSignalHandlers ) +import Cardano.Wallet + ( WalletLog ) +import Cardano.Wallet.Api + ( ApiLayer, ApiV2 ) +import Cardano.Wallet.Api.Server + ( HostPreference, Listen (..), ListenError (..) ) +import Cardano.Wallet.Api.Types + ( DecodeAddress, EncodeAddress ) +import Cardano.Wallet.Byron.Compatibility + ( Byron, ByronBlock, KnownNetwork (..), fromByronBlock ) +import Cardano.Wallet.Byron.Network + ( AddrInfo, newNetworkLayer ) +import Cardano.Wallet.Byron.Transaction + ( newTransactionLayer ) +import Cardano.Wallet.Byron.Transaction.Size + ( WorstSizeOf ) +import Cardano.Wallet.DB.Sqlite + ( DatabasesStartupLog, DefaultFieldValues (..), PersistState ) +import Cardano.Wallet.Logging + ( filterTraceSeverity, trMessageText ) +import Cardano.Wallet.Network + ( NetworkLayer (..) ) +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (..) + , NetworkDiscriminant (..) + , NetworkDiscriminantVal + , PersistPrivateKey + , WalletKey + , networkDiscriminantVal + ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( IsOurs ) +import Cardano.Wallet.Primitive.AddressDiscovery.Random + ( RndState ) +import Cardano.Wallet.Primitive.AddressDiscovery.Sequential + ( SeqState ) +import Cardano.Wallet.Primitive.Types + ( Address + , BlockchainParameters (..) + , ChimericAccount + , SyncTolerance + , WalletId + ) +import Cardano.Wallet.Registry + ( WorkerLog (..) ) +import Cardano.Wallet.Transaction + ( TransactionLayer ) +import Control.Applicative + ( Const (..) ) +import Control.DeepSeq + ( NFData ) +import Control.Tracer + ( Tracer (..), nullTracer, traceWith ) +import Data.Function + ( (&) ) +import Data.Functor + ( ($>) ) +import Data.Functor.Contravariant + ( contramap ) +import Data.Proxy + ( Proxy (..) ) +import Data.Text + ( Text ) +import Data.Text.Class + ( ToText (..) ) +import GHC.Generics + ( Generic ) +import Network.Socket + ( SockAddr, Socket, getSocketName ) +import Network.Wai.Handler.Warp + ( setBeforeMainLoop ) +import Network.Wai.Middleware.Logging + ( ApiLog ) +import System.Exit + ( ExitCode (..) ) + +import qualified Cardano.Wallet.Api.Server as Server +import qualified Cardano.Wallet.DB.Sqlite as Sqlite +import qualified Data.Text as T +import qualified Network.Wai.Handler.Warp as Warp + +-- | The @cardano-wallet-shelley@ main function. It takes the configuration +-- which was passed from the CLI and environment and starts all components of +-- the wallet. +serveWallet + :: forall (n :: NetworkDiscriminant) t. + ( NetworkDiscriminantVal n + , KnownNetwork n + , DecodeAddress n + , EncodeAddress n + , WorstSizeOf Address n IcarusKey + , WorstSizeOf Address n ByronKey + , t ~ IO Byron + ) + => Tracers IO + -- ^ Logging config. + -> SyncTolerance + -- ^ A time tolerance within we consider being synced + -> Maybe FilePath + -- ^ Database folder filepath + -> HostPreference + -- ^ Which host to bind. + -> Listen + -- ^ HTTP API Server port. + -> AddrInfo + -- ^ Socket for communicating with the node + -> (SockAddr -> IO ()) + -- ^ 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 + Left e -> handleApiServerStartupError e + Right (_, socket) -> serveApp socket + where + bp = blockchainParameters @n + + serveApp socket = do + let nl = newNetworkLayer nullTracer bp addrInfo (versionData @n) + byronApi <- apiLayer (newTransactionLayer @n) nl + icarusApi <- apiLayer (newTransactionLayer @n) nl + startServer socket byronApi icarusApi $> ExitSuccess + + startServer + :: Socket + -> ApiLayer (RndState 'Mainnet) t ByronKey + -> ApiLayer (SeqState 'Mainnet IcarusKey) t IcarusKey + -> IO () + startServer socket byron icarus = do + sockAddr <- getSocketName socket + let settings = Warp.defaultSettings & setBeforeMainLoop + (beforeMainLoop sockAddr) + let application = Server.serve (Proxy @(ApiV2 n)) $ + Server.byronServer byron icarus + Server.start settings apiServerTracer socket application + + apiLayer + :: forall s k. + ( IsOurs s Address + , IsOurs s ChimericAccount + , NFData s + , Show s + , PersistState s + , PersistPrivateKey (k 'RootK) + , WalletKey k + ) + => TransactionLayer t k + -> NetworkLayer IO t ByronBlock + -> IO (ApiLayer s t k) + apiLayer tl nl = do + let (block0, _) = staticBlockchainParameters nl + let tracer = contramap MsgDatabaseStartup applicationTracer + let params = (fromByronBlock genesisHash block0, bp, sTolerance) + wallets <- maybe (pure []) (Sqlite.findDatabases @k tracer) databaseDir + db <- Sqlite.newDBFactory + walletDbTracer + (DefaultFieldValues $ getActiveSlotCoefficient bp) + databaseDir + Server.newApiLayer + walletEngineTracer params nl' tl db wallets + where + genesisHash = getGenesisBlockHash bp + nl' = fromByronBlock genesisHash <$> nl + + -- FIXME: reduce duplication (see Cardano.Wallet.Jormungandr) + handleApiServerStartupError :: ListenError -> IO ExitCode + handleApiServerStartupError err = do + traceWith applicationTracer $ MsgServerStartupError err + pure $ ExitFailure $ exitCodeApiServer err + +-- | Failure status codes for HTTP API server errors. +-- FIXME: reduce duplication (see Cardano.Wallet.Jormungandr) +exitCodeApiServer :: ListenError -> Int +exitCodeApiServer = \case + ListenErrorHostDoesNotExist _ -> 10 + ListenErrorInvalidAddress _ -> 11 + ListenErrorAddressAlreadyInUse _ -> 12 + ListenErrorOperationNotPermitted -> 13 + +{------------------------------------------------------------------------------- + Logging +-------------------------------------------------------------------------------} + +-- | Log messages related to application startup and shutdown. +data ApplicationLog + = MsgStarting AddrInfo + | MsgNetworkName NetworkDiscriminant + | MsgSigTerm + | MsgServerStartupError ListenError + | MsgDatabaseStartup DatabasesStartupLog + deriving (Generic, Show, Eq) + +instance ToText ApplicationLog where + toText = \case + MsgStarting info -> + "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 + ListenErrorHostDoesNotExist host -> mempty + <> "Can't listen on " + <> T.pack (show host) + <> ". It does not exist." + ListenErrorInvalidAddress host -> mempty + <> "Can't listen on " + <> T.pack (show host) + <> ". Invalid address." + ListenErrorAddressAlreadyInUse mPort -> mempty + <> "The API server listen port " + <> maybe "(unknown)" (T.pack . show) mPort + <> " is already in use." + ListenErrorOperationNotPermitted -> mempty + <> "Cannot listen on the given port. " + <> "The operation is not permitted." + +instance DefinePrivacyAnnotation ApplicationLog +instance DefineSeverity ApplicationLog where + defineSeverity = \case + MsgStarting _ -> Info + MsgSigTerm -> Notice + MsgNetworkName _ -> Info + MsgDatabaseStartup ev -> defineSeverity ev + MsgServerStartupError _ -> Alert + +{------------------------------------------------------------------------------- + Tracers +-------------------------------------------------------------------------------} + +-- FIXME: reduce duplication (see Cardano.Wallet.Jormungandr) vvv + +-- | The types of trace events produced by the Byron API server. +data Tracers' f = Tracers + { applicationTracer :: f ApplicationLog + , apiServerTracer :: f ApiLog + , walletEngineTracer :: f (WorkerLog WalletId WalletLog) + , walletDbTracer :: f DBLog + } + +-- | All of the Byron 'Tracer's. +type Tracers m = Tracers' (Tracer m) + +-- | The minimum severities for 'Tracers'. 'Nothing' indicates that tracing is +-- completely disabled. +type TracerSeverities = Tracers' (Const (Maybe Severity)) + +deriving instance Show TracerSeverities +deriving instance Eq TracerSeverities + +-- | Construct a 'TracerSeverities' record with all tracers set to the given +-- severity. +tracerSeverities :: Maybe Severity -> TracerSeverities +tracerSeverities sev = Tracers + { applicationTracer = Const sev + , apiServerTracer = Const sev + , walletDbTracer = Const sev + , walletEngineTracer = Const sev + } + +-- | Set up tracing with textual log messages. +setupTracers :: TracerSeverities -> Trace IO Text -> Tracers IO +setupTracers sev tr = Tracers + { applicationTracer = mkTrace applicationTracer $ onoff applicationTracer tr + , apiServerTracer = mkTrace apiServerTracer $ onoff apiServerTracer tr + , walletEngineTracer = mkTrace walletEngineTracer $ onoff walletEngineTracer tr + , walletDbTracer = mkTrace walletDbTracer $ onoff walletDbTracer tr + } + where + onoff + :: Monad m + => (TracerSeverities -> Const (Maybe Severity) a) + -> Trace m b + -> Trace m b + onoff f = case getConst (f sev) of + Nothing -> const nullTracer + Just s -> filterTraceSeverity s + + mkTrace + :: (DefinePrivacyAnnotation a, DefineSeverity a, ToText a) + => (Tracers' (Const Text) -> Const Text a) + -> Trace IO Text + -> Tracer IO a + mkTrace f = + trMessageText . appendName (getConst $ f tracerLabels) + +-- | Strings that the user can refer to tracers by. +tracerLabels :: Tracers' (Const Text) +tracerLabels = Tracers + { applicationTracer = Const "application" + , apiServerTracer = Const "api-server" + , walletEngineTracer = Const "wallet-engine" + , walletDbTracer = Const "wallet-db" + } + +-- | Names and descriptions of the tracers, for user documentation. +tracerDescriptions :: [(String, String)] +tracerDescriptions = + [ ( lbl applicationTracer + , "About start-up logic and the server's surroundings." + ) + , ( lbl apiServerTracer + , "About the HTTP API requests and responses." + ) + , ( lbl walletEngineTracer + , "About background wallet workers events and core wallet engine." + ) + , ( lbl walletDbTracer + , "About database operations of each wallet." + ) + ] + where + lbl f = T.unpack . getConst . f $ tracerLabels diff --git a/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs b/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs new file mode 100644 index 00000000000..74194eda120 --- /dev/null +++ b/lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs @@ -0,0 +1,356 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Copyright: © 2020 IOHK +-- License: Apache-2.0 +-- +-- Conversion functions and static chain settings for Byron. + +module Cardano.Wallet.Byron.Compatibility + ( Byron + , ByronBlock + + -- * Chain Parameters + , KnownNetwork (..) + , mainnetParameters + , mainnetGenesisHash + , mainnetStartTime + , byronFeePolicy + , byronSlotLength + , byronEpochLength + , byronTxMaxSize + , byronEpochStability + , byronActiveSlotCoefficient + + -- * Genesis + , genesisTip + , genesisBlock + + -- * Network Parameters + , mainnetVersionData + , testnetVersionData + + -- * Conversions + , toByronHash + , toEpochSlots + , toPoint + , toSlotNo + + , fromByronBlock + , fromTxAux + , fromTxIn + , fromTxOut + , fromByronHash + , fromChainHash + , fromSlotNo + , fromBlockNo + , fromTip + ) where + +import Prelude + +import Cardano.Binary + ( serialize' ) +import Cardano.Chain.Block + ( ABlockOrBoundary (..) + , ABoundaryBlock (..) + , ABoundaryBody (..) + , ABoundaryHeader (..) + , blockTxPayload + ) +import Cardano.Chain.Common + ( ChainDifficulty (..), unsafeGetLovelace ) +import Cardano.Chain.Slotting + ( EpochSlots (..) ) +import Cardano.Chain.UTxO + ( Tx (..), TxAux, TxIn (..), TxOut (..), taTx, unTxPayload ) +import Cardano.Crypto + ( AbstractHash (..), hash ) +import Cardano.Wallet.Primitive.AddressDerivation + ( NetworkDiscriminant (..) ) +import Codec.SerialiseTerm + ( CodecCBORTerm ) +import Data.Coerce + ( coerce ) +import Data.Quantity + ( Quantity (..) ) +import Data.Text + ( Text ) +import Data.Time.Clock.POSIX + ( posixSecondsToUTCTime ) +import Data.Word + ( Word16, Word32 ) +import Ouroboros.Consensus.Ledger.Byron + ( ByronBlock (..), ByronHash (..) ) +import Ouroboros.Network.Block + ( BlockNo (..) + , ChainHash (..) + , Point (..) + , SlotNo (..) + , Tip (..) + , genesisBlockNo + , genesisPoint + , genesisSlotNo + ) +import Ouroboros.Network.ChainFragment + ( HasHeader (..) ) +import Ouroboros.Network.Magic + ( NetworkMagic (..) ) +import Ouroboros.Network.NodeToClient + ( NodeToClientVersionData (..), nodeToClientCodecCBORTerm ) +import Ouroboros.Network.Point + ( WithOrigin (..) ) + +import qualified Cardano.Chain.Genesis as Genesis +import qualified Crypto.Hash as Crypto +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.List.NonEmpty as NE +import qualified Ouroboros.Network.Block as O +import qualified Ouroboros.Network.Point as Point + +import Cardano.Wallet.Unsafe + ( unsafeFromHex ) + +import qualified Cardano.Wallet.Primitive.Types as W + +data Byron + +-------------------------------------------------------------------------------- +-- +-- Chain Parameters + +-- | Embed some constants into a network type. +class KnownNetwork (n :: NetworkDiscriminant) where + blockchainParameters + :: W.BlockchainParameters + versionData + :: ( NodeToClientVersionData + , CodecCBORTerm Text NodeToClientVersionData + ) + +instance KnownNetwork 'Mainnet where + blockchainParameters = mainnetParameters + versionData = mainnetVersionData + +mainnetParameters + :: W.BlockchainParameters +mainnetParameters = W.BlockchainParameters + { getGenesisBlockHash = mainnetGenesisHash + , getGenesisBlockDate = mainnetStartTime + , getFeePolicy = byronFeePolicy + , getSlotLength = byronSlotLength + , getEpochLength = byronEpochLength + , getTxMaxSize = byronTxMaxSize + , getEpochStability = byronEpochStability + , getActiveSlotCoefficient = byronActiveSlotCoefficient + } + +-- | Hard-coded mainnet genesis hash +mainnetGenesisHash :: W.Hash "Genesis" +mainnetGenesisHash = W.Hash $ unsafeFromHex + "f0f7892b5c333cffc4b3c4344de48af4\ + \cc63f55e44936196f365a9ef2244134f" + +-- | Hard-coded mainnet start time +mainnetStartTime :: W.StartTime +mainnetStartTime = + W.StartTime $ posixSecondsToUTCTime 1506203091 + +-- | Hard-coded fee policy for Cardano on Byron +byronFeePolicy :: W.FeePolicy +byronFeePolicy = + W.LinearFee (Quantity 155381) (Quantity 43.946) (Quantity 0) + +-- | Hard-coded slot duration +byronSlotLength :: W.SlotLength +byronSlotLength = + W.SlotLength 20 +-- | Hard-coded byron epoch length +byronEpochLength :: W.EpochLength +byronEpochLength = + W.EpochLength 21600 + +-- | Hard-coded max transaction size +byronTxMaxSize :: Quantity "byte" Word16 +byronTxMaxSize = + Quantity 8192 + +-- | Hard-coded epoch stability (a.k.a 'k') +byronEpochStability :: Quantity "block" Word32 +byronEpochStability = + Quantity 2160 + +-- | Hard-coded active slot coefficient (a.k.a 'f' in Ouroboros/Praos) +byronActiveSlotCoefficient :: W.ActiveSlotCoefficient +byronActiveSlotCoefficient = + W.ActiveSlotCoefficient 1.0 + +-------------------------------------------------------------------------------- +-- +-- Genesis + +genesisTip :: Tip ByronBlock +genesisTip = Tip genesisPoint genesisBlockNo + +-- FIXME +-- Actually figure out a way to get this from the network. For Haskell nodes, +-- there's actually no such thing as a genesis block. But there's a genesis +-- UTxO and a genesis hash. So, we might be able to ajust our abstractions to +-- this. +genesisBlock :: ByronHash -> ByronBlock +genesisBlock genesisHash = ByronBlock + { byronBlockRaw = ABOBBoundary $ ABoundaryBlock + { boundaryBlockLength = 0 + , boundaryHeader = UnsafeABoundaryHeader + { boundaryPrevHash = Left (Genesis.GenesisHash (coerce genesisHash)) + , boundaryEpoch = 0 + , boundaryDifficulty = ChainDifficulty 0 + , boundaryHeaderAnnotation = mempty + } + , boundaryBody = ABoundaryBody mempty + , boundaryAnnotation = mempty + } + , byronBlockSlotNo = genesisSlotNo + , byronBlockHash = genesisHash + } + +-------------------------------------------------------------------------------- +-- +-- Network Parameters + +-- | Settings for configuring a MainNet network client +mainnetVersionData + :: (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData) +mainnetVersionData = + ( NodeToClientVersionData { networkMagic = NetworkMagic 764824073 } + , nodeToClientCodecCBORTerm + ) + +-- | Settings +testnetVersionData + :: (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData) +testnetVersionData = + ( NodeToClientVersionData { networkMagic = NetworkMagic 1097911063 } + , nodeToClientCodecCBORTerm + ) + +-------------------------------------------------------------------------------- +-- +-- Type Conversions + +toByronHash :: W.Hash "BlockHeader" -> ByronHash +toByronHash (W.Hash bytes) = + case Crypto.digestFromByteString bytes of + Just digest -> + ByronHash $ AbstractHash digest + Nothing -> + error "unsafeHash: failed to convert bytes to hash?" + +toEpochSlots :: W.EpochLength -> EpochSlots +toEpochSlots = + EpochSlots . fromIntegral . W.unEpochLength + +toPoint :: W.BlockHeader -> Point ByronBlock +toPoint (W.BlockHeader sid _ h _) + | sid == W.SlotId 0 0 = genesisPoint + | otherwise = O.Point $ Point.block (toSlotNo sid) (toByronHash h) + +toSlotNo :: W.SlotId -> SlotNo +toSlotNo = + SlotNo . W.flatSlot byronEpochLength + +fromByronBlock :: W.Hash "Genesis" -> ByronBlock -> W.Block +fromByronBlock genesisHash byronBlk = case byronBlockRaw byronBlk of + ABOBBlock blk -> + mkBlock $ fromTxAux <$> unTxPayload (blockTxPayload blk) + ABOBBoundary _ -> + mkBlock [] + where + mkBlock :: [W.Tx] -> W.Block + mkBlock txs = W.Block + { header = W.BlockHeader + { slotId = + fromSlotNo $ blockSlot byronBlk + , blockHeight = + fromBlockNo $ blockNo byronBlk + , headerHash = + fromByronHash $ blockHash byronBlk + , parentHeaderHash = + fromChainHash genesisHash $ blockPrevHash byronBlk + } + , transactions = txs + , delegations = [] + } + +fromTxAux :: TxAux -> W.Tx +fromTxAux txAux = case taTx txAux of + tx@(UnsafeTx inputs outputs _attributes) -> W.Tx + { txId = W.Hash $ BA.convert $ hash tx + + -- TODO: Review 'W.Tx' to not require resolved inputs but only inputs + , resolvedInputs = + (, W.Coin 0) . fromTxIn <$> NE.toList inputs + + , outputs = + fromTxOut <$> NE.toList outputs + } + +fromTxIn :: TxIn -> W.TxIn +fromTxIn (TxInUtxo id_ ix) = W.TxIn + { inputId = W.Hash $ BA.convert id_ + , inputIx = ix + } + +fromTxOut :: TxOut -> W.TxOut +fromTxOut (TxOut addr coin) = W.TxOut + { address = W.Address (serialize' addr) + , coin = W.Coin (unsafeGetLovelace coin) + } + +fromByronHash :: ByronHash -> W.Hash "BlockHeader" +fromByronHash = + W.Hash . BA.convert . unByronHash + +fromChainHash :: W.Hash "Genesis" -> ChainHash ByronBlock -> W.Hash "BlockHeader" +fromChainHash genesisHash = \case + GenesisHash -> coerce genesisHash + BlockHash h -> fromByronHash h + +fromSlotNo :: SlotNo -> W.SlotId +fromSlotNo (SlotNo sl) = + W.fromFlatSlot byronEpochLength sl + +-- FIXME unsafe conversion (Word64 -> Word32) +fromBlockNo :: BlockNo -> Quantity "block" Word32 +fromBlockNo (BlockNo h) = + Quantity (fromIntegral h) + +fromTip :: W.Hash "Genesis" -> Tip ByronBlock -> W.BlockHeader +fromTip genesisHash tip = case getPoint (tipPoint tip) of + Origin -> W.BlockHeader + { slotId = W.SlotId 0 0 + , blockHeight = Quantity 0 + , headerHash = coerce genesisHash + , parentHeaderHash = W.Hash (BS.replicate 32 0) + } + At blk -> W.BlockHeader + { slotId = fromSlotNo $ Point.blockPointSlot blk + , blockHeight = fromBlockNo $ tipBlockNo tip + , headerHash = fromByronHash $ Point.blockPointHash blk + -- TODO + -- We only use the parentHeaderHash in the + -- 'Cardano.Wallet.Network.BlockHeaders' chain follower only required for + -- Jörmungandr, this is therefore useless to have in 'normal' BlockHeader + -- + -- Yet, since we also serialize these to the database, this requires + -- some non-trivial changes. Not fixing this right now is also a + -- possibility. + , parentHeaderHash = W.Hash "parentHeaderHash - unused in Byron" + } diff --git a/lib/byron/src/Cardano/Wallet/Byron/Network.hs b/lib/byron/src/Cardano/Wallet/Byron/Network.hs new file mode 100644 index 00000000000..ecd14cfd49b --- /dev/null +++ b/lib/byron/src/Cardano/Wallet/Byron/Network.hs @@ -0,0 +1,587 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Copyright: © 2020 IOHK +-- License: Apache-2.0 +-- +-- Network Layer for talking to Haskell re-written nodes. +-- +-- Good to read before / additional resources: +-- +-- - Module's documentation in `ouroboros-network/typed-protocols/src/Network/TypedProtocols.hs` +-- - Data Diffusion and Peer Networking in Shelley (see: https://raw.githubusercontent.com/wiki/input-output-hk/cardano-wallet/data_diffusion_and_peer_networking_in_shelley.pdf) +-- - In particular sections 4.1, 4.2, 4.6 and 4.8 +module Cardano.Wallet.Byron.Network + ( -- * Top-Level Interface + pattern Cursor + , newNetworkLayer + + -- * Transport Helpers + , AddrInfo + , localSocketAddrInfo + ) where + +import Prelude + +import Cardano.BM.Trace + ( Trace, nullTracer ) +import Cardano.Wallet.Byron.Compatibility + ( Byron + , byronEpochLength + , fromSlotNo + , fromTip + , genesisBlock + , genesisTip + , toByronHash + , toEpochSlots + , toPoint + ) +import Cardano.Wallet.Logging + ( trMessage ) +import Cardano.Wallet.Network + ( Cursor + , ErrGetBlock (..) + , ErrNetworkUnavailable (..) + , NetworkLayer (..) + , NextBlocksResult (..) + ) +import Codec.SerialiseTerm + ( CodecCBORTerm ) +import Control.Concurrent.Async + ( async, link ) +import Control.Exception + ( catch, throwIO ) +import Control.Monad + ( void ) +import Control.Monad.Class.MonadAsync + ( MonadAsync (race) ) +import Control.Monad.Class.MonadST + ( MonadST ) +import Control.Monad.Class.MonadSTM + ( MonadSTM + , TQueue (..) + , atomically + , newEmptyTMVarM + , newTQueue + , putTMVar + , readTQueue + , takeTMVar + , writeTQueue + ) +import Control.Monad.Class.MonadThrow + ( MonadThrow ) +import Control.Monad.Class.MonadTimer + ( MonadTimer, threadDelay ) +import Control.Monad.IO.Class + ( MonadIO ) +import Control.Monad.Trans.Except + ( ExceptT (..), withExceptT ) +import Control.Tracer + ( Tracer, contramap ) +import Data.ByteString.Lazy + ( ByteString ) +import Data.Coerce + ( coerce ) +import Data.Functor + ( (<&>) ) +import Data.Quantity + ( Quantity (..) ) +import Data.Text + ( Text ) +import Data.Void + ( Void ) +import GHC.Stack + ( HasCallStack ) +import Network.Mux.Interface + ( AppType (..) ) +import Network.Mux.Types + ( MuxError ) +import Network.Socket + ( AddrInfo (..), Family (..), SockAddr (..), SocketType (..) ) +import Network.TypedProtocol.Channel + ( Channel ) +import Network.TypedProtocol.Codec + ( Codec ) +import Network.TypedProtocol.Codec.Cbor + ( DeserialiseFailure ) +import Network.TypedProtocol.Driver + ( TraceSendRecv, runPeer ) +import Ouroboros.Consensus.Ledger.Byron + ( ByronBlock (..) + , GenTx + , decodeByronBlock + , decodeByronGenTx + , decodeByronHeaderHash + , encodeByronBlock + , encodeByronGenTx + , encodeByronHeaderHash + ) +import Ouroboros.Network.Block + ( Point (..) + , SlotNo (..) + , Tip (..) + , blockPoint + , decodePoint + , decodeTip + , encodePoint + , encodeTip + , genesisPoint + , pointSlot + ) +import Ouroboros.Network.Mux + ( OuroborosApplication (..) ) +import Ouroboros.Network.NodeToClient + ( ConnectionId (..) + , NetworkConnectTracers (..) + , NodeToClientProtocols (..) + , NodeToClientVersion (..) + , NodeToClientVersionData (..) + , connectTo + , localTxSubmissionClientNull + ) +import Ouroboros.Network.Point + ( fromWithOrigin ) +import Ouroboros.Network.Protocol.ChainSync.Client + ( ChainSyncClient (..) + , ClientStIdle (..) + , ClientStIntersect (..) + , ClientStNext (..) + , chainSyncClientPeer + ) +import Ouroboros.Network.Protocol.ChainSync.Codec + ( codecChainSync ) +import Ouroboros.Network.Protocol.ChainSync.Type + ( ChainSync ) +import Ouroboros.Network.Protocol.Handshake.Version + ( DictVersion (..), simpleSingletonVersions ) +import Ouroboros.Network.Protocol.LocalTxSubmission.Client + ( LocalTxSubmissionClient (..), localTxSubmissionClientPeer ) +import Ouroboros.Network.Protocol.LocalTxSubmission.Codec + ( codecLocalTxSubmission ) +import Ouroboros.Network.Protocol.LocalTxSubmission.Type + ( LocalTxSubmission ) + +import qualified Cardano.Wallet.Primitive.Types as W +import qualified Codec.Serialise as CBOR +import qualified Data.Text as T +import qualified Network.Socket as Socket + +-- | Network layer cursor for Byron. Mostly useless since the protocol itself is +-- stateful and the node's keep track of the associated connection's cursor. +data instance Cursor (m Byron) = Cursor + (Point ByronBlock) + (TQueue m (NetworkClientCmd m)) + +-- | Create an instance of the network layer +newNetworkLayer + :: Trace IO Text + -- ^ Logging of network layer startup + -> W.BlockchainParameters + -- ^ Static blockchain parameters + -> AddrInfo + -- ^ Socket for communicating with the node + -> (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData) + -- ^ Codecs for the node's client + -> NetworkLayer IO (IO Byron) ByronBlock +newNetworkLayer tr bp addrInfo versionData = NetworkLayer + { currentNodeTip = _currentNodeTip + , nextBlocks = _nextBlocks + , initCursor = _initCursor + , cursorSlotId = _cursorSlotId + , postTx = _postTx + , staticBlockchainParameters = _staticBlockchainParameters + , stakeDistribution = _stakeDistribution + , getAccountBalance = _getAccountBalance + } + where + _initCursor headers = do + queue <- atomically newTQueue + link =<< async + (connectClient (mkNetworkClient tr bp queue) versionData addrInfo) + + let points = genesisPoint : (toPoint <$> headers) + queue `send` CmdFindIntersection points >>= \case + Right(Just intersection) -> + pure $ Cursor intersection queue + _ -> fail + "initCursor: intersection not found? This can't happen \ + \because we always give at least the genesis point..." + + _nextBlocks (Cursor _ queue) = withExceptT ErrGetBlockNetworkUnreachable $ do + ExceptT (queue `send` CmdNextBlocks) + + _cursorSlotId (Cursor point _) = do + fromSlotNo $ fromWithOrigin (SlotNo 0) $ pointSlot point + + _getAccountBalance _ = + pure (Quantity 0) + + _staticBlockchainParameters = + -- FIXME: Actually pass in the block0 as a parameter + ( genesisBlock $ toByronHash $ coerce $ W.getGenesisBlockHash bp + , bp + ) + + _currentNodeTip = + notImplemented "currentNodeTip" + + _postTx = + notImplemented "postTx" + + _stakeDistribution = + notImplemented "stakeDistribution" + +-------------------------------------------------------------------------------- +-- +-- Interface with the Network Client + + +-- | We interact with the 'NetworkClient' via a commands instrumenting the +-- client to move within the state-machine protocol. Commands are sent from a +-- parent thread via a shared 'TQueue'. +-- +-- +-- MAIN THREAD | NETWORK CLIENT THREAD +-- | +-- *---------------* | +-- | | | +-- | Wallet Engine | | +-- | | | +-- *---------------* | +-- | ^ | +-- v | | +-- *---------------* | *----------------* +-- | | | | | +-- | Network Layer |<===[ TQueue ]===>| Network Client | +-- | | | | | +-- *---------------* | *----------------* +-- | | ^ +-- | v | +-- | (ChainSync + TxSubmission) +-- +-- The NetworkClient is idling most of the time and blocking on the TQueue while +-- waiting for commands. Upon receiving a command, it interprets it by sending +-- the corresponding instruction to the node and responding via a given +-- callback. +-- +-- See also 'send' for invoking commands. +data NetworkClientCmd (m :: * -> *) + = CmdFindIntersection + [Point ByronBlock] + (Maybe (Point ByronBlock) -> m ()) + | CmdNextBlocks + (NextBlocksResult (m Byron) ByronBlock -> m ()) + | CmdCurrentNodeTip + (Tip ByronBlock -> m ()) + +-- | Helper function to easily send commands to the node's client and read +-- responses back. +-- +-- >>> queue `send` CmdNextBlocks +-- RollForward cursor nodeTip blocks +-- +-- >>> queue `send` CmdNextBlocks +-- AwaitReply +send + :: (MonadSTM m, MonadAsync m, MonadTimer m) + => TQueue m (NetworkClientCmd m) + -> ((a -> m ()) -> NetworkClientCmd m) + -> m (Either ErrNetworkUnavailable a) +send queue cmd = do + tvar <- newEmptyTMVarM + atomically $ writeTQueue queue (cmd (atomically . putTMVar tvar)) + race timeout (atomically $ takeTMVar tvar) <&> \case + Left{} -> Left (ErrNetworkUnreachable "timeout") + Right a -> Right a + where + timeout = threadDelay 60 + +-------------------------------------------------------------------------------- +-- +-- Network Client + +-- | Type representing a network client running two mini-protocols to sync +-- from the chain and, submit transactions. +type NetworkClient m = OuroborosApplication + 'InitiatorApp + -- Initiator ~ Client (as opposed to Responder / Server) + ConnectionId + -- An identifier for the peer: here, a local and remote socket. + NodeToClientProtocols + -- Specifies which mini-protocols our client is talking. + -- 'NodeToClientProtocols' allows for two mini-protocols: + -- - Chain Sync + -- - Tx submission + m + -- Underlying monad we run in + ByteString + -- Concrete representation for bytes string + Void + -- Return type of a network client. Void indicates that the client + -- never exits. + Void + -- Irrelevant for 'InitiatorApplication'. Return type of 'Responder' + -- application. + +-- | Construct a network client with the given communication channel +mkNetworkClient + :: (MonadIO m, MonadThrow m, MonadST m, MonadTimer m) + => Trace m Text + -- ^ Base trace for underlying protocols + -> W.BlockchainParameters + -- ^ Static blockchain parameters + -> TQueue m (NetworkClientCmd m) + -- ^ Communication channel with the node + -> NetworkClient m +mkNetworkClient tr bp queue = + OuroborosInitiatorApplication $ \pid -> \case + ChainSyncWithBlocksPtcl -> + let tr' = contramap (T.pack . show) $ trMessage tr in + chainSyncWithBlocks tr' pid (W.getGenesisBlockHash bp) queue + LocalTxSubmissionPtcl -> + localTxSubmission nullTracer pid + +-- Connect a client to a network, see `mkNetworkClient` to construct a network +-- client interface. +-- +-- >>> connectClient (mkNetworkClient tr bp queue) mainnetVersionData addrInfo +connectClient + :: NetworkClient IO + -> (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData) + -> AddrInfo + -> IO () +connectClient client (vData, vCodec) addr = do + let vDict = DictVersion vCodec + let versions = simpleSingletonVersions NodeToClientV_1 vData vDict client + let tracers = NetworkConnectTracers nullTracer nullTracer + connectTo tracers versions Nothing addr `catch` handleMuxError + where + -- `connectTo` might rise an exception: we are the client and the protocols + -- specify that only client can lawfuly close a connection, but the other + -- side might just disappear. + -- + -- NOTE: This handler does nothing. + handleMuxError :: MuxError -> IO () + handleMuxError = throwIO + +-- | Client for the 'Chain Sync' mini-protocol. +-- +-- A corresponding 'Channel' can be obtained using a `MuxInitiatorApplication` +-- constructor. Once started, the client simply runs ad-infinitum but one may +-- interact with it via a 'TQueue' of commands / messages used to move inside +-- the state-machine. +-- +-- In a typical usage, 'chainSyncWithBlocks' would be executed in a forked +-- thread and given a 'TQueue' over which the parent thread as control. +-- +-- >>> forkIO $ void $ chainSyncWithBlocks peerId tr queue channel +-- () +-- >>> writeTQueue queue ... +-- +-- Agency +-- ------------------------------------------------------------------------- +-- Client has agency* | Idle +-- Server has agency* | Intersect, Next +-- +-- * A peer has agency if it is expected to send the next message. +-- +-- *-----------* +-- | Intersect |◀══════════════════════════════╗ +-- *-----------* FindIntersect ║ +-- │ ║ +-- │ *---------* *------* +-- │ Intersect.{Found,NotFound} | |═════════════▶| Done | +-- └───────────────────────────────╼| | MsgDone *------* +-- | Idle | +-- ╔═══════════════════════════════════| | +-- ║ RequestNext | |⇦ START +-- ║ *---------* +-- ▼ ╿ +-- *------* Roll.{Backward,Forward} │ +-- | Next |────────────────────────────────────┘ +-- *------* +-- +chainSyncWithBlocks + :: forall m protocol peerId. + ( protocol ~ ChainSync ByronBlock (Tip ByronBlock) + , MonadThrow m, MonadST m, MonadSTM m + ) + => Tracer m (TraceSendRecv protocol peerId DeserialiseFailure) + -- ^ Base tracer for the mini-protocols + -> peerId + -- ^ An abstract peer identifier for 'runPeer' + -> W.Hash "Genesis" + -- ^ Hash of the genesis block + -> TQueue m (NetworkClientCmd m) + -- ^ We use a 'TQueue' as a communication channel to drive queries from + -- outside of the network client to the client itself. + -- Requests are pushed to the queue which are then transformed into + -- messages to keep the state-machine moving. + -> Channel m ByteString + -- ^ A 'Channel' is a abstract communication instrument which + -- transports serialized messages between peers (e.g. a unix + -- socket). + -> m Void +chainSyncWithBlocks tr pid genesisHash queue channel = do + nodeTipVar <- newTMVarM genesisTip + runPeer tr codec pid channel (chainSyncClientPeer $ client nodeTipVar) + where + codec :: Codec protocol DeserialiseFailure m ByteString + codec = codecChainSync + encodeByronBlock + (decodeByronBlock (toEpochSlots byronEpochLength)) + (encodePoint encodeByronHeaderHash) + (decodePoint decodeByronHeaderHash) + (encodeTip encodeByronHeaderHash) + (decodeTip decodeByronHeaderHash) + + client + :: TMVar m (Tip ByronBlock) + -> ChainSyncClient ByronBlock (Tip ByronBlock) m Void + client nodeTipVar = ChainSyncClient clientStIdle + where + -- Client in the state 'Idle'. We wait for requests / commands on an + -- 'TQueue'. Commands start a chain of messages and state transitions + -- before finally returning to 'Idle', waiting for the next command. + clientStIdle + :: m (ClientStIdle ByronBlock (Tip ByronBlock) m Void) + clientStIdle = atomically (readTQueue queue) >>= \case + CmdFindIntersection points respond -> pure $ + SendMsgFindIntersect points (clientStIntersect respond) + + CmdNextBlocks respond -> pure $ + SendMsgRequestNext + (clientStNext ([], 1000) respond) + (pure $ clientStNext ([], 1) respond) + + CmdCurrentNodeTip respond -> do + respond =<< atomically (readTMVar nodeTipVar) + clientStIdle + + clientStIntersect + :: (Maybe (Point ByronBlock) -> m ()) + -> ClientStIntersect ByronBlock (Tip ByronBlock) m Void + clientStIntersect respond = ClientStIntersect + { recvMsgIntersectFound = \intersection tip -> + ChainSyncClient $ do + swapTMVarM nodeTipVar tip + respond (Just intersection) + clientStIdle + + , recvMsgIntersectNotFound = \tip -> + ChainSyncClient $ do + swapTMVarM nodeTipVar tip + respond Nothing + clientStIdle + } + + clientStNext + :: ([ByronBlock], Int) + -> (NextBlocksResult (m Byron) ByronBlock -> m ()) + -> ClientStNext ByronBlock (Tip ByronBlock) m Void + clientStNext (blocks, n) respond + | n <= 1 = ClientStNext + { recvMsgRollBackward = onRollback + , recvMsgRollForward = \block tip -> + ChainSyncClient $ do + swapTMVarM nodeTipVar tip + let cursor = Cursor (blockPoint block) queue + let blocks' = reverse (block:blocks) + respond (RollForward cursor (fromTip genesisHash tip) blocks') + clientStIdle + } + | otherwise = ClientStNext + { recvMsgRollBackward = onRollback + , recvMsgRollForward = \block _ -> + ChainSyncClient $ pure $ SendMsgRequestNext + (clientStNext (block:blocks,n-1) respond) + (pure $ clientStNext (block:blocks,1) respond) + } + where + onRollback point tip = ChainSyncClient $ do + swapTMVarM nodeTipVar tip + respond (RollBackward (Cursor point queue)) + clientStIdle + +-- | Client for the 'Local Tx Submission' mini-protocol. +-- +-- A corresponding 'Channel' can be obtained using a `MuxInitiatorApplication` +-- constructor. +-- +-- Agency +-- ------------------------------------------------------------------------- +-- Client has agency* | Idle +-- Server has agency* | Busy +-- * A peer has agency if it is expected to send the next message. +-- +-- *-----------* +-- | Busy |◀══════════════════════════════╗ +-- *-----------* SubmitTx ║ +-- │ │ ║ +-- │ │ *---------* *------* +-- │ │ AcceptTx | |═════════════▶| Done | +-- │ └────────────────────────────╼| | MsgDone *------* +-- │ RejectTx | Idle | +-- └──────────────────────────────────╼| | +-- | |⇦ START +-- *---------* +localTxSubmission + :: forall m protocol peerId. + ( MonadThrow m, MonadTimer m, MonadST m + , protocol ~ LocalTxSubmission (GenTx ByronBlock) String + ) + => Tracer m (TraceSendRecv protocol peerId DeserialiseFailure) + -- ^ Base tracer for the mini-protocols + -> peerId + -- ^ An abstract peer identifier for 'runPeer' + -> Channel m ByteString + -- ^ A 'Channel' is a abstract communication instrument which + -- transports serialized messages between peers (e.g. a unix + -- socket). + -> m Void +localTxSubmission tr pid channel = + runPeer tr codec pid channel (localTxSubmissionClientPeer client) + where + codec :: Codec protocol DeserialiseFailure m ByteString + codec = codecLocalTxSubmission + encodeByronGenTx -- Tx -> CBOR.Encoding + decodeByronGenTx -- CBOR.Decoder s Tx + CBOR.encode -- String -> CBOR.Encoding + CBOR.decode -- CBOR.Decoder s String + + client :: LocalTxSubmissionClient (GenTx ByronBlock) String m Void + client = localTxSubmissionClientNull + +-------------------------------------------------------------------------------- +-- +-- Transport + +localSocketAddrInfo :: FilePath -> AddrInfo +localSocketAddrInfo socketPath = AddrInfo + { addrFlags = [] + , addrFamily = AF_UNIX + , addrProtocol = Socket.defaultProtocol + , addrAddress = SockAddrUnix socketPath + , addrCanonName = Nothing + , addrSocketType = Stream + } + +-------------------------------------------------------------------------------- +-- +-- Internal + +swapTMVarM :: MonadSTM m => TMVar m a -> a -> m () +swapTMVarM var = void . atomically . swapTMVar var + +-------------------------------------------------------------------------------- +-- +-- Temporary + +notImplemented :: HasCallStack => String -> a +notImplemented what = error ("Not implemented: " <> what) diff --git a/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs b/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs new file mode 100644 index 00000000000..4b80355e2e5 --- /dev/null +++ b/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs @@ -0,0 +1,227 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Copyright: © 2020 IOHK +-- License: Apache-2.0 +-- +-- Working with Byron transactions. + +module Cardano.Wallet.Byron.Transaction + ( newTransactionLayer + ) where + +import Prelude + +import Cardano.Wallet.Byron.Compatibility + ( Byron ) +import Cardano.Wallet.Byron.Transaction.Size + ( WorstSizeOf, sizeOfSignedTx, worstSizeOf ) +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth (..) + , NetworkDiscriminant (..) + , Passphrase (..) + , WalletKey (..) + , XPrv + ) +import Cardano.Wallet.Primitive.CoinSelection + ( CoinSelection (..) ) +import Cardano.Wallet.Primitive.Types + ( Address (..) + , Coin (..) + , Hash (..) + , PoolId + , SealedTx (..) + , Tx (..) + , TxIn (..) + , TxOut (..) + ) +import Cardano.Wallet.Transaction + ( ErrDecodeSignedTx (..) + , ErrMkTx (..) + , ErrValidateSelection + , TransactionLayer (..) + ) +import Control.Arrow + ( second ) +import Control.Monad + ( forM, when ) +import Crypto.Hash + ( hash ) +import Crypto.Hash.Algorithms + ( Blake2b_256 ) +import Data.ByteString + ( ByteString ) +import Data.Either.Combinators + ( maybeToRight ) +import Data.Quantity + ( Quantity (..) ) +import Data.Word + ( Word16, Word8 ) +import Fmt + ( Buildable (..) ) +import GHC.Stack + ( HasCallStack ) + +import qualified Cardano.Byron.Codec.Cbor as CBOR +import qualified Cardano.Crypto.Wallet as CC +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Read as CBOR +import qualified Codec.CBOR.Write as CBOR +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T + + +newTransactionLayer + :: forall (n :: NetworkDiscriminant) k t. + ( t ~ IO Byron + , WalletKey k + , WorstSizeOf Address n k + ) + => TransactionLayer t k +newTransactionLayer = TransactionLayer + { mkStdTx = _mkStdTx + , mkDelegationJoinTx = _mkDelegationJoinTx + , mkDelegationQuitTx = _mkDelegationQuitTx + , decodeSignedTx = _decodeSignedTx + , estimateSize = _estimateSize + , estimateMaxNumberOfInputs = _estimateMaxNumberOfInputs + , validateSelection = _validateSelection + } + where + _mkStdTx + :: (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) + -> [(TxIn, TxOut)] + -> [TxOut] + -> Either ErrMkTx (Tx, SealedTx) + _mkStdTx keyFrom inps outs = do + let tx = (fst <$> inps, outs) + let sigData = blake2b256 (CBOR.encodeTx tx) + witnesses <- forM inps $ \(_, TxOut addr _) -> + mkWitness sigData <$> lookupPrivateKey addr + pure + ( Tx (Hash sigData) (second coin <$> inps) outs + , SealedTx $ CBOR.toStrictByteString $ CBOR.encodeSignedTx tx witnesses + ) + where + lookupPrivateKey + :: Address + -> Either ErrMkTx (k 'AddressK XPrv, Passphrase "encryption") + lookupPrivateKey addr = + maybeToRight (ErrKeyNotFoundForAddress addr) (keyFrom addr) + + _estimateSize + :: CoinSelection + -> Quantity "byte" Int + _estimateSize (CoinSelection inps outs chngs) = + Quantity $ sizeOfSignedTx (fst <$> inps) (outs <> map dummyOutput chngs) + where + dummyOutput :: Coin -> TxOut + dummyOutput = TxOut (dummyAddress @n @k) + + _estimateMaxNumberOfInputs + :: Quantity "byte" Word16 + -- ^ Transaction max size in bytes + -> Word8 + -- ^ Number of outputs in transaction + -> Word8 + _estimateMaxNumberOfInputs _ _ = + -- TODO: Compute the actual size or, revise coin selection to not + -- need that. Instead, we could simply compute the size of the + -- transaction at each step and check that it remains under the + -- allowed max size. + maxBound + + _validateSelection + :: CoinSelection + -> Either (ErrValidateSelection t) () + _validateSelection (CoinSelection _ outs _) = + when (any (\ (TxOut _ c) -> c == Coin 0) outs) $ + Left ErrInvalidTxOutAmount + + _decodeSignedTx + :: ByteString + -> Either ErrDecodeSignedTx (Tx, SealedTx) + _decodeSignedTx bytes = + case CBOR.deserialiseFromBytes CBOR.decodeSignedTx (BL.fromStrict bytes) of + Left e -> + Left $ ErrDecodeSignedTxWrongPayload $ T.pack $ show e + Right (_, ((inps, outs), _)) -> Right + ( Tx + { txId = Hash $ blake2b256 $ CBOR.encodeTx (inps, outs) + -- FIXME Do not require Tx to have resolvedInputs + , resolvedInputs = (,Coin 0) <$> inps + , outputs = outs + } + , SealedTx bytes + ) + + _mkDelegationJoinTx + :: PoolId + -> (k 'AddressK XPrv, Passphrase "encryption") -- reward account + -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) + -> [(TxIn, TxOut)] + -> [TxOut] + -> Either ErrMkTx (Tx, SealedTx) + _mkDelegationJoinTx = + notImplemented "mkDelegationJoinTx" + + _mkDelegationQuitTx + :: (k 'AddressK XPrv, Passphrase "encryption") -- reward account + -> (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) + -> [(TxIn, TxOut)] + -> [TxOut] + -> Either ErrMkTx (Tx, SealedTx) + _mkDelegationQuitTx = + notImplemented "mkDelegationQuitTx" + +-------------------------------------------------------------------------------- +-- Extra validations on coin selection +-- + +-- | Transaction with 0 output amount is tried +data ErrInvalidTxOutAmount = ErrInvalidTxOutAmount + +instance Buildable ErrInvalidTxOutAmount where + build _ = "Invalid coin selection: at least one output is null." + +type instance ErrValidateSelection (IO Byron) = ErrInvalidTxOutAmount + +-------------------------------------------------------------------------------- +-- Internal +-- + +dummyAddress + :: forall (n :: NetworkDiscriminant) k. (WorstSizeOf Address n k) => Address +dummyAddress = + Address $ BS.replicate (worstSizeOf @Address @n @k) 0 + +mkWitness + :: WalletKey k + => ByteString + -> (k 'AddressK XPrv, Passphrase "encryption") + -> ByteString +mkWitness sigData (xPrv, Passphrase pwd) = CBOR.toStrictByteString + $ CBOR.encodePublicKeyWitness (getRawKey $ publicKey xPrv) + $ CC.unXSignature (CC.sign pwd (getRawKey xPrv) message) + where + message = "\x01" <> pm <> CBOR.toStrictByteString (CBOR.encodeBytes sigData) + pm = notImplemented "protocolMagic" + -- CBOR.toStrictByteString . CBOR.encodeInt32 $ x + -- let ProtocolMagic x = protocolMagic @n in + +blake2b256 :: CBOR.Encoding -> ByteString +blake2b256 = + BA.convert . hash @_ @Blake2b_256 . CBOR.toStrictByteString + +notImplemented :: HasCallStack => String -> a +notImplemented what = error ("Not implemented: " <> what) diff --git a/lib/byron/src/Cardano/Wallet/Byron/Transaction/Size.hs b/lib/byron/src/Cardano/Wallet/Byron/Transaction/Size.hs new file mode 100644 index 00000000000..f07dc884528 --- /dev/null +++ b/lib/byron/src/Cardano/Wallet/Byron/Transaction/Size.hs @@ -0,0 +1,225 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} + +-- | +-- Copyright: © 2020 IOHK +-- License: Apache-2.0 +-- +-- Size estimation of cbor-encoded transactions in Byron + +module Cardano.Wallet.Byron.Transaction.Size + ( sizeOfTxIn + , sizeOfSignedTx + , sizeOfTxWitness + , sizeOfTxOut + , sizeOfCoin + , worstSizeOf + , WorstSizeOf + ) where + +import Prelude + +import Cardano.Wallet.Primitive.AddressDerivation + ( Depth, NetworkDiscriminant (..) ) +import Cardano.Wallet.Primitive.AddressDerivation.Byron + ( ByronKey ) +import Cardano.Wallet.Primitive.AddressDerivation.Icarus + ( IcarusKey ) +import Cardano.Wallet.Primitive.Types + ( Address (..), Coin (..), TxIn (..), TxOut (..) ) + +import qualified Codec.CBOR.Encoding as CBOR +import qualified Codec.CBOR.Write as CBOR +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL + +-- TX +-- = CBOR-LIST-LEN (3) -- 1 byte +-- | CBOR-BEGIN-LIST -- 1 byte +-- | *INPUT -- ΣsizeOf(INPUT) bytes +-- | CBOR-BREAK-LIST -- 1 byte +-- | CBOR-BEGIN-LIST -- 1 byte +-- | *OUTPUT -- ΣsizeOf(OUTPUT) bytes +-- | CBOR-BREAK-LIST -- 1 byte +-- | ATTRIBUTES (Ø) -- 1 byte +-- == 6 + ΣsizeOf(i) + ΣsizeOf(o) +sizeOfTx :: [TxIn] -> [TxOut] -> Int +sizeOfTx inps outs = 6 + + sum (map sizeOfTxIn inps) + + sum (map sizeOfTxOut outs) + +-- SIGNED-TX +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | TX -- sizeOf(TX) bytes +-- | CBOR-LIST-LEN (n) -- 1-2 bytes (assuming n < 255) +-- | *WITNESS -- n * 139 bytes +-- == 1 + sizeOf(TX) + 1-2 + n * 139 +sizeOfSignedTx :: [TxIn] -> [TxOut] -> Int +sizeOfSignedTx inps outs = 1 + + sizeOfTx inps outs + + sizeOf (CBOR.encodeListLen $ fromIntegral n) + + n * sizeOfTxWitness + where + n = length inps + +-- INPUT +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | U8 -- 1 byte +-- | CBOR-TAG (24) -- 2 bytes +-- | BYTES (38-42) -- 2 bytes +-- | 36-40OCTET -- 35 + 1-5 bytes #---* +-- == 41 + (1-5) | +-- *--------------------------------------------* +-- | +-- v +-- 36-40OCTET +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | CBOR-BYTES (32) -- 2 bytes +-- | 32OCTET -- 32 bytes +-- | U32 -- 1-5 bytes +sizeOfTxIn :: TxIn -> Int +sizeOfTxIn (TxIn _ ix) = + 41 + sizeOf (CBOR.encodeWord32 $ fromIntegral ix) + +-- WITNESS +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | U8 -- 1 byte +-- | CBOR-TAG (24) -- 2 bytes +-- | CBOR-BYTES (133 -- 2 bytes +-- | 133OCTET -- 133 bytes #--------* +-- == 139 | +-- *--------------------------------------------* +-- | +-- v +-- 133OCTET +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | CBOR-BYTES (64) -- 2 bytes +-- | 64OCTET -- 64 bytes +-- | CBOR-BYTES (64) -- 2 bytes +-- | 64OCTET -- 64 bytes +sizeOfTxWitness :: Int +sizeOfTxWitness = 139 + +-- OUTPUT +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | ADDRESS -- 40-83 bytes +-- | U64 -- 1-9 bytes +-- == 1 + sizeOf(ADDRESS) + 1-9 +sizeOfTxOut :: TxOut -> Int +sizeOfTxOut (TxOut (Address bytes) c) = + 1 + BS.length bytes + sizeOfCoin c + +-- Compute the size of a coin +sizeOfCoin :: Coin -> Int +sizeOfCoin = sizeOf . CBOR.encodeWord64 . getCoin + +-- Size of a particular CBOR encoding +sizeOf :: CBOR.Encoding -> Int +sizeOf = fromIntegral . BL.length . CBOR.toLazyByteString + +class WorstSizeOf (t :: *) (n :: NetworkDiscriminant) (k :: Depth -> * -> *) where + worstSizeOf :: Int + +-- ADDRESS (MainNet, Icarus) +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | 39-43OCTET -- 39-43 bytes #------* +-- | +-- *--------------------------------------------* +-- | +-- v +-- 39-43OCTET +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | CBOR-TAG (24) -- 2 bytes +-- | CBOR-BYTES (33) -- 2 bytes +-- | 33OCTET -- 33 bytes #------* +-- | U32 -- 1-5 bytes | +-- | +-- *--------------------------------------------* +-- | +-- v +-- 33OCTET +-- = CBOR-LIST-LEN (3) -- 1 byte +-- | CBOR-BYTES (28) -- 2 bytes +-- | 28OCTET -- 28 bytes +-- | ATTRIBUTES (Ø) -- 1 byte +-- | U8 -- 1 bytes +instance WorstSizeOf Address 'Mainnet IcarusKey where worstSizeOf = 44 + +-- ADDRESS (TestNet, Icarus) +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | 46-50OCTET -- 46-50 bytes #------* +-- | +-- *--------------------------------------------* +-- | +-- v +-- 46-50OCTET +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | CBOR-TAG (24) -- 2 bytes +-- | CBOR-BYTES (40) -- 2 bytes +-- | 40OCTET -- 40 bytes #------* +-- | U32 -- 1-5 bytes | +-- | +-- *--------------------------------------------* +-- | +-- v +-- 40OCTET +-- = CBOR-LIST-LEN (3) -- 1 byte +-- | CBOR-BYTES (28) -- 2 bytes +-- | 28OCTET -- 28 bytes +-- | ATTRIBUTES (8) -- 8 bytes +-- | U8 -- 1 bytes +instance WorstSizeOf Address 'Testnet IcarusKey where worstSizeOf = 51 + +-- ADDRESS (MainNet, Random) +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | 72-76OCTET -- 72-76 bytes #------* +-- | +-- *--------------------------------------------* +-- | +-- v +-- 72-76OCTET +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | CBOR-TAG (24) -- 2 bytes +-- | CBOR-BYTES (33) -- 2 bytes +-- | 66OCTET -- 66 bytes #------* +-- | U32 -- 1-5 bytes | +-- | +-- *--------------------------------------------* +-- | +-- v +-- 66OCTET +-- = CBOR-LIST-LEN (3) -- 1 byte +-- | CBOR-BYTES (28) -- 2 bytes +-- | 28OCTET -- 28 bytes +-- | ATTRIBUTES (34) -- 34 bytes +-- | U8 -- 1 bytes +instance WorstSizeOf Address 'Mainnet ByronKey where worstSizeOf = 77 + +-- ADDRESS (TestNet, Random) +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | 79-83OCTET -- 79-83 bytes #------* +-- | +-- *--------------------------------------------* +-- | +-- v +-- 79-83OCTET +-- = CBOR-LIST-LEN (2) -- 1 byte +-- | CBOR-TAG (24) -- 2 bytes +-- | CBOR-BYTES (33) -- 2 bytes +-- | 73OCTET -- 73 bytes #------* +-- | U32 -- 1-5 bytes | +-- | +-- *--------------------------------------------* +-- | +-- v +-- 73OCTET +-- = CBOR-LIST-LEN (3) -- 1 byte +-- | CBOR-BYTES (28) -- 2 bytes +-- | 28OCTET -- 28 bytes +-- | ATTRIBUTES (41) -- 41 bytes +-- | U8 -- 1 bytes +instance WorstSizeOf Address 'Testnet ByronKey where worstSizeOf = 84 diff --git a/lib/cli/src/Cardano/CLI.hs b/lib/cli/src/Cardano/CLI.hs index 3deea749eb7..3091a1b16b1 100644 --- a/lib/cli/src/Cardano/CLI.hs +++ b/lib/cli/src/Cardano/CLI.hs @@ -44,9 +44,12 @@ module Cardano.CLI , nodePortMaybeOption , stateDirOption , syncToleranceOption - , loggingSeverityReader - , loggingSeverityOrOffReader + , LoggingOptions (..) + , helperTracing + , loggingOptions , loggingSeverities + , loggingSeverityOrOffReader + , loggingSeverityReader -- * Types , Service @@ -162,6 +165,8 @@ import Data.Text.Class ( FromText (..), TextDecodingError (..), ToText (..), showT ) import Data.Text.Read ( decimal ) +import Data.Void + ( Void ) import Fmt ( Buildable, pretty ) import GHC.Generics @@ -179,9 +184,12 @@ import Options.Applicative , CommandFields , Mod , OptionFields + , ParseError (InfoMsg) , Parser , ParserInfo + , abortOption , argument + , auto , command , customExecParser , eitherReader @@ -190,6 +198,7 @@ import Options.Applicative , header , help , helper + , hidden , info , long , metavar @@ -1176,6 +1185,74 @@ withLogging configFile minSeverity action = bracket before after (action . snd) logDebug tr "Logging shutdown." shutdown sb +data LoggingOptions tracers = LoggingOptions + { loggingMinSeverity :: Severity + , loggingTracers :: tracers + , loggingTracersDoc :: Maybe Void + } deriving (Show, Eq) + +loggingOptions :: Parser tracers -> Parser (LoggingOptions tracers) +loggingOptions tracers = LoggingOptions + <$> minSev + <*> tracers + <*> tracersDoc + where + -- Note: If the global log level is Info then there will be no Debug-level + -- messages whatsoever. + -- If the global log level is Debug then there will be Debug, Info, and + -- higher-severity messages. + -- So the default global log level is Debug. + minSev = option loggingSeverityReader $ mempty + <> long "log-level" + <> value Debug + <> metavar "SEVERITY" + <> help "Global minimum severity for a message to be logged. \ + \Individual tracers severities still need to be configured \ + \independently. Defaults to \"DEBUG\"." + <> hidden + tracersDoc = optional $ option auto $ mempty + <> long "trace-NAME" + <> metavar "SEVERITY" + <> help "Individual component severity for 'NAME'. See --help-tracing \ + \for details and available tracers." + +-- | A hidden "helper" option which always fails, but shows info about the +-- logging options. +helperTracing :: [(String, String)] -> Parser (a -> a) +helperTracing tracerDescriptions = abortOption (InfoMsg helpTxt) $ mempty + <> long "help-tracing" + <> help "Show help for tracing options" + <> hidden + where + helpTxt = helperTracingText tracerDescriptions + +helperTracingText :: [(String, String)] -> String +helperTracingText tracerDescriptions = unlines $ + [ "Additional tracing options:" + , "" + , " --log-level SEVERITY Global minimum severity for a message to be logged." + , " Defaults to \"DEBUG\"." + , "" + , " --trace-NAME=off Disable logging on the given tracer." + , " --trace-NAME=SEVERITY Minimum severity for a message to be logged, or" + , " \"off\" to disable the tracer. Note that component" + , " traces still abide by the global log-level. For" + , " example, if the global log level is \"INFO\", then" + , " there will be no \"DEBUG\" messages whatsoever." + , " Defaults to \"INFO\"." + , "" + , "The possible log levels (lowest to highest) are:" + , " " ++ unwords (map fst loggingSeverities) + , "" + , "The possible tracers are:" + ] ++ [ pretty_ tracerName desc | (tracerName, desc) <- tracerDescriptions] + where + maxLength = maximum $ map (length . fst) tracerDescriptions + pretty_ tracerName desc = + " " ++ padRight maxLength ' ' tracerName ++ " " ++ desc + where + padRight n c cs = take n $ cs ++ replicate n c + {------------------------------------------------------------------------------- ANSI Terminal Helpers -------------------------------------------------------------------------------} diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 6439bb03d29..117b4e8d81b 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -227,7 +227,7 @@ import System.Process , withCreateProcess ) import Test.Hspec - ( expectationFailure ) + ( HasCallStack, expectationFailure ) import Test.Hspec.Expectations.Lifted ( shouldBe, shouldContain, shouldNotBe ) import Test.Integration.Faucet @@ -261,7 +261,7 @@ import qualified Network.HTTP.Types.Status as HTTP -- | Expect an error response, without any further assumptions. expectError - :: (MonadIO m, MonadFail m, Show a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a) => (s, Either RequestException a) -> m () expectError (_, res) = case res of @@ -270,7 +270,7 @@ expectError (_, res) = case res of -- | Expect an error response, without any further assumptions. expectErrorMessage - :: (MonadIO m, MonadFail m, Show a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a) => String -> (s, Either RequestException a) -> m () @@ -285,7 +285,7 @@ expectErrorMessage want (_, res) = case res of -- | Expect a successful response, without any further assumptions. expectSuccess - :: (MonadIO m, MonadFail m) + :: (HasCallStack, MonadIO m, MonadFail m) => (s, Either RequestException a) -> m () expectSuccess (_, res) = case res of @@ -294,7 +294,7 @@ expectSuccess (_, res) = case res of -- | Expect a given response code on the response. expectResponseCode - :: (MonadIO m, Show a) + :: (HasCallStack, MonadIO m, Show a) => HTTP.Status -> (HTTP.Status, a) -> m () @@ -309,7 +309,7 @@ expectResponseCode want (got, a) = ] expectFieldEqual - :: (MonadIO m, MonadFail m, Show a, Eq a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Eq a) => Lens' s a -> a -> (HTTP.Status, Either RequestException s) @@ -319,7 +319,7 @@ expectFieldEqual getter a (_, res) = case res of Right s -> (view getter s) `shouldBe` a expectFieldBetween - :: (MonadIO m, MonadFail m, Show a, Ord a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Ord a) => Lens' s a -> (a, a) -> (HTTP.Status, Either RequestException s) @@ -336,7 +336,7 @@ expectFieldBetween getter (aMin, aMax) (_, res) = case res of return () expectFieldSatisfy - :: (MonadIO m, MonadFail m, Show a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a) => Lens' s a -> (a -> Bool) -> (HTTP.Status, Either RequestException s) @@ -350,7 +350,7 @@ expectFieldSatisfy getter predicate (_, res) = case res of else fail $ "predicate failed for: " <> show a expectFieldNotEqual - :: (MonadIO m, MonadFail m, Show a, Eq a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Eq a) => Lens' s a -> a -> (HTTP.Status, Either RequestException s) @@ -365,7 +365,7 @@ expectFieldNotEqual getter a (_, res) = case res of -- expectListItemFieldEqual 0 (#name . #getApiT . #getWalletName) "first" r -- expectListItemFieldEqual 1 (#name . #getApiT . #getWalletName) "second" r expectListItemFieldEqual - :: (MonadIO m, MonadFail m, Show a, Eq a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Eq a) => Int -> Lens' s a -> a @@ -380,7 +380,7 @@ expectListItemFieldEqual i getter a (c, res) = case res of " element from a list but there's none! " expectListItemFieldSatisfy - :: (MonadIO m, MonadFail m, Show a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a) => Int -> Lens' s a -> (a -> Bool) @@ -396,7 +396,7 @@ expectListItemFieldSatisfy i getter predicate (c, res) = case res of " element from a list but there's none! " expectListItemFieldBetween - :: (MonadIO m, MonadFail m, Show a, Eq a, Ord a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Eq a, Ord a) => Int -> Lens' s a -> (a, a) @@ -413,7 +413,7 @@ expectListItemFieldBetween i getter (aMin, aMax) (c, res) = case res of -- | Expects data list returned by the API to be of certain length expectListSizeEqual - :: (MonadIO m, MonadFail m, Foldable xs) + :: (HasCallStack, MonadIO m, MonadFail m, Foldable xs) => Int -> (HTTP.Status, Either RequestException (xs a)) -> m () @@ -424,7 +424,7 @@ expectListSizeEqual l (_, res) = case res of -- | Expects wallet UTxO statistics from the request to be equal to -- pre-calculated statistics. expectWalletUTxO - :: (MonadIO m, MonadFail m) + :: (HasCallStack, MonadIO m, MonadFail m) => [Word64] -> Either RequestException ApiUtxoStatistics -> m () @@ -446,7 +446,7 @@ expectWalletUTxO coins = \case -- | Expects wallet from the request to eventually reach the given state or -- beyond. expectEventually - :: forall ctx s a m. (MonadIO m, MonadCatch m, MonadFail m) + :: forall ctx s a m. (HasCallStack, MonadIO m, MonadCatch m, MonadFail m) => (Ord a, Show a, FromJSON s) => (HasType (Text, Manager) ctx) => ctx @@ -475,7 +475,7 @@ expectEventually ctx endpoint getter target (_, res) = case res of -- | Like 'expectEventually', but the target is part of the response. expectEventuallyL - :: (MonadIO m, MonadCatch m, MonadFail m) + :: (HasCallStack, MonadIO m, MonadCatch m, MonadFail m) => (Ord a, Show a) => (HasType (Text, Manager) ctx) => ctx @@ -501,7 +501,7 @@ expectEventuallyL ctx getter target s = liftIO $ do -- | Same as 'expectEventually', but works directly on 'ApiWallet' -- rather than on a response from the API. expectEventually' - :: forall ctx s a m. (MonadIO m, MonadCatch m, MonadFail m) + :: forall ctx s a m. (HasCallStack, MonadIO m, MonadCatch m, MonadFail m) => (Ord a, Show a, FromJSON s) => (HasType (Text, Manager) ctx) => ctx @@ -521,7 +521,7 @@ expectEventually' ctx endpoint target value s = do -- | Expects a given string to be a valid JSON output corresponding to some -- given data-type 'a'. Returns this type if successful. expectValidJSON - :: forall m a. (MonadFail m, FromJSON a) + :: forall m a. (HasCallStack, MonadFail m, FromJSON a) => Proxy a -> String -> m a @@ -531,7 +531,7 @@ expectValidJSON _ str = Right a -> return a expectCliFieldBetween - :: (MonadIO m, MonadFail m, Show a, Ord a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Ord a) => Lens' s a -> (a, a) -> s @@ -545,7 +545,7 @@ expectCliFieldBetween getter (aMin, aMax) s = case view getter s of return () expectCliListItemFieldBetween - :: (MonadIO m, MonadFail m, Show a, Eq a, Ord a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Eq a, Ord a) => Int -> Lens' s a -> (a, a) @@ -558,7 +558,7 @@ expectCliListItemFieldBetween i getter (aMin, aMax) xs " element from a list but there's none! " expectCliFieldEqual - :: (MonadIO m, Show a, Eq a) + :: (HasCallStack, MonadIO m, Show a, Eq a) => Lens' s a -> a -> s @@ -566,7 +566,7 @@ expectCliFieldEqual expectCliFieldEqual getter a out = (view getter out) `shouldBe` a expectCliFieldNotEqual - :: (MonadIO m, Show a, Eq a) + :: (HasCallStack, MonadIO m, Show a, Eq a) => Lens' s a -> a -> s @@ -575,7 +575,7 @@ expectCliFieldNotEqual getter a out = (view getter out) `shouldNotBe` a -- | Same as 'expectListItemFieldEqual' but for CLI expectCliListItemFieldEqual - :: (MonadIO m, MonadFail m, Show a, Eq a) + :: (HasCallStack, MonadIO m, MonadFail m, Show a, Eq a) => Int -> Lens' s a -> a @@ -588,7 +588,7 @@ expectCliListItemFieldEqual i getter a out " element from a list but there's none! " -- | A file is eventually created on the given location -expectPathEventuallyExist :: FilePath -> IO () +expectPathEventuallyExist :: HasCallStack => FilePath -> IO () expectPathEventuallyExist filepath = do handle <- async doesPathExistNow winner <- race (threadDelay (60 * oneSecond)) (wait handle) diff --git a/lib/core/src/Cardano/Byron/Codec/Cbor.hs b/lib/core/src/Cardano/Byron/Codec/Cbor.hs index 2fc88fe57c1..d3a180fabb3 100644 --- a/lib/core/src/Cardano/Byron/Codec/Cbor.hs +++ b/lib/core/src/Cardano/Byron/Codec/Cbor.hs @@ -41,6 +41,8 @@ module Cardano.Byron.Codec.Cbor , encodeProtocolMagicAttr , encodePublicKeyWitness , encodeTx + , encodeSignedTx + , encodeTxWitness -- * Helpers , deserialiseCbor @@ -66,7 +68,6 @@ import Cardano.Wallet.Primitive.Types , SlotNo (..) , TxIn (..) , TxOut (..) - , TxWitness (..) , unsafeEpochNo ) import Control.Monad @@ -460,7 +461,7 @@ decodeSignature = do 2 -> decodeProxySignature decodeHeavyIndex _ -> fail $ "decodeSignature: unknown signature constructor: " <> show t -decodeSignedTx :: CBOR.Decoder s (([TxIn], [TxOut]), [TxWitness]) +decodeSignedTx :: CBOR.Decoder s (([TxIn], [TxOut]), [ByteString]) decodeSignedTx = do _ <- CBOR.decodeListLenCanonicalOf 2 tx <- decodeTx @@ -531,15 +532,15 @@ decodeTxProof = do _ <- CBOR.decodeBytes -- Witnesses Hash return () -decodeTxWitness :: CBOR.Decoder s TxWitness +decodeTxWitness :: CBOR.Decoder s ByteString decodeTxWitness = do _ <- CBOR.decodeListLenCanonicalOf 2 t <- CBOR.decodeWord8 _ <- CBOR.decodeTag case t of - 0 -> TxWitness <$> CBOR.decodeBytes - 1 -> TxWitness <$> CBOR.decodeBytes - 2 -> TxWitness <$> CBOR.decodeBytes + 0 -> CBOR.decodeBytes + 1 -> CBOR.decodeBytes + 2 -> CBOR.decodeBytes _ -> fail $ "decodeTxWitness: unknown tx witness constructor: " <> show t @@ -641,11 +642,11 @@ encodeDerivationPath (Index acctIx) (Index addrIx) = mempty <> CBOR.encodeWord32 addrIx <> CBOR.encodeBreak -encodePublicKeyWitness :: XPub -> Hash "signature" -> CBOR.Encoding -encodePublicKeyWitness xpub (Hash signData) = mempty +encodePublicKeyWitness :: XPub -> ByteString -> CBOR.Encoding +encodePublicKeyWitness xpub signatur = mempty <> CBOR.encodeListLen 2 <> CBOR.encodeBytes (unXPub xpub) - <> CBOR.encodeBytes signData + <> CBOR.encodeBytes signatur encodeTx :: ([TxIn], [TxOut]) -> CBOR.Encoding encodeTx (inps, outs) = mempty @@ -658,6 +659,29 @@ encodeTx (inps, outs) = mempty <> CBOR.encodeBreak <> encodeTxAttributes +encodeSignedTx :: ([TxIn], [TxOut]) -> [ByteString] -> CBOR.Encoding +encodeSignedTx tx witnesses = mempty + <> CBOR.encodeListLen 2 + <> encodeTx tx + <> CBOR.encodeListLen (fromIntegral $ length witnesses) + <> mconcat (map encodeTxWitness witnesses) + +encodeTxWitness :: ByteString -> CBOR.Encoding +encodeTxWitness bytes = mempty + <> CBOR.encodeListLen 2 + <> CBOR.encodeWord8 tag + <> CBOR.encodeTag 24 + <> CBOR.encodeBytes bytes + where + -- NOTE + -- We only support 'PublicKey' witness types at the moment. However, + -- Byron nodes support more: + -- + -- * 0 for Public Key + -- * 1 for Script + -- * 2 for Redeem + tag = 0 + encodeTxAttributes :: CBOR.Encoding encodeTxAttributes = mempty <> CBOR.encodeMapLen 0 diff --git a/lib/core/src/Cardano/Pool/Metrics.hs b/lib/core/src/Cardano/Pool/Metrics.hs index 1c9cebbbd08..e562a82cef5 100644 --- a/lib/core/src/Cardano/Pool/Metrics.hs +++ b/lib/core/src/Cardano/Pool/Metrics.hs @@ -61,11 +61,11 @@ import Cardano.Pool.Performance import Cardano.Pool.Ranking ( EpochConstants (..), unsafeMkNonNegative, unsafeMkRatio ) import Cardano.Wallet.Network - ( ErrNetworkTip + ( ErrCurrentNodeTip , ErrNetworkUnavailable , FollowAction (..) , FollowLog - , NetworkLayer (networkTip, stakeDistribution) + , NetworkLayer (currentNodeTip, stakeDistribution) , follow , staticBlockchainParameters ) @@ -191,8 +191,8 @@ monitorStakePools tr nl db@DBLayer{..} = do forward blocks nodeTip = handler $ do (ep, dist) <- withExceptT ErrMonitorStakePoolsNetworkUnavailable $ stakeDistribution nl - currentTip <- withExceptT ErrMonitorStakePoolsNetworkTip $ - networkTip nl + currentTip <- withExceptT ErrMonitorStakePoolsCurrentNodeTip $ + currentNodeTip nl when (nodeTip /= currentTip) $ throwE ErrMonitorStakePoolsWrongTip liftIO $ traceWith tr $ MsgStakeDistribution ep @@ -210,7 +210,7 @@ monitorStakePools tr nl db@DBLayer{..} = do traceWith tr (MsgApplyError e) pure $ case e of ErrMonitorStakePoolsNetworkUnavailable{} -> RetryLater - ErrMonitorStakePoolsNetworkTip{} -> RetryLater + ErrMonitorStakePoolsCurrentNodeTip{} -> RetryLater ErrMonitorStakePoolsWrongTip{} -> RetryImmediately ErrMonitorStakePoolsPoolAlreadyExists{} -> ExitWith e Right () -> @@ -222,7 +222,7 @@ monitorStakePools tr nl db@DBLayer{..} = do data ErrMonitorStakePools = ErrMonitorStakePoolsNetworkUnavailable ErrNetworkUnavailable | ErrMonitorStakePoolsPoolAlreadyExists ErrPointAlreadyExists - | ErrMonitorStakePoolsNetworkTip ErrNetworkTip + | ErrMonitorStakePoolsCurrentNodeTip ErrCurrentNodeTip | ErrMonitorStakePoolsWrongTip deriving (Show, Eq) @@ -246,7 +246,7 @@ data StakePoolLayer m = StakePoolLayer data ErrListStakePools = ErrMetricsIsUnsynced (Quantity "percent" Percentage) | ErrListStakePoolsMetricsInconsistency ErrMetricsInconsistency - | ErrListStakePoolsErrNetworkTip ErrNetworkTip + | ErrListStakePoolsCurrentNodeTip ErrCurrentNodeTip deriving (Show) newStakePoolLayer @@ -270,8 +270,8 @@ newStakePoolLayer tr getEpCst db@DBLayer{..} nl metadataDir = StakePoolLayer where sortKnownPools :: ExceptT ErrListStakePools IO [(StakePool, [PoolOwner])] sortKnownPools = do - nodeTip <- withExceptT ErrListStakePoolsErrNetworkTip - $ networkTip nl + nodeTip <- withExceptT ErrListStakePoolsCurrentNodeTip + $ currentNodeTip nl let nodeEpoch = nodeTip ^. #slotId . #epochNumber let genesisEpoch = block0 ^. #header . #slotId . #epochNumber @@ -574,7 +574,7 @@ instance DefineSeverity StakePoolLog where -> Debug MsgApplyError e -> case e of ErrMonitorStakePoolsNetworkUnavailable{} -> Notice - ErrMonitorStakePoolsNetworkTip{} -> Notice + ErrMonitorStakePoolsCurrentNodeTip{} -> Notice ErrMonitorStakePoolsWrongTip{} -> Debug ErrMonitorStakePoolsPoolAlreadyExists{} -> Debug @@ -633,7 +633,7 @@ instance ToText StakePoolLog where MsgApplyError e -> case e of ErrMonitorStakePoolsNetworkUnavailable{} -> "Network is not available." - ErrMonitorStakePoolsNetworkTip{} -> + ErrMonitorStakePoolsCurrentNodeTip{} -> "Network is not available." ErrMonitorStakePoolsWrongTip{} -> "Race condition when fetching stake distribution." diff --git a/lib/core/src/Cardano/Wallet/Api.hs b/lib/core/src/Cardano/Wallet/Api.hs index c7414be0fc3..0cf5c5515c6 100644 --- a/lib/core/src/Cardano/Wallet/Api.hs +++ b/lib/core/src/Cardano/Wallet/Api.hs @@ -14,6 +14,7 @@ module Cardano.Wallet.Api ( -- * API Api + , ApiV2 -- * Shelley , Wallets @@ -170,6 +171,7 @@ import Servant.API.Verbs , Verb ) +type ApiV2 n = "v2" :> Api n type Api n = Wallets diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 6a1f1259139..ebbd3434a21 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -27,6 +27,9 @@ module Cardano.Wallet.Api.Server , ListenError (..) , HostPreference , start + , serve + , server + , byronServer , newApiLayer , withListeningSocket ) where @@ -120,8 +123,6 @@ import Cardano.Wallet.Api.Types , ApiWallet (..) , ApiWalletPassphrase (..) , ByronWalletPostData (..) - , DecodeAddress (..) - , EncodeAddress (..) , Iso8601Time (..) , PostExternalTransactionData (..) , PostTransactionData @@ -135,7 +136,7 @@ import Cardano.Wallet.Api.Types import Cardano.Wallet.DB ( DBFactory (..) ) import Cardano.Wallet.Network - ( ErrNetworkTip (..), ErrNetworkUnavailable (..), NetworkLayer ) + ( ErrCurrentNodeTip (..), ErrNetworkUnavailable (..), NetworkLayer ) import Cardano.Wallet.Primitive.AddressDerivation ( DelegationAddress (..) , Depth (..) @@ -276,7 +277,6 @@ import Numeric.Natural ( Natural ) import Servant ( (:<|>) (..) - , (:>) , Application , JSON , NoContent (..) @@ -288,8 +288,10 @@ import Servant , err409 , err410 , err500 + , err501 , err503 , serve + , throwError ) import Servant.Server ( Handler (..), ServantErr (..) ) @@ -329,30 +331,18 @@ data Listen -- | Start the application server, using the given settings and a bound socket. start - :: forall t (n :: NetworkDiscriminant). - ( Buildable (ErrValidateSelection t) - , DecodeAddress n - , EncodeAddress n - , DelegationAddress n ShelleyKey - ) - => Warp.Settings + :: Warp.Settings -> Tracer IO ApiLog -> Socket - -> ApiLayer (RndState 'Mainnet) t ByronKey - -> ApiLayer (SeqState 'Mainnet IcarusKey) t IcarusKey - -> ApiLayer (SeqState n ShelleyKey) t ShelleyKey - -> StakePoolLayer IO + -> Application -> IO () -start settings tr socket byron icarus shelley spl = do +start settings tr socket application = do logSettings <- newApiLoggerSettings <&> obfuscateKeys (const sensitive) Warp.runSettingsSocket settings socket $ handleRawError (curry handler) $ withApiLogger tr logSettings application where - application :: Application - application = serve (Proxy @("v2" :> Api n)) (server byron icarus shelley spl) - sensitive :: [Text] sensitive = [ "passphrase" @@ -539,6 +529,108 @@ server byron icarus shelley spl = proxy :: Server Proxy_ proxy = postExternalTransaction shelley + +-- | A diminished servant server to serve Byron wallets only. +byronServer + :: forall t n. () + => ApiLayer (RndState 'Mainnet) t ByronKey + -> ApiLayer (SeqState 'Mainnet IcarusKey) t IcarusKey + -> Server (Api n) +byronServer byron icarus = + wallets + :<|> addresses + :<|> coinSelections + :<|> transactions + :<|> stakePools + :<|> byronWallets + :<|> byronTransactions + :<|> byronMigrations + :<|> network + :<|> proxy + where + wallets :: Server Wallets + wallets = + (\_ -> throwError err501) + :<|> (\_ -> throwError err501) + :<|> throwError err501 + :<|> (\_ -> throwError err501) + :<|> (\_ _ -> throwError err501) + :<|> (\_ _ -> throwError err501) + :<|> (\_ -> throwError err501) + :<|> (\_ _ -> throwError err501) + + addresses :: Server (Addresses n) + addresses _ _ = throwError err501 + + coinSelections :: Server (CoinSelections n) + coinSelections _ _ = throwError err501 + + transactions :: Server (Transactions n) + transactions = + (\_ _ -> throwError err501) + :<|> (\_ _ _ _ -> throwError err501) + :<|> (\_ _ -> throwError err501) + :<|> (\_ _ -> throwError err501) + + stakePools :: Server (StakePools n) + stakePools = + throwError err501 + :<|> (\_ _ _ -> throwError err501) + :<|> (\_ _ _ -> throwError err501) + :<|> (\_ -> throwError err501) + + byronWallets :: Server ByronWallets + byronWallets = + postRandomWallet byron + :<|> postIcarusWallet icarus + :<|> postTrezorWallet icarus + :<|> postLedgerWallet icarus + :<|> (\wid -> withLegacyLayer wid + (byron , deleteWallet byron wid) + (icarus, deleteWallet icarus wid) + ) + :<|> (\wid -> withLegacyLayer wid + (byron , fst <$> getWallet byron mkLegacyWallet wid) + (icarus, fst <$> getWallet icarus mkLegacyWallet wid) + ) + :<|> liftA2 (\xs ys -> fmap fst $ sortOn snd $ xs ++ ys) + (listWallets byron mkLegacyWallet) + (listWallets icarus mkLegacyWallet) + :<|> (\wid tip -> withLegacyLayer wid + (byron , forceResyncWallet byron wid tip) + (icarus, forceResyncWallet icarus wid tip) + ) + + byronTransactions :: Server (ByronTransactions n) + byronTransactions = + (\wid r0 r1 s -> withLegacyLayer wid + (byron , listTransactions byron wid r0 r1 s) + (icarus, listTransactions icarus wid r0 r1 s) + ) + :<|> (\wid txid -> withLegacyLayer wid + (byron , deleteTransaction byron wid txid) + (icarus, deleteTransaction icarus wid txid) + ) + + byronMigrations :: Server (ByronMigrations n) + byronMigrations = + (\wid -> withLegacyLayer wid + (byron , getMigrationInfo byron wid) + (icarus, getMigrationInfo icarus wid) + ) + :<|> \_ _ _ -> throwError err501 + + network :: Server Network + network = + getNetworkInformation genesis nl + :<|> (getNetworkParameters genesis) + where + nl = icarus ^. networkLayer @t + genesis = icarus ^. genesisData + + proxy :: Server Proxy_ + proxy = postExternalTransaction icarus + {------------------------------------------------------------------------------- Wallet Constructors -------------------------------------------------------------------------------} @@ -1275,7 +1367,7 @@ getNetworkInformation -> Handler ApiNetworkInformation getNetworkInformation (_block0, bp, st) nl = do now <- liftIO getCurrentTime - nodeTip <- liftHandler (NW.networkTip nl) + nodeTip <- liftHandler (NW.currentNodeTip nl) let ntrkTip = fromMaybe slotMinBound (slotAt sp now) let nextEpochNo = unsafeEpochSucc (ntrkTip ^. #epochNumber) pure $ ApiNetworkInformation @@ -1295,7 +1387,7 @@ getNetworkInformation (_block0, bp, st) nl = do , networkTip = ApiNetworkTip { epochNumber = ApiT $ ntrkTip ^. #epochNumber - , slotNumber = ApiT $ ntrkTip ^. #slotNumber + , slotNumber = ApiT $ ntrkTip ^. #slotNumber } } where @@ -1872,10 +1964,10 @@ instance LiftHandler ErrStartTimeLaterThanEndTime where , "'." ] -instance LiftHandler ErrNetworkTip where +instance LiftHandler ErrCurrentNodeTip where handler = \case - ErrNetworkTipNetworkUnreachable e -> handler e - ErrNetworkTipNotFound -> apiError err503 NetworkTipNotFound $ mconcat + ErrCurrentNodeTipNetworkUnreachable e -> handler e + ErrCurrentNodeTipNotFound -> apiError err503 NetworkTipNotFound $ mconcat [ "I couldn't get the current network tip at the moment. It's " , "probably because the node is down or not started yet. Retrying " , "in a bit might give better results!" @@ -1884,7 +1976,7 @@ instance LiftHandler ErrNetworkTip where instance LiftHandler ErrListStakePools where handler = \case ErrListStakePoolsMetricsInconsistency e -> handler e - ErrListStakePoolsErrNetworkTip e -> handler e + ErrListStakePoolsCurrentNodeTip e -> handler e ErrMetricsIsUnsynced p -> apiError err503 NotSynced $ mconcat [ "I can't list stake pools yet because I need to scan the " diff --git a/lib/core/src/Cardano/Wallet/Logging.hs b/lib/core/src/Cardano/Wallet/Logging.hs index b5bff0aebf8..f06c7a25188 100644 --- a/lib/core/src/Cardano/Wallet/Logging.hs +++ b/lib/core/src/Cardano/Wallet/Logging.hs @@ -25,7 +25,7 @@ import Prelude import Cardano.BM.Data.LogItem ( LOContent (..), LOMeta (..), LogObject (..), mkLOMeta ) import Cardano.BM.Data.Severity - ( Severity ) + ( Severity (..) ) import Cardano.BM.Data.Tracer ( DefinePrivacyAnnotation (..), DefineSeverity (..), Transformable (..) ) import Cardano.BM.Trace diff --git a/lib/core/src/Cardano/Wallet/Network.hs b/lib/core/src/Cardano/Wallet/Network.hs index 6dfd3926f29..06d34472484 100644 --- a/lib/core/src/Cardano/Wallet/Network.hs +++ b/lib/core/src/Cardano/Wallet/Network.hs @@ -18,7 +18,7 @@ module Cardano.Wallet.Network -- * Errors , ErrNetworkUnavailable (..) - , ErrNetworkTip (..) + , ErrCurrentNodeTip (..) , ErrGetBlock (..) , ErrPostTx (..) , ErrGetAccountBalance (..) @@ -106,14 +106,8 @@ data NetworkLayer m target block = NetworkLayer -- If the node has adopted an alternate fork of the chain, it will -- return 'RollBackward' with a new cursor. - , findIntersection - :: Cursor target -> m (Maybe BlockHeader) - -- ^ Attempt to find an intersection between the node's unstable blocks - -- and a given list of headers. This can be useful if we need to know - -- whether we are 'in sync' with the node or, close enough. - , initCursor - :: [BlockHeader] -> Cursor target + :: [BlockHeader] -> m (Cursor target) -- ^ Creates a cursor from the given block header so that 'nextBlocks' -- can be used to fetch blocks. @@ -121,9 +115,9 @@ data NetworkLayer m target block = NetworkLayer :: Cursor target -> SlotId -- ^ Get the slot corresponding to a cursor. - , networkTip - :: ExceptT ErrNetworkTip m BlockHeader - -- ^ Get the current network tip from the chain producer + , currentNodeTip + :: ExceptT ErrCurrentNodeTip m BlockHeader + -- ^ Get the current tip from the chain producer , postTx :: SealedTx -> ExceptT ErrPostTx m () @@ -138,6 +132,7 @@ data NetworkLayer m target block = NetworkLayer ( EpochNo , Map PoolId (Quantity "lovelace" Word64) ) + , getAccountBalance :: ChimericAccount -> ExceptT ErrGetAccountBalance m (Quantity "lovelace" Word64) @@ -163,13 +158,13 @@ data ErrNetworkUnavailable instance Exception ErrNetworkUnavailable --- | Error while trying to get the network tip -data ErrNetworkTip - = ErrNetworkTipNetworkUnreachable ErrNetworkUnavailable - | ErrNetworkTipNotFound +-- | Error while trying to get the node tip +data ErrCurrentNodeTip + = ErrCurrentNodeTipNetworkUnreachable ErrNetworkUnavailable + | ErrCurrentNodeTipNotFound deriving (Generic, Show, Eq) -instance Exception ErrNetworkTip +instance Exception ErrCurrentNodeTip -- | Error while trying to get one or more blocks data ErrGetBlock @@ -195,7 +190,7 @@ data ErrGetAccountBalance Initialization -------------------------------------------------------------------------------} --- | Wait until 'networkTip networkLayer' succeeds according to a given +-- | Wait until 'currentNodeTip networkLayer' succeeds according to a given -- retry policy. Throws an exception otherwise. waitForNetwork :: ExceptT ErrNetworkUnavailable IO () @@ -258,6 +253,13 @@ instance Functor (NextBlocksResult target) where -- NOTE: @Retry@ is needed to handle data-races in -- 'Cardano.Pool.Metrics', where it is essensial that we fetch the stake -- distribution while the node-tip +-- +-- FIXME: +-- Retry actions with the Haskell nodes are not possible (or at least, requires +-- some additional manipulation to find a new intersection). As a possible fix, +-- we could use a type family to define 'FollowAction' in terms of the +-- underlying target. 'RetryImmediately' and 'RetryLater' could be authorized in +-- the context of Jormungandr but absent in the context of the Haskell nodes. data FollowAction err = ExitWith err -- ^ Stop following the chain. @@ -294,7 +296,7 @@ follow -- ^ Getter on the abstract 'block' type -> IO (Maybe SlotId) follow nl tr cps yield header = - sleep 0 (initCursor nl cps) + sleep 0 =<< initCursor nl cps where delay0 :: Int delay0 = 500*1000 -- 500ms @@ -341,15 +343,25 @@ follow nl tr cps yield header = traceWith tr MsgSynced sleep delay0 cursor' - Right (RollForward cursor' nodeTip (blockFirst : blocksRest)) -> do + Right (RollForward cursor' tip (blockFirst : blocksRest)) -> do let blocks = blockFirst :| blocksRest traceWith tr $ MsgApplyBlocks (header <$> blocks) - action <- yield blocks nodeTip + action <- yield blocks tip traceWith tr $ MsgFollowAction (fmap show action) handle cursor' action Right (RollBackward cursor') -> - return $ Just (cursorSlotId nl cursor') + -- NOTE + -- In case the node asks us to rollback to the last checkpoints we + -- gave, we take no action and simply move on to the next query. + -- This happens typically with the Haskell nodes which always + -- initiates the protocol by asking clients to rollback to the last + -- known intersection. + case (cursorSlotId nl cursor', cps) of + (sl, _:_) | sl == slotId (last cps) -> + step delay0 cursor' + (sl, _) -> + pure (Just sl) where handle :: Cursor target -> FollowAction e -> IO (Maybe SlotId) handle cursor' = \case diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs index f53643dd6ab..96c343bdd7e 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation.hs @@ -70,7 +70,6 @@ module Cardano.Wallet.Primitive.AddressDerivation , MkKeyFingerprint(..) , ErrMkKeyFingerprint(..) , KeyFingerprint(..) - , dummyAddress -- * Passphrase , Passphrase(..) @@ -593,9 +592,6 @@ class WalletKey (key :: Depth -> * -> *) where :: key depth raw -> raw - -- | Produce a fake address key of this scheme, for use in 'dummyAddress'. - dummyKey :: key 'AddressK XPub - -- | Encoding of addresses for certain key types and backend targets. class MkKeyFingerprint key Address => PaymentAddress (network :: NetworkDiscriminant) key where @@ -638,20 +634,6 @@ class PaymentAddress network key -- ^ Staking key / Reward account -> Address --- | Produce a fake address of representative size for the target and key --- type. This can be used in transaction size estimations. --- --- This function is ambiguous, like 'paymentAddress', and types need to be --- applied. -dummyAddress - :: forall network key. - ( PaymentAddress network key - , WalletKey key - ) - => Address -dummyAddress = - paymentAddress @network @key (dummyKey @key) - -- | Operations for saving a private key into a database, and restoring it from -- a database. The keys should be encoded in hexadecimal strings. class PersistPrivateKey (key :: * -> *) where diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs index a8ff4969836..df4f8ea5278 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Byron.hs @@ -56,7 +56,6 @@ import Cardano.Crypto.Wallet , unXPub , xPrvChangePass , xprv - , xpub ) import Cardano.Wallet.Primitive.AddressDerivation ( Depth (..) @@ -138,7 +137,6 @@ instance WalletKey ByronKey where -- Hash a public key to some other representation. digest = hash . unXPub . getKey getRawKey = getKey - dummyKey = dummyKeyRnd keyTypeDescriptor _ = "rnd" instance PaymentAddress 'Testnet ByronKey where @@ -262,13 +260,6 @@ hdPassphrase masterKey = Passphrase $ (unXPub masterKey) ("address-hashing" :: ByteString) -dummyKeyRnd :: ByronKey 'AddressK XPub -dummyKeyRnd = ByronKey key (minBound, minBound) pwd - where - Right key = xpub (B8.replicate 64 '\0') - -- The 'hdPassphrase' result is 256 bits - pwd = Passphrase (BA.convert $ B8.replicate 32 '\0') - {------------------------------------------------------------------------------- Passphrase -------------------------------------------------------------------------------} diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs index a9b3fbf09c1..20defbc419c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Icarus.hs @@ -373,9 +373,6 @@ instance WalletKey IcarusKey where getRawKey = getKey - dummyKey = - let Right pub = xpub (BS.replicate 64 0) in IcarusKey pub - {------------------------------------------------------------------------------- Relationship Key / Address -------------------------------------------------------------------------------} diff --git a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs index 029af7fe345..0c3142bbee2 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/AddressDerivation/Shelley.hs @@ -245,7 +245,6 @@ instance WalletKey ShelleyKey where publicKey = publicKeySeq digest = digestSeq getRawKey = getKey - dummyKey = dummyKeySeq keyTypeDescriptor _ = "seq" -- | Extract the public key part of a private key. @@ -263,10 +262,6 @@ digestSeq digestSeq (ShelleyKey k) = hash (unXPub k) -dummyKeySeq :: ShelleyKey 'AddressK XPub -dummyKeySeq = ShelleyKey key - where Right key = xpub (BS.replicate 64 0) - -- | Re-encrypt a private key using a different passphrase. -- -- **Important**: diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 1c0c07705f9..ac6b163b50c 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/lib/core/src/Cardano/Wallet/Primitive/Types.hs @@ -43,7 +43,6 @@ module Cardano.Wallet.Primitive.Types , TxMeta(..) , Direction(..) , TxStatus(..) - , TxWitness(..) , SealedTx (..) , TransactionInfo (..) , UnsignedTx (..) @@ -776,12 +775,6 @@ newtype SealedTx = SealedTx { getSealedTx :: ByteString } deriving stock (Show, Eq, Generic) deriving newtype (ByteArrayAccess) --- | @TxWitness@ is proof that transaction inputs are allowed to be spent -newtype TxWitness = TxWitness { unWitness :: ByteString } - deriving (Generic, Show, Eq, Ord) - -instance NFData TxWitness - -- | True if the given tuple refers to a pending transaction isPending :: TxMeta -> Bool isPending = (== Pending) . (status :: TxMeta -> TxStatus) diff --git a/lib/core/src/Cardano/Wallet/Transaction.hs b/lib/core/src/Cardano/Wallet/Transaction.hs index 6457bcb37db..4db5006b887 100644 --- a/lib/core/src/Cardano/Wallet/Transaction.hs +++ b/lib/core/src/Cardano/Wallet/Transaction.hs @@ -2,9 +2,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -- | @@ -24,34 +22,16 @@ module Cardano.Wallet.Transaction , ErrMkTx (..) , ErrValidateSelection , ErrDecodeSignedTx (..) - - -- * Backend helpers - , estimateMaxNumberOfInputsBase - , EstimateMaxNumberOfInputsParams(..) ) where import Prelude import Cardano.Wallet.Primitive.AddressDerivation - ( Depth (..) - , Passphrase - , PaymentAddress (..) - , WalletKey - , XPrv - , dummyAddress - ) + ( Depth (..), Passphrase, XPrv ) import Cardano.Wallet.Primitive.CoinSelection ( CoinSelection (..) ) import Cardano.Wallet.Primitive.Types - ( Address (..) - , Hash (..) - , PoolId - , SealedTx (..) - , Tx (..) - , TxIn (..) - , TxOut (..) - , TxWitness (..) - ) + ( Address (..), PoolId, SealedTx (..), Tx (..), TxIn (..), TxOut (..) ) import Data.ByteString ( ByteString ) import Data.Quantity @@ -61,8 +41,6 @@ import Data.Text import Data.Word ( Word16, Word8 ) -import qualified Data.ByteString as BS - data TransactionLayer t k = TransactionLayer { mkStdTx :: (Address -> Maybe (k 'AddressK XPrv, Passphrase "encryption")) @@ -159,62 +137,3 @@ newtype ErrMkTx = ErrKeyNotFoundForAddress Address -- ^ We tried to sign a transaction with inputs that are unknown to us? deriving (Eq, Show) - --- | Backend-specific variables used by 'estimateMaxNumberOfInputsBase'. -data EstimateMaxNumberOfInputsParams t = EstimateMaxNumberOfInputsParams - { estMeasureTx :: [TxIn] -> [TxOut] -> [TxWitness] -> Int - -- ^ Finds the size of a serialized transaction. - , estBlockHashSize :: Int - -- ^ Block ID size - , estTxWitnessSize :: Int - -- ^ Tx Witness size - } - --- | This is called by the 'TransactionLayer' implementation. It uses the --- serialization functions to calculate the size of an empty transaction --- compared to a transaction with one input. The estimation is based on that. --- --- It doesn't account for transaction outputs, and assumes there is a single Tx --- output. --- --- All the values used are the smaller ones. For example, the shortest adress --- type and shortest witness type are chosen to use for the estimate. -estimateMaxNumberOfInputsBase - :: forall t n k. - ( PaymentAddress n k - , WalletKey k - ) - => EstimateMaxNumberOfInputsParams t - -- ^ Backend-specific variables used in the estimation - -> Quantity "byte" Word16 - -- ^ Transaction max size in bytes - -> Word8 - -- ^ Number of outputs in transaction - -> Word8 - -- ^ Maximum number of inputs, estimated -estimateMaxNumberOfInputsBase - EstimateMaxNumberOfInputsParams{..} (Quantity txSize) numOutputs = - clamp $ max 0 (fromIntegral txSize - fixedSize) `div` inputSize - where - -- The fixed size covers the headers of a signed transaction with a single - -- output. - fixedSize = sizeOfTx [] [] - - -- inputSize is the size of each additional input of a signed transaction. - inputSize = sizeOfTx [txIn] [wit] - fixedSize - - -- Serialize a "representative" Tx with the given inputs and read its size. - sizeOfTx ins = estMeasureTx ins outs - - outs = replicate (fromIntegral numOutputs) txout - txout = TxOut baseAddr minBound - baseAddr = dummyAddress @n @k - txIn = TxIn (Hash $ chaff estBlockHashSize) 0 - wit = TxWitness (chaff estTxWitnessSize) - - -- Make a bytestring of length n - chaff n = BS.replicate n 0 - - -- convert down to a smaller int without wrapping - clamp :: Int -> Word8 - clamp = fromIntegral . min (fromIntegral $ maxBound @Word8) diff --git a/lib/core/test/unit/Cardano/Pool/MetricsSpec.hs b/lib/core/test/unit/Cardano/Pool/MetricsSpec.hs index 8ced1c9802e..6bec95fcb35 100644 --- a/lib/core/test/unit/Cardano/Pool/MetricsSpec.hs +++ b/lib/core/test/unit/Cardano/Pool/MetricsSpec.hs @@ -262,10 +262,10 @@ prop_trackRegistrations test = monadicIO $ do $ ErrGetBlockNetworkUnreachable $ ErrNetworkInvalid "The test case has finished") , initCursor = - const $ Cursor header0 + pure . const (Cursor header0) , stakeDistribution = pure (0, mempty) - , networkTip = + , currentNodeTip = pure header0 -- These params are basically unused and completely arbitrary. , staticBlockchainParameters = @@ -288,7 +288,7 @@ test_emptyDatabaseNotSynced = do _ -> fail $ "got something else than expected: " <> show res where nl = mockNetworkLayer - { networkTip = + { currentNodeTip = pure header0 , staticBlockchainParameters = ( block0 @@ -313,7 +313,7 @@ test_notSyncedProgress = do nodeTip = header0 { blockHeight = Quantity 42 } prodTip = header0 { blockHeight = Quantity 14 } nl = mockNetworkLayer - { networkTip = + { currentNodeTip = pure nodeTip , staticBlockchainParameters = ( block0 @@ -332,14 +332,12 @@ mockNetworkLayer :: NetworkLayer m t b mockNetworkLayer = NetworkLayer { nextBlocks = \_ -> error "mockNetworkLayer: nextBlocks" - , findIntersection = - \_ -> error "mockNetworkLayer: findIntersection" , initCursor = \_ -> error "mockNetworkLayer: initCursor" , cursorSlotId = \_ -> error "mockNetworkLayer: cursorSlotId" - , networkTip = - error "mockNetworkLayer: networkTip" + , currentNodeTip = + error "mockNetworkLayer: currentNodeTip" , postTx = \_ -> error "mockNetworkLayer: postTx" , staticBlockchainParameters = diff --git a/lib/core/test/unit/Cardano/Wallet/NetworkSpec.hs b/lib/core/test/unit/Cardano/Wallet/NetworkSpec.hs index 4d34a727117..62d1df29377 100644 --- a/lib/core/test/unit/Cardano/Wallet/NetworkSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/NetworkSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} module Cardano.Wallet.NetworkSpec ( spec @@ -11,8 +12,9 @@ import Cardano.BM.Trace ( traceInTVarIO ) import Cardano.Wallet.DummyTarget.Primitive.Types import Cardano.Wallet.Network - ( ErrGetBlock (..) - , ErrNetworkTip (..) + ( Cursor + , ErrCurrentNodeTip (..) + , ErrGetBlock (..) , ErrNetworkUnavailable (..) , ErrPostTx (..) , FollowAction (..) @@ -40,11 +42,11 @@ spec = do describe "Pointless tests to cover 'Show' instances for errors" $ do testShow $ ErrNetworkUnreachable mempty testShow $ ErrNetworkInvalid mempty - testShow $ ErrNetworkTipNetworkUnreachable + testShow $ ErrCurrentNodeTipNetworkUnreachable $ ErrNetworkUnreachable mempty - testShow $ ErrNetworkTipNetworkUnreachable + testShow $ ErrCurrentNodeTipNetworkUnreachable $ ErrNetworkInvalid mempty - testShow ErrNetworkTipNotFound + testShow ErrCurrentNodeTipNotFound testShow $ ErrGetBlockNetworkUnreachable $ ErrNetworkUnreachable mempty testShow $ ErrGetBlockNetworkUnreachable @@ -81,13 +83,15 @@ followSpec = e@MsgUnhandledException{} -> Just e _ -> Nothing + +data instance (Cursor DummyTarget) = DummyCursor + mockNetworkLayer :: NetworkLayer IO DummyTarget Block mockNetworkLayer = NetworkLayer { nextBlocks = \_ -> error "no next blocks" - , findIntersection = \_ -> error "no find intersection" - , initCursor = \_ -> error "no init cursor" + , initCursor = \_ -> pure DummyCursor , cursorSlotId = \_ -> error "no cursor slot id" - , networkTip = error "there is no network tip" + , currentNodeTip = error "there is no current node tip" , postTx = \_ -> error "the tx is not a thing that can be posted" , staticBlockchainParameters = error "static blockchain params don't exist" , stakeDistribution = error "stake? no." diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index 5ce040e8ad3..908e7a5e36a 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/lib/core/test/unit/Cardano/WalletSpec.hs @@ -75,7 +75,6 @@ import Cardano.Wallet.Primitive.Types , TxMeta (..) , TxOut (..) , TxStatus (..) - , TxWitness (..) , WalletId (..) , WalletMetadata (..) , WalletName (..) @@ -434,8 +433,7 @@ dummyTransactionLayer = TransactionLayer (ErrKeyNotFoundForAddress addr) $ keyFrom addr let (Hash sigData) = txId tx let sig = CC.unXSignature $ CC.sign pwd (getKey xprv) sigData - return $ TxWitness - (CC.unXPub (getKey $ publicKey xprv) <> sig) + return $ CC.unXPub (getKey $ publicKey xprv) <> sig -- (tx1, wit1) == (tx2, wit2) <==> fakebinary1 == fakebinary2 let fakeBinary = SealedTx . B8.pack $ show (tx, wit) diff --git a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs index 171ec211f6b..23f4a2a0076 100644 --- a/lib/jormungandr/exe/cardano-wallet-jormungandr.hs +++ b/lib/jormungandr/exe/cardano-wallet-jormungandr.hs @@ -29,7 +29,8 @@ import Cardano.BM.Data.Severity import Cardano.BM.Trace ( Trace, appendName, logDebug, logInfo ) import Cardano.CLI - ( Port (..) + ( LoggingOptions (..) + , Port (..) , cli , cmdAddress , cmdMnemonic @@ -41,11 +42,11 @@ import Cardano.CLI , databaseOption , enableWindowsANSI , getDataDir + , helperTracing , hostPreferenceOption , listenOption - , loggingSeverities + , loggingOptions , loggingSeverityOrOffReader - , loggingSeverityReader , nodePortMaybeOption , nodePortOption , optionT @@ -94,23 +95,17 @@ import Data.Text ( Text ) import Data.Text.Class ( ToText (..) ) -import Data.Void - ( Void ) import Network.Socket ( SockAddr ) import Options.Applicative ( CommandFields , Mod - , ParseError (InfoMsg) , Parser - , abortOption , argument - , auto , command , footerDoc , help , helper - , hidden , info , internal , long @@ -184,7 +179,7 @@ data LaunchArgs = LaunchArgs , _nodePort :: Maybe (Port "Node") , _stateDir :: Maybe FilePath , _syncTolerance :: SyncTolerance - , _logging :: LoggingOptions + , _logging :: LoggingOptions TracerSeverities , _jormungandrArgs :: JormungandrArgs } deriving (Show, Eq) @@ -196,7 +191,7 @@ data JormungandrArgs = JormungandrArgs cmdLaunch :: FilePath -> Mod CommandFields (IO ()) -cmdLaunch dataDir = command "launch" $ info (helper <*> helperTracing <*> cmd) $ mempty +cmdLaunch dataDir = command "launch" $ info (helper <*> helper' <*> cmd) $ mempty <> progDesc "Launch and monitor a wallet server and its chain producers." <> footerDoc (Just $ D.empty <> D.text "Examples:" @@ -219,13 +214,15 @@ cmdLaunch dataDir = command "launch" $ info (helper <*> helperTracing <*> cmd) $ <> D.text "not to define any these configuration settings." ) where + helper' = helperTracing tracerDescriptions + cmd = fmap exec $ LaunchArgs <$> hostPreferenceOption <*> listenOption <*> nodePortMaybeOption <*> stateDirOption dataDir <*> syncToleranceOption - <*> loggingOptions + <*> loggingOptions tracerSeveritiesOption <*> (JormungandrArgs <$> genesisBlockOption <*> extraArguments) @@ -267,14 +264,16 @@ data ServeArgs = ServeArgs , _database :: Maybe FilePath , _syncTolerance :: SyncTolerance , _block0H :: Hash "Genesis" - , _logging :: LoggingOptions + , _logging :: LoggingOptions TracerSeverities } deriving (Show, Eq) cmdServe :: Mod CommandFields (IO ()) -cmdServe = command "serve" $ info (helper <*> helperTracing <*> cmd) $ mempty +cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty <> progDesc "Serve API that listens for commands/actions." where + helper' = helperTracing tracerDescriptions + cmd = fmap exec $ ServeArgs <$> hostPreferenceOption <*> listenOption @@ -282,7 +281,7 @@ cmdServe = command "serve" $ info (helper <*> helperTracing <*> cmd) $ mempty <*> optional databaseOption <*> syncToleranceOption <*> genesisHashOption - <*> loggingOptions + <*> loggingOptions tracerSeveritiesOption exec :: ServeArgs -> IO () @@ -351,39 +350,8 @@ extraArguments = many $ argument jmArg $ mempty <> " command.\nIf you need to use this option," <> " run Jörmungandr separately and use 'serve'." -data LoggingOptions = LoggingOptions - { loggingMinSeverity :: Severity - , loggingTracers :: TracerSeverities - , loggingTracersDoc :: Maybe Void - } deriving (Show, Eq) - -loggingOptions :: Parser LoggingOptions -loggingOptions = LoggingOptions - <$> minSev - <*> loggingTracersOptions - <*> tracersDoc - where - -- Note: If the global log level is Info then there will be no Debug-level - -- messages whatsoever. - -- If the global log level is Debug then there will be Debug, Info, and - -- higher-severity messages. - -- So the default global log level is Debug. - minSev = option loggingSeverityReader $ mempty - <> long "log-level" - <> value Debug - <> metavar "SEVERITY" - <> help "Global minimum severity for a message to be logged. \ - \Individual tracers severities still need to be configured \ - \independently. Defaults to \"DEBUG\"." - <> hidden - tracersDoc = optional $ option auto $ mempty - <> long "trace-NAME" - <> metavar "SEVERITY" - <> help "Individual component severity for 'NAME'. See --help-tracing \ - \for details and available tracers." - -loggingTracersOptions :: Parser TracerSeverities -loggingTracersOptions = Tracers +tracerSeveritiesOption :: Parser TracerSeverities +tracerSeveritiesOption = Tracers <$> traceOpt applicationTracer (Just Info) <*> traceOpt apiServerTracer (Just Info) <*> traceOpt walletEngineTracer (Just Info) @@ -399,41 +367,6 @@ loggingTracersOptions = Tracers <> metavar "SEVERITY" <> internal --- | A hidden "helper" option which always fails, but shows info about the --- logging options. -helperTracing :: Parser (a -> a) -helperTracing = abortOption (InfoMsg helperTracingText) $ mempty - <> long "help-tracing" - <> help "Show help for tracing options" - <> hidden - -helperTracingText :: String -helperTracingText = unlines $ - [ "Additional tracing options:" - , "" - , " --log-level SEVERITY Global minimum severity for a message to be logged." - , " Defaults to \"DEBUG\"." - , "" - , " --trace-NAME=off Disable logging on the given tracer." - , " --trace-NAME=SEVERITY Minimum severity for a message to be logged, or" - , " \"off\" to disable the tracer. Note that component" - , " traces still abide by the global log-level. For" - , " example, if the global log level is \"INFO\", then" - , " there will be no \"DEBUG\" messages whatsoever." - , " Defaults to \"INFO\"." - , "" - , "The possible log levels (lowest to highest) are:" - , " " ++ unwords (map fst loggingSeverities) - , "" - , "The possible tracers are:" - ] ++ [ pretty name desc | (name, desc) <- tracerDescriptions] - where - maxLength = maximum $ map (length . fst) tracerDescriptions - pretty name desc = - " " ++ padRight maxLength ' ' name ++ " " ++ desc - where - padRight n char str = take n $ str ++ replicate n char - {------------------------------------------------------------------------------- Logging -------------------------------------------------------------------------------} @@ -461,7 +394,10 @@ instance ToText MainLog where MsgListenAddress addr -> "Wallet backend server listening on " <> T.pack (show addr) -withTracers :: LoggingOptions -> (Trace IO MainLog -> Tracers IO -> IO a) -> IO a +withTracers + :: LoggingOptions TracerSeverities + -> (Trace IO MainLog -> Tracers IO -> IO a) + -> IO a withTracers logOpt action = withLogging Nothing (loggingMinSeverity logOpt) $ \(_, tr) -> do let trMain = appendName "main" (transformTextTrace tr) diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs index d35084cd9da..f00f7f49292 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs @@ -67,7 +67,7 @@ import Cardano.Pool.Metrics import Cardano.Wallet ( WalletLog ) import Cardano.Wallet.Api - ( ApiLayer ) + ( ApiLayer, ApiV2 ) import Cardano.Wallet.Api.Server ( HostPreference, Listen (..), ListenError (..) ) import Cardano.Wallet.Api.Types @@ -149,6 +149,8 @@ import Data.Functor.Contravariant ( contramap ) import Data.Maybe ( fromMaybe ) +import Data.Proxy + ( Proxy (..) ) import Data.Quantity ( Quantity (..) ) import Data.Text @@ -250,7 +252,9 @@ serveWallet Tracers{..} sTolerance databaseDir hostPref listen backend beforeMai sockAddr <- getSocketName socket let settings = Warp.defaultSettings & setBeforeMainLoop (beforeMainLoop sockAddr nPort bp) - Server.start settings apiServerTracer socket byron icarus shelley pools + let application = Server.serve (Proxy @(ApiV2 n)) + $ Server.server byron icarus shelley pools + Server.start settings apiServerTracer socket application apiLayer :: forall s k. diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Client.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Client.hs index 8768987e861..52ef77ff403 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Client.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api/Client.hs @@ -33,7 +33,7 @@ module Cardano.Wallet.Jormungandr.Api.Client , ErrGetBlock (..) , ErrGetBlockchainParams (..) , ErrGetDescendants (..) - , ErrNetworkTip (..) + , ErrCurrentNodeTip (..) , ErrNetworkUnavailable (..) , ErrPostTx (..) , ErrUnexpectedNetworkFailure (..) @@ -68,8 +68,8 @@ import Cardano.Wallet.Jormungandr.Binary import Cardano.Wallet.Jormungandr.Compatibility ( softTxMaxSize ) import Cardano.Wallet.Network - ( ErrGetBlock (..) - , ErrNetworkTip (..) + ( ErrCurrentNodeTip (..) + , ErrGetBlock (..) , ErrNetworkUnavailable (..) , ErrPostTx (..) ) @@ -406,10 +406,10 @@ data ErrGetBlockchainParams class LiftError lift where liftE :: lift -instance LiftError (ErrGetBlock -> ErrNetworkTip) where +instance LiftError (ErrGetBlock -> ErrCurrentNodeTip) where liftE = \case - ErrGetBlockNotFound _ -> ErrNetworkTipNotFound - ErrGetBlockNetworkUnreachable e -> ErrNetworkTipNetworkUnreachable e + ErrGetBlockNotFound _ -> ErrCurrentNodeTipNotFound + ErrGetBlockNetworkUnreachable e -> ErrCurrentNodeTipNetworkUnreachable e instance LiftError (ErrNetworkUnavailable -> ErrGetBlock) where liftE = diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs index b378d4b6e9e..f560947f46f 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs @@ -114,7 +114,6 @@ import Cardano.Wallet.Primitive.Types , Tx (..) , TxIn (..) , TxOut (..) - , TxWitness (..) , unsafeEpochNo ) import Control.DeepSeq @@ -467,13 +466,11 @@ getGenericTransaction tid = label "getGenericTransaction" $ do _wits <- replicateM witnessCount getWitness return $ Tx tid ins outs where - getWitness :: Get TxWitness + getWitness :: Get ByteString getWitness = do tag <- lookAhead getTxWitnessTag let len = txWitnessSize tag + txWitnessTagSize - -- NOTE: Regardless of the type of witness, we decode it as a - -- @TxWitness@. - TxWitness <$> getByteString len + getByteString len getTokenTransfer :: Get ([(TxIn, Coin)], [TxOut]) getTokenTransfer = label "getTokenTransfer" $ do diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs index 86fb775e9ba..bb44bc2d9a0 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs +++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs @@ -7,6 +7,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} @@ -41,7 +42,7 @@ module Cardano.Wallet.Jormungandr.Network , ErrGetBlock (..) , ErrGetBlockchainParams (..) , ErrGetDescendants (..) - , ErrNetworkTip (..) + , ErrCurrentNodeTip (..) , ErrNetworkUnavailable (..) , ErrPostTx (..) , ErrStartup (..) @@ -54,6 +55,7 @@ module Cardano.Wallet.Jormungandr.Network , mkRawNetworkLayer , BaseUrl (..) , Scheme (..) + , pattern Cursor ) where import Prelude @@ -71,11 +73,11 @@ import Cardano.Launcher ) import Cardano.Wallet.Jormungandr.Api.Client ( BaseUrl (..) + , ErrCurrentNodeTip (..) , ErrGetAccountState (..) , ErrGetBlock (..) , ErrGetBlockchainParams (..) , ErrGetDescendants (..) - , ErrNetworkTip (..) , ErrNetworkUnavailable (..) , ErrPostTx (..) , ErrUnexpectedNetworkFailure (..) @@ -274,11 +276,8 @@ mkRawNetworkLayer -> JormungandrClient m -> NetworkLayer m t block mkRawNetworkLayer (block0, bp) batchSize st j = NetworkLayer - { networkTip = - _networkTip - - , findIntersection = - _findIntersection + { currentNodeTip = + _currentNodeTip , nextBlocks = _nextBlocks @@ -315,22 +314,17 @@ mkRawNetworkLayer (block0, bp) batchSize st j = NetworkLayer genesis :: Hash "Genesis" genesis = getGenesisBlockHash bp - _networkTip :: ExceptT ErrNetworkTip m BlockHeader - _networkTip = modifyMVar st $ \bs -> do + _currentNodeTip :: ExceptT ErrCurrentNodeTip m BlockHeader + _currentNodeTip = modifyMVar st $ \bs -> do let tip = withExceptT liftE $ getTipId j bs' <- withExceptT liftE $ updateUnstableBlocks k tip (getBlockHeader j) bs ExceptT . pure $ case blockHeadersTip bs' of Just t -> Right (bs', t) - Nothing -> Left ErrNetworkTipNotFound - - _findIntersection :: Cursor t -> m (Maybe BlockHeader) - _findIntersection (Cursor localChain) = do - nodeChain <- readMVar st - pure (greatestCommonBlockHeader nodeChain localChain) + Nothing -> Left ErrCurrentNodeTipNotFound - _initCursor :: [BlockHeader] -> Cursor t + _initCursor :: [BlockHeader] -> m (Cursor t) _initCursor bhs = - Cursor $ appendBlockHeaders k emptyBlockHeaders bhs + pure $ Cursor $ appendBlockHeaders k emptyBlockHeaders bhs _cursorSlotId :: Cursor t -> SlotId _cursorSlotId (Cursor unstable) = @@ -362,7 +356,7 @@ mkRawNetworkLayer (block0, bp) batchSize st j = NetworkLayer :: Cursor t -> ExceptT ErrGetBlock m (NextBlocksResult t block) _nextBlocks cursor@(Cursor localChain) = do - lift (runExceptT _networkTip) >>= \case + lift (runExceptT _currentNodeTip) >>= \case Right _ -> do unstable <- readMVar st case direction cursor unstable of @@ -389,10 +383,10 @@ mkRawNetworkLayer (block0, bp) batchSize st j = NetworkLayer Restart -> pure (recover localChain) - Left ErrNetworkTipNotFound -> + Left ErrCurrentNodeTipNotFound -> pure AwaitReply - Left (ErrNetworkTipNetworkUnreachable e) -> + Left (ErrCurrentNodeTipNetworkUnreachable e) -> throwE (ErrGetBlockNetworkUnreachable e) where tryRollForward diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs index 6316e9e24bb..a336b216e7d 100644 --- a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs +++ b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs @@ -46,8 +46,8 @@ import Cardano.Wallet.Jormungandr.Network , withNetworkLayer ) import Cardano.Wallet.Network - ( ErrGetBlock (..) - , ErrNetworkTip (..) + ( ErrCurrentNodeTip (..) + , ErrGetBlock (..) , NetworkLayer (..) , NextBlocksResult (..) ) @@ -145,7 +145,7 @@ spec = do } it "get network tip" $ \(nw, _) -> do - resp <- runExceptT $ networkTip nw + resp <- runExceptT $ currentNodeTip nw resp `shouldSatisfy` isRight let (Right slot) = slotId <$> resp let (Right height) = blockHeight <$> resp @@ -154,14 +154,14 @@ spec = do it "get some blocks from the genesis" $ \(nw, _) -> do threadDelay (10 * second) - resp <- runExceptT $ nextBlocks nw (initCursor nw []) + resp <- (runExceptT . nextBlocks nw) =<< initCursor nw [] resp `shouldSatisfy` isRight resp `shouldSatisfy` (not . null) it "no blocks after the tip" $ \(nw, _) -> do let attempt = do - tip <- unsafeRunExceptT $ networkTip nw - runExceptT $ nextBlocks nw (initCursor nw [tip]) + tip <- unsafeRunExceptT $ currentNodeTip nw + (runExceptT . nextBlocks nw) =<< initCursor nw [tip] -- NOTE Retrying twice since between the moment we fetch the -- tip and the moment we get the next blocks, one block may be -- inserted. @@ -183,7 +183,7 @@ spec = do , headerHash = Hash bytes , parentHeaderHash = Hash bytes } - resp <- runExceptT $ nextBlocks nw (initCursor nw [block]) + resp <- (runExceptT . nextBlocks nw) =<< initCursor nw [block] fmap (isRollBackwardTo nw (SlotId 0 0)) resp `shouldBe` Right True @@ -204,15 +204,15 @@ spec = do let dummyUrl = BaseUrl Http "localhost" port "/api" newBrokenNetworkLayer dummyUrl - it "networkTip: ErrNetworkUnreachable" $ do + it "currentNodeTip: ErrNetworkUnreachable" $ do nw <- makeUnreachableNetworkLayer let msg x = "Expected a ErrNetworkUnreachable' failure but got " <> show x let action = do - res <- runExceptT $ networkTip nw + res <- runExceptT $ currentNodeTip nw res `shouldSatisfy` \case - Left (ErrNetworkTipNetworkUnreachable e) -> + Left (ErrCurrentNodeTipNetworkUnreachable e) -> show e `deepseq` True _ -> error (msg res) @@ -224,7 +224,7 @@ spec = do "Expected a ErrNetworkUnreachable' failure but got " <> show x let action = do - res <- runExceptT $ nextBlocks nw (initCursor nw []) + res <- (runExceptT . nextBlocks nw) =<< initCursor nw [] res `shouldSatisfy` \case Left (ErrGetBlockNetworkUnreachable e) -> show e `deepseq` True @@ -232,11 +232,11 @@ spec = do error (msg res) action `shouldReturn` () - it "networkTip: throws on invalid url" $ + it "currentNodeTip: throws on invalid url" $ startNode $ \(_nw, url) -> do let wrongUrl = url { baseUrlPath = "/not-valid-prefix" } wrongNw <- newBrokenNetworkLayer wrongUrl - let io = void $ runExceptT $ networkTip wrongNw + let io = void $ runExceptT $ currentNodeTip wrongNw shouldThrow io $ \(ErrUnexpectedNetworkFailure link _) -> show link == show (safeLink api (Proxy @GetTipId)) diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/NetworkSpec.hs index f4d3012e056..72ee8fade06 100644 --- a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/NetworkSpec.hs +++ b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/NetworkSpec.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -19,11 +20,11 @@ import Cardano.Wallet.Jormungandr.Api.Client import Cardano.Wallet.Jormungandr.Compatibility ( Jormungandr ) import Cardano.Wallet.Jormungandr.Network - ( ErrGetDescendants (..), mkRawNetworkLayer ) + ( pattern Cursor, ErrGetDescendants (..), mkRawNetworkLayer ) import Cardano.Wallet.Network ( Cursor, ErrGetBlock (..), NetworkLayer (..), NextBlocksResult (..) ) import Cardano.Wallet.Network.BlockHeaders - ( emptyBlockHeaders ) + ( BlockHeaders, emptyBlockHeaders, greatestCommonBlockHeader ) import Cardano.Wallet.Primitive.Types ( BlockHeader (..) , BlockchainParameters (..) @@ -32,7 +33,7 @@ import Cardano.Wallet.Primitive.Types , SlotNo (unSlotNo) ) import Control.Concurrent.MVar.Lifted - ( newMVar ) + ( MVar, newMVar, readMVar ) import Control.Monad.Fail ( MonadFail ) import Control.Monad.Trans.Class @@ -121,9 +122,10 @@ prop_sync s0 = monadicIO $ do (c0Chain, c0Cps) <- pick $ genConsumer s0 (consumer, s) <- run $ flip runStateT s0 $ do -- Set up network layer with mock Jormungandr - nl <- mockNetworkLayer logLine - let c0 = (C c0Chain (initCursor nl c0Cps) 0 0) - consumerRestoreStep logLineC nl c0 Nothing + nXl@(nl, _) <- mockNetworkLayer logLine + cursor <- initCursor nl c0Cps + let c0 = C c0Chain cursor 0 0 + consumerRestoreStep logLineC nXl c0 Nothing let nodeChain = getNodeChain (node s) monitor $ counterexample $ unlines @@ -280,7 +282,7 @@ consumerRestoreStep :: (Monad m) => (String -> StateT S m ()) -- ^ logger function - -> TestNetworkLayer m + -> (TestNetworkLayer m, Cursor Jormungandr -> m (Maybe BlockHeader)) -- ^ Network layer. -> Consumer -- ^ Current consumer state. @@ -290,7 +292,7 @@ consumerRestoreStep -- eventually be in sync. -> StateT S m Consumer consumerRestoreStep _ _ c (Just 0) = pure c -consumerRestoreStep logLine nw (C bs cur hit total) mLimit = do +consumerRestoreStep logLine nXw@(nw, findIntersection) (C bs cur hit total) mLimit = do -- We apply blocks by batch of `k`, so, when the node stabilizes, we should -- finish in less than the chain length divided by k steps. S n ops (Quantity k) _ <- get @@ -300,25 +302,26 @@ consumerRestoreStep logLine nw (C bs cur hit total) mLimit = do then Just (2 + length (nodeChainIds n) `div` fromIntegral k) else Nothing logLine $ "nextBlocks " <> show (cursorSlotId nw cur) - hit' <- findIntersection nw cur <&> \case + hit' <- lift (findIntersection cur) <&> \case Nothing -> hit Just _ -> hit + 1 let total' = total + 1 runExceptT (nextBlocks nw cur) >>= \case Left e -> do logLine ("Failed to get next blocks: " ++ show e) - consumerRestoreStep logLine nw (C bs cur hit' total') limit + consumerRestoreStep logLine nXw (C bs cur hit' total') limit Right AwaitReply -> do logLine "AwaitReply" - consumerRestoreStep logLine nw (C bs cur hit' total') limit + consumerRestoreStep logLine nXw (C bs cur hit' total') limit Right (RollForward cur' _ bs') -> do logLine $ "RollForward " <> unwords (showBlock <$> bs') - consumerRestoreStep logLine nw (C (bs ++ bs') cur' hit' total') limit + consumerRestoreStep logLine nXw (C (bs ++ bs') cur' hit' total') limit Right (RollBackward cur') -> do logLine $ "RollBackward " <> show (cursorSlotId nw cur') let sl = cursorSlotId nw cur' let bs' = takeWhile (\b -> mockBlockSlot b <= sl) bs - consumerRestoreStep logLine nw (C bs' cur' hit' total') limit + consumerRestoreStep logLine nXw (C bs' cur' hit' total') limit + ---------------------------------------------------------------------------- -- Network layer with mock jormungandr node @@ -330,13 +333,21 @@ type TestNetworkLayer m = mockNetworkLayer :: forall m. (MonadFail m, MonadBaseControl IO m) => (String -> StateT S m ()) -- ^ logger function - -> StateT S m (TestNetworkLayer m) + -> StateT S m (TestNetworkLayer m, Cursor Jormungandr -> m (Maybe BlockHeader)) mockNetworkLayer logLine = do let jm = mockJormungandrClient logLine Quantity k <- gets mockNodeK st <- newMVar emptyBlockHeaders Right (b0,bp) <- runExceptT $ getInitialBlockchainParameters jm genesisHash - pure $ fromJBlock <$> mkRawNetworkLayer (b0, bp) (fromIntegral k) st jm + pure + ( fromJBlock <$> mkRawNetworkLayer (b0, bp) (fromIntegral k) st jm + , findIntersection st + ) + where + findIntersection :: MVar BlockHeaders -> Cursor Jormungandr -> m (Maybe BlockHeader) + findIntersection st (Cursor localChain) = do + nodeChain <- readMVar st + pure (greatestCommonBlockHeader nodeChain localChain) -- | A network layer which returns mock blocks and mutates its state according -- to the generated operations. diff --git a/nix/.stack.nix/cardano-binary-test.nix b/nix/.stack.nix/cardano-binary-test.nix new file mode 100644 index 00000000000..a78585ac849 --- /dev/null +++ b/nix/.stack.nix/cardano-binary-test.nix @@ -0,0 +1,86 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-binary-test"; version = "1.3.0"; }; + license = "MIT"; + copyright = "2019 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Test helpers from cardano-binary exposed to other packages"; + description = "Test helpers from cardano-binary exposed to other packages"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."hspec" or (buildDepError "hspec")) + (hsPkgs."pretty-show" or (buildDepError "pretty-show")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."quickcheck-instances" or (buildDepError "quickcheck-instances")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-base"; + rev = "468d9b79ae3ac28f5f2cbb3ce52623a69923c4ef"; + sha256 = "13hcbgmcg3zzllii95r6qr9mkch6p4lf9ds04ar5jpnbc2az284q"; + }); + postUnpack = "sourceRoot+=/binary/test; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-binary.nix b/nix/.stack.nix/cardano-binary.nix new file mode 100644 index 00000000000..0582380f59b --- /dev/null +++ b/nix/.stack.nix/cardano-binary.nix @@ -0,0 +1,108 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-binary"; version = "1.5.0"; }; + license = "MIT"; + copyright = "2019 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Binary serialization for Cardano"; + description = "This package includes the binary serialization format for Cardano"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."aeson" or (buildDepError "aeson")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."digest" or (buildDepError "digest")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."recursion-schemes" or (buildDepError "recursion-schemes")) + (hsPkgs."safe-exceptions" or (buildDepError "safe-exceptions")) + (hsPkgs."tagged" or (buildDepError "tagged")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + tests = { + "test" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."hspec" or (buildDepError "hspec")) + (hsPkgs."pretty-show" or (buildDepError "pretty-show")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."quickcheck-instances" or (buildDepError "quickcheck-instances")) + (hsPkgs."tagged" or (buildDepError "tagged")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-base"; + rev = "468d9b79ae3ac28f5f2cbb3ce52623a69923c4ef"; + sha256 = "13hcbgmcg3zzllii95r6qr9mkch6p4lf9ds04ar5jpnbc2az284q"; + }); + postUnpack = "sourceRoot+=/binary; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-crypto-class.nix b/nix/.stack.nix/cardano-crypto-class.nix new file mode 100644 index 00000000000..02e7149aa0e --- /dev/null +++ b/nix/.stack.nix/cardano-crypto-class.nix @@ -0,0 +1,97 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-crypto-class"; version = "2.0.0"; }; + license = "MIT"; + copyright = "2019 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Type classes abstracting over cryptography primitives for Cardano"; + description = "Type classes abstracting over cryptography primitives for Cardano"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."deepseq" or (buildDepError "deepseq")) + (hsPkgs."memory" or (buildDepError "memory")) + (hsPkgs."reflection" or (buildDepError "reflection")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + tests = { + "test-crypto" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto-class" or (buildDepError "cardano-crypto-class")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-base"; + rev = "468d9b79ae3ac28f5f2cbb3ce52623a69923c4ef"; + sha256 = "13hcbgmcg3zzllii95r6qr9mkch6p4lf9ds04ar5jpnbc2az284q"; + }); + postUnpack = "sourceRoot+=/cardano-crypto-class; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-crypto-test.nix b/nix/.stack.nix/cardano-crypto-test.nix new file mode 100644 index 00000000000..de2adb0dabe --- /dev/null +++ b/nix/.stack.nix/cardano-crypto-test.nix @@ -0,0 +1,82 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-crypto-test"; version = "1.3.0"; }; + license = "MIT"; + copyright = "2018 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Test helpers from cardano-crypto exposed to other packages"; + description = "Test helpers from cardano-crypto exposed to other packages"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-binary-test" or (buildDepError "cardano-binary-test")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."memory" or (buildDepError "memory")) + ]; + buildable = true; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-ledger"; + rev = "dbdb643722e431e4d232345a0eafdc7bdeab7b60"; + sha256 = "0vql7f53dq8zf595l3kzdzssz5801pz6z140q5fpnk38kr97s9da"; + }); + postUnpack = "sourceRoot+=/crypto/test; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-crypto-wrapper.nix b/nix/.stack.nix/cardano-crypto-wrapper.nix new file mode 100644 index 00000000000..12f7aa7a383 --- /dev/null +++ b/nix/.stack.nix/cardano-crypto-wrapper.nix @@ -0,0 +1,109 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-crypto-wrapper"; version = "1.3.0"; }; + license = "MIT"; + copyright = "2019 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Cryptographic primitives used in the Cardano project"; + description = "Cryptographic primitives used in the Cardano project"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."aeson" or (buildDepError "aeson")) + (hsPkgs."base64-bytestring" or (buildDepError "base64-bytestring")) + (hsPkgs."base64-bytestring-type" or (buildDepError "base64-bytestring-type")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."canonical-json" or (buildDepError "canonical-json")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."cryptonite-openssl" or (buildDepError "cryptonite-openssl")) + (hsPkgs."data-default" or (buildDepError "data-default")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."memory" or (buildDepError "memory")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."scrypt" or (buildDepError "scrypt")) + (hsPkgs."text" or (buildDepError "text")) + ]; + buildable = true; + }; + tests = { + "test" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-binary-test" or (buildDepError "cardano-binary-test")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."memory" or (buildDepError "memory")) + (hsPkgs."text" or (buildDepError "text")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-ledger"; + rev = "dbdb643722e431e4d232345a0eafdc7bdeab7b60"; + sha256 = "0vql7f53dq8zf595l3kzdzssz5801pz6z140q5fpnk38kr97s9da"; + }); + postUnpack = "sourceRoot+=/crypto; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-ledger-test.nix b/nix/.stack.nix/cardano-ledger-test.nix new file mode 100644 index 00000000000..f239ddffeaf --- /dev/null +++ b/nix/.stack.nix/cardano-ledger-test.nix @@ -0,0 +1,103 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-ledger-test"; version = "1.3.0"; }; + license = "MIT"; + copyright = "2018 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Test helpers from cardano-ledger exposed to other packages"; + description = "Test helpers from cardano-ledger exposed to other packages"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bimap" or (buildDepError "bimap")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-binary-test" or (buildDepError "cardano-binary-test")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (hsPkgs."cardano-crypto-test" or (buildDepError "cardano-crypto-test")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."cs-blockchain" or (buildDepError "cs-blockchain")) + (hsPkgs."cs-ledger" or (buildDepError "cs-ledger")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."filepath" or (buildDepError "filepath")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."generic-monoid" or (buildDepError "generic-monoid")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."lens" or (buildDepError "lens")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) + (hsPkgs."resourcet" or (buildDepError "resourcet")) + (hsPkgs."small-steps" or (buildDepError "small-steps")) + (hsPkgs."streaming" or (buildDepError "streaming")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-hedgehog" or (buildDepError "tasty-hedgehog")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-ledger"; + rev = "dbdb643722e431e4d232345a0eafdc7bdeab7b60"; + sha256 = "0vql7f53dq8zf595l3kzdzssz5801pz6z140q5fpnk38kr97s9da"; + }); + postUnpack = "sourceRoot+=/cardano-ledger/test; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-ledger.nix b/nix/.stack.nix/cardano-ledger.nix new file mode 100644 index 00000000000..f94a50af08a --- /dev/null +++ b/nix/.stack.nix/cardano-ledger.nix @@ -0,0 +1,167 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; test-normal-form = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-ledger"; version = "0.1.0.0"; }; + license = "MIT"; + copyright = "2018 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "The blockchain layer of Cardano"; + description = "The blockchain layer of Cardano"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."base58-bytestring" or (buildDepError "base58-bytestring")) + (hsPkgs."base64-bytestring-type" or (buildDepError "base64-bytestring-type")) + (hsPkgs."bimap" or (buildDepError "bimap")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."canonical-json" or (buildDepError "canonical-json")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."concurrency" or (buildDepError "concurrency")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."Cabal" or (buildDepError "Cabal")) + (hsPkgs."deepseq" or (buildDepError "deepseq")) + (hsPkgs."digest" or (buildDepError "digest")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."filepath" or (buildDepError "filepath")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."megaparsec" or (buildDepError "megaparsec")) + (hsPkgs."memory" or (buildDepError "memory")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."resourcet" or (buildDepError "resourcet")) + (hsPkgs."streaming" or (buildDepError "streaming")) + (hsPkgs."streaming-binary" or (buildDepError "streaming-binary")) + (hsPkgs."streaming-bytestring" or (buildDepError "streaming-bytestring")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + tests = { + "cardano-ledger-test" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bimap" or (buildDepError "bimap")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-binary-test" or (buildDepError "cardano-binary-test")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (hsPkgs."cardano-crypto-test" or (buildDepError "cardano-crypto-test")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."cs-blockchain" or (buildDepError "cs-blockchain")) + (hsPkgs."cs-ledger" or (buildDepError "cs-ledger")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."filepath" or (buildDepError "filepath")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."generic-monoid" or (buildDepError "generic-monoid")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."lens" or (buildDepError "lens")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) + (hsPkgs."resourcet" or (buildDepError "resourcet")) + (hsPkgs."small-steps" or (buildDepError "small-steps")) + (hsPkgs."streaming" or (buildDepError "streaming")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-hedgehog" or (buildDepError "tasty-hedgehog")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + "epoch-validation-normal-form-test" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."cardano-crypto-test" or (buildDepError "cardano-crypto-test")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-prelude-test" or (buildDepError "cardano-prelude-test")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."filepath" or (buildDepError "filepath")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) + (hsPkgs."resourcet" or (buildDepError "resourcet")) + (hsPkgs."silently" or (buildDepError "silently")) + (hsPkgs."streaming" or (buildDepError "streaming")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-hedgehog" or (buildDepError "tasty-hedgehog")) + ]; + buildable = if !flags.test-normal-form then false else true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-ledger"; + rev = "dbdb643722e431e4d232345a0eafdc7bdeab7b60"; + sha256 = "0vql7f53dq8zf595l3kzdzssz5801pz6z140q5fpnk38kr97s9da"; + }); + postUnpack = "sourceRoot+=/cardano-ledger; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-prelude-test.nix b/nix/.stack.nix/cardano-prelude-test.nix new file mode 100644 index 00000000000..9ca60793457 --- /dev/null +++ b/nix/.stack.nix/cardano-prelude-test.nix @@ -0,0 +1,90 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-prelude-test"; version = "0.1.0.0"; }; + license = "MIT"; + copyright = "2018 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "Utility types and functions for testing Cardano"; + description = "Utility types and functions for testing Cardano"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."aeson" or (buildDepError "aeson")) + (hsPkgs."aeson-pretty" or (buildDepError "aeson-pretty")) + (hsPkgs."attoparsec" or (buildDepError "attoparsec")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."canonical-json" or (buildDepError "canonical-json")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."hspec" or (buildDepError "hspec")) + (hsPkgs."pretty-show" or (buildDepError "pretty-show")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."quickcheck-instances" or (buildDepError "quickcheck-instances")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."template-haskell" or (buildDepError "template-haskell")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-prelude"; + rev = "3c40edcf5bdba8721d3430d0aaaeea8770ce9bec"; + sha256 = "1z77nwjxj0v9gxhs3mlmqfq705mkkcpnwgr0d8shykjvf0iqdkcn"; + }); + postUnpack = "sourceRoot+=/test; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-prelude.nix b/nix/.stack.nix/cardano-prelude.nix new file mode 100644 index 00000000000..ea48c90e3b3 --- /dev/null +++ b/nix/.stack.nix/cardano-prelude.nix @@ -0,0 +1,119 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-prelude"; version = "0.1.0.0"; }; + license = "MIT"; + copyright = "2018 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK"; + homepage = ""; + url = ""; + synopsis = "A Prelude replacement for the Cardano project"; + description = "A Prelude replacement for the Cardano project"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."aeson" or (buildDepError "aeson")) + (hsPkgs."array" or (buildDepError "array")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."canonical-json" or (buildDepError "canonical-json")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."ghc-heap" or (buildDepError "ghc-heap")) + (hsPkgs."ghc-prim" or (buildDepError "ghc-prim")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."integer-gmp" or (buildDepError "integer-gmp")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."nonempty-containers" or (buildDepError "nonempty-containers")) + (hsPkgs."protolude" or (buildDepError "protolude")) + (hsPkgs."tagged" or (buildDepError "tagged")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."vector" or (buildDepError "vector")) + ]; + buildable = true; + }; + tests = { + "cardano-prelude-test" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."aeson" or (buildDepError "aeson")) + (hsPkgs."aeson-pretty" or (buildDepError "aeson-pretty")) + (hsPkgs."attoparsec" or (buildDepError "attoparsec")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."canonical-json" or (buildDepError "canonical-json")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."ghc-heap" or (buildDepError "ghc-heap")) + (hsPkgs."ghc-prim" or (buildDepError "ghc-prim")) + (hsPkgs."hedgehog" or (buildDepError "hedgehog")) + (hsPkgs."hspec" or (buildDepError "hspec")) + (hsPkgs."pretty-show" or (buildDepError "pretty-show")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."quickcheck-instances" or (buildDepError "quickcheck-instances")) + (hsPkgs."random" or (buildDepError "random")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."template-haskell" or (buildDepError "template-haskell")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-prelude"; + rev = "3c40edcf5bdba8721d3430d0aaaeea8770ce9bec"; + sha256 = "1z77nwjxj0v9gxhs3mlmqfq705mkkcpnwgr0d8shykjvf0iqdkcn"; + }); + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-slotting.nix b/nix/.stack.nix/cardano-slotting.nix new file mode 100644 index 00000000000..7b30962971c --- /dev/null +++ b/nix/.stack.nix/cardano-slotting.nix @@ -0,0 +1,80 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-slotting"; version = "0.1.0.0"; }; + license = "NONE"; + copyright = "IOHK"; + maintainer = "formal.methods@iohk.io"; + author = "IOHK Formal Methods Team"; + homepage = ""; + url = ""; + synopsis = "Key slotting types for cardano libraries"; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."mmorph" or (buildDepError "mmorph")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."transformers" or (buildDepError "transformers")) + ]; + buildable = true; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/cardano-base"; + rev = "468d9b79ae3ac28f5f2cbb3ce52623a69923c4ef"; + sha256 = "13hcbgmcg3zzllii95r6qr9mkch6p4lf9ds04ar5jpnbc2az284q"; + }); + postUnpack = "sourceRoot+=/slotting; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/cardano-wallet-byron.nix b/nix/.stack.nix/cardano-wallet-byron.nix new file mode 100644 index 00000000000..187854b1d6e --- /dev/null +++ b/nix/.stack.nix/cardano-wallet-byron.nix @@ -0,0 +1,111 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { development = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "cardano-wallet-byron"; version = "2020.1.21"; }; + license = "Apache-2.0"; + copyright = "2020 IOHK"; + maintainer = "operations@iohk.io"; + author = "IOHK Engineering Team"; + homepage = "https://github.com/input-output-hk/cardano-wallet"; + url = ""; + synopsis = "Wallet backend protocol-specific bits implemented using byron nodes"; + description = "Please see README.md"; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto" or (buildDepError "cardano-crypto")) + (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")) + (hsPkgs."deepseq" or (buildDepError "deepseq")) + (hsPkgs."either" or (buildDepError "either")) + (hsPkgs."fmt" or (buildDepError "fmt")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."iohk-monitoring" or (buildDepError "iohk-monitoring")) + (hsPkgs."memory" or (buildDepError "memory")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."ouroboros-consensus" or (buildDepError "ouroboros-consensus")) + (hsPkgs."ouroboros-network" or (buildDepError "ouroboros-network")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."text-class" or (buildDepError "text-class")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."transformers" or (buildDepError "transformers")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."warp" or (buildDepError "warp")) + ]; + buildable = true; + }; + exes = { + "cardano-wallet-byron" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."cardano-wallet-byron" or (buildDepError "cardano-wallet-byron")) + (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."iohk-monitoring" or (buildDepError "iohk-monitoring")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."text-class" or (buildDepError "text-class")) + ]; + buildable = true; + }; + }; + }; + } // rec { src = (pkgs.lib).mkDefault ../.././lib/byron; } \ No newline at end of file diff --git a/nix/.stack.nix/default.nix b/nix/.stack.nix/default.nix index bf796452867..23132a042fa 100644 --- a/nix/.stack.nix/default.nix +++ b/nix/.stack.nix/default.nix @@ -12,6 +12,14 @@ "time-units" = (((hackage.time-units)."1.0.0").revisions).default; "libsystemd-journal" = (((hackage.libsystemd-journal)."1.4.4").revisions).default; "katip" = (((hackage.katip)."0.8.3.0").revisions).default; + "tasty-hedgehog" = (((hackage.tasty-hedgehog)."1.0.0.1").revisions).default; + "streaming-binary" = (((hackage.streaming-binary)."0.3.0.1").revisions).default; + "hedgehog" = (((hackage.hedgehog)."1.0").revisions).default; + "generic-monoid" = (((hackage.generic-monoid)."0.1.0.0").revisions).default; + "bimap" = (((hackage.bimap)."0.4.0").revisions)."c59d587b56b575c299ba0c2fff44e630991a120a167de5a19cd7a81320f63c84"; + "canonical-json" = (((hackage.canonical-json)."0.6.0.0").revisions)."9021f435ccb884a3b4c55bcc6b50eb19d5fc3cc3f29d5fcbdef016f5bbae23a2"; + "cborg" = (((hackage.cborg)."0.2.2.0").revisions)."eaee50d09d766af95ba18348e4fc230243033b98633ed46ccb5ae85efef7dc6c"; + "statistics-linreg" = (((hackage.statistics-linreg)."0.3").revisions)."95c6efe6c7f6b26bc6e9ada90ab2d18216371cf59a6ef2b517b4a6fd35d9a76f"; bech32 = ./bech32.nix; cardano-wallet-core = ./cardano-wallet-core.nix; cardano-wallet-core-integration = ./cardano-wallet-core-integration.nix; @@ -20,6 +28,7 @@ text-class = ./text-class.nix; cardano-wallet-test-utils = ./cardano-wallet-test-utils.nix; cardano-wallet-jormungandr = ./cardano-wallet-jormungandr.nix; + cardano-wallet-byron = ./cardano-wallet-byron.nix; persistent = ./persistent.nix; persistent-sqlite = ./persistent-sqlite.nix; persistent-template = ./persistent-template.nix; @@ -29,6 +38,22 @@ lobemo-backend-aggregation = ./lobemo-backend-aggregation.nix; lobemo-backend-monitoring = ./lobemo-backend-monitoring.nix; ekg-prometheus-adapter = ./ekg-prometheus-adapter.nix; + cardano-binary = ./cardano-binary.nix; + cardano-binary-test = ./cardano-binary-test.nix; + cardano-crypto-class = ./cardano-crypto-class.nix; + cardano-slotting = ./cardano-slotting.nix; + cardano-ledger = ./cardano-ledger.nix; + cardano-ledger-test = ./cardano-ledger-test.nix; + cardano-crypto-wrapper = ./cardano-crypto-wrapper.nix; + cardano-crypto-test = ./cardano-crypto-test.nix; + cardano-prelude = ./cardano-prelude.nix; + cardano-prelude-test = ./cardano-prelude-test.nix; + io-sim-classes = ./io-sim-classes.nix; + network-mux = ./network-mux.nix; + ouroboros-network = ./ouroboros-network.nix; + ouroboros-consensus = ./ouroboros-consensus.nix; + typed-protocols = ./typed-protocols.nix; + typed-protocols-cbor = ./typed-protocols-cbor.nix; }; }; resolver = "lts-13.24"; diff --git a/nix/.stack.nix/io-sim-classes.nix b/nix/.stack.nix/io-sim-classes.nix new file mode 100644 index 00000000000..12463a2fa35 --- /dev/null +++ b/nix/.stack.nix/io-sim-classes.nix @@ -0,0 +1,77 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { checktvarinvariant = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "io-sim-classes"; version = "0.1.0.0"; }; + license = "Apache-2.0"; + copyright = "2019 Input Output (Hong Kong) Ltd."; + maintainer = ""; + author = "Alexander Vieth, Marcin Szamotulski, Duncan Coutts"; + homepage = ""; + url = ""; + synopsis = "Type classes for concurrency with STM, ST and timing"; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."stm" or (buildDepError "stm")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/ouroboros-network"; + rev = "c785fe64445357b806c847fa438fc7612563b42b"; + sha256 = "015ac7fj10xg5wcgv265qdgi85gdgj14cl03lrnqsmyqxsy1pjpn"; + }); + postUnpack = "sourceRoot+=/io-sim-classes; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/network-mux.nix b/nix/.stack.nix/network-mux.nix new file mode 100644 index 00000000000..2806d8eecdb --- /dev/null +++ b/nix/.stack.nix/network-mux.nix @@ -0,0 +1,114 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { ipv6 = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "network-mux"; version = "0.1.0.0"; }; + license = "Apache-2.0"; + copyright = "2019 Input Output (Hong Kong) Ltd."; + maintainer = "duncan@well-typed.com, marcin.szamotulski@iohk.io, marc.fontaine@iohk.io, karl.knutsson@iohk.io, alex@well-typed.com, neil.davies@pnsol.com"; + author = "Duncan Coutts, Marc Fontaine, Karl Knutsson, Marcin Szamotulski, Alexander Vieth, Neil Davies"; + homepage = ""; + url = ""; + synopsis = "Multiplexing library"; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."array" or (buildDepError "array")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."process" or (buildDepError "process")) + (hsPkgs."statistics-linreg" or (buildDepError "statistics-linreg")) + (hsPkgs."vector" or (buildDepError "vector")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + tests = { + "test-network-mux" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."io-sim" or (buildDepError "io-sim")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."array" or (buildDepError "array")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."process" or (buildDepError "process")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."splitmix" or (buildDepError "splitmix")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."stm" or (buildDepError "stm")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."tasty-hunit" or (buildDepError "tasty-hunit")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/ouroboros-network"; + rev = "c785fe64445357b806c847fa438fc7612563b42b"; + sha256 = "015ac7fj10xg5wcgv265qdgi85gdgj14cl03lrnqsmyqxsy1pjpn"; + }); + postUnpack = "sourceRoot+=/network-mux; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/ouroboros-consensus.nix b/nix/.stack.nix/ouroboros-consensus.nix new file mode 100644 index 00000000000..03bc4a91f79 --- /dev/null +++ b/nix/.stack.nix/ouroboros-consensus.nix @@ -0,0 +1,238 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "ouroboros-consensus"; version = "0.1.0.0"; }; + license = "Apache-2.0"; + copyright = "2019 Input Output (Hong Kong) Ltd."; + maintainer = "operations@iohk.io"; + author = "IOHK Engineering Team"; + homepage = ""; + url = ""; + synopsis = "Consensus layer for the Ouroboros blockchain protocol"; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."ouroboros-network" or (buildDepError "ouroboros-network")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."bifunctors" or (buildDepError "bifunctors")) + (hsPkgs."bimap" or (buildDepError "bimap")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto-class" or (buildDepError "cardano-crypto-class")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."deepseq" or (buildDepError "deepseq")) + (hsPkgs."digest" or (buildDepError "digest")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."filepath" or (buildDepError "filepath")) + (hsPkgs."fingertree" or (buildDepError "fingertree")) + (hsPkgs."formatting" or (buildDepError "formatting")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."memory" or (buildDepError "memory")) + (hsPkgs."mmorph" or (buildDepError "mmorph")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."stm" or (buildDepError "stm")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."transformers" or (buildDepError "transformers")) + (hsPkgs."vector" or (buildDepError "vector")) + ] ++ (if system.isWindows + then [ (hsPkgs."Win32" or (buildDepError "Win32")) ] + else [ + (hsPkgs."unix" or (buildDepError "unix")) + (hsPkgs."unix-bytestring" or (buildDepError "unix-bytestring")) + ]); + buildable = true; + }; + exes = { + "byron-db-converter" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) + (hsPkgs."optparse-generic" or (buildDepError "optparse-generic")) + (hsPkgs."ouroboros-consensus" or (buildDepError "ouroboros-consensus")) + (hsPkgs."path" or (buildDepError "path")) + (hsPkgs."path-io" or (buildDepError "path-io")) + (hsPkgs."resourcet" or (buildDepError "resourcet")) + (hsPkgs."streaming" or (buildDepError "streaming")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + "analyse-db" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."optparse-applicative" or (buildDepError "optparse-applicative")) + (hsPkgs."ouroboros-consensus" or (buildDepError "ouroboros-consensus")) + (hsPkgs."ouroboros-network" or (buildDepError "ouroboros-network")) + ]; + buildable = true; + }; + }; + tests = { + "test-consensus" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-crypto-class" or (buildDepError "cardano-crypto-class")) + (hsPkgs."cardano-crypto-wrapper" or (buildDepError "cardano-crypto-wrapper")) + (hsPkgs."cardano-crypto-test" or (buildDepError "cardano-crypto-test")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."cardano-ledger-test" or (buildDepError "cardano-ledger-test")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."ouroboros-network" or (buildDepError "ouroboros-network")) + (hsPkgs."ouroboros-consensus" or (buildDepError "ouroboros-consensus")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."io-sim" or (buildDepError "io-sim")) + (hsPkgs."binary-search" or (buildDepError "binary-search")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."cryptonite" or (buildDepError "cryptonite")) + (hsPkgs."deepseq" or (buildDepError "deepseq")) + (hsPkgs."fgl" or (buildDepError "fgl")) + (hsPkgs."fingertree" or (buildDepError "fingertree")) + (hsPkgs."generics-sop" or (buildDepError "generics-sop")) + (hsPkgs."graphviz" or (buildDepError "graphviz")) + (hsPkgs."hedgehog-quickcheck" or (buildDepError "hedgehog-quickcheck")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."quickcheck-state-machine" or (buildDepError "quickcheck-state-machine")) + (hsPkgs."random" or (buildDepError "random")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-hunit" or (buildDepError "tasty-hunit")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."tree-diff" or (buildDepError "tree-diff")) + ]; + buildable = true; + }; + "test-storage" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."cardano-crypto-class" or (buildDepError "cardano-crypto-class")) + (hsPkgs."cardano-ledger" or (buildDepError "cardano-ledger")) + (hsPkgs."cardano-ledger-test" or (buildDepError "cardano-ledger-test")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."ouroboros-network" or (buildDepError "ouroboros-network")) + (hsPkgs."ouroboros-network-testing" or (buildDepError "ouroboros-network-testing")) + (hsPkgs."ouroboros-consensus" or (buildDepError "ouroboros-consensus")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."io-sim" or (buildDepError "io-sim")) + (hsPkgs."base16-bytestring" or (buildDepError "base16-bytestring")) + (hsPkgs."bifunctors" or (buildDepError "bifunctors")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."cereal" or (buildDepError "cereal")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."deepseq" or (buildDepError "deepseq")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."fingertree" or (buildDepError "fingertree")) + (hsPkgs."generics-sop" or (buildDepError "generics-sop")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."pretty-show" or (buildDepError "pretty-show")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."quickcheck-state-machine" or (buildDepError "quickcheck-state-machine")) + (hsPkgs."random" or (buildDepError "random")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-hunit" or (buildDepError "tasty-hunit")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."temporary" or (buildDepError "temporary")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."transformers" or (buildDepError "transformers")) + (hsPkgs."tree-diff" or (buildDepError "tree-diff")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/ouroboros-network"; + rev = "c785fe64445357b806c847fa438fc7612563b42b"; + sha256 = "015ac7fj10xg5wcgv265qdgi85gdgj14cl03lrnqsmyqxsy1pjpn"; + }); + postUnpack = "sourceRoot+=/ouroboros-consensus; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/ouroboros-network.nix b/nix/.stack.nix/ouroboros-network.nix new file mode 100644 index 00000000000..1f7232cde70 --- /dev/null +++ b/nix/.stack.nix/ouroboros-network.nix @@ -0,0 +1,184 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = { ipv6 = false; cddl = false; }; + package = { + specVersion = "1.10"; + identifier = { name = "ouroboros-network"; version = "0.1.0.0"; }; + license = "Apache-2.0"; + copyright = "2019 Input Output (Hong Kong) Ltd."; + maintainer = ""; + author = "Alexander Vieth, Marcin Szamotulski, Duncan Coutts"; + homepage = ""; + url = ""; + synopsis = "A networking layer for the Ouroboros blockchain protocol"; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."dns" or (buildDepError "dns")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."fingertree" or (buildDepError "fingertree")) + (hsPkgs."iproute" or (buildDepError "iproute")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."stm" or (buildDepError "stm")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."text" or (buildDepError "text")) + ]; + buildable = true; + }; + exes = { + "demo-chain-sync" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."ouroboros-network" or (buildDepError "ouroboros-network")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."random" or (buildDepError "random")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."splitmix" or (buildDepError "splitmix")) + (hsPkgs."stm" or (buildDepError "stm")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + ]; + buildable = true; + }; + }; + tests = { + "test-network" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."array" or (buildDepError "array")) + (hsPkgs."async" or (buildDepError "async")) + (hsPkgs."binary" or (buildDepError "binary")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."directory" or (buildDepError "directory")) + (hsPkgs."dns" or (buildDepError "dns")) + (hsPkgs."fingertree" or (buildDepError "fingertree")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."io-sim" or (buildDepError "io-sim")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."iproute" or (buildDepError "iproute")) + (hsPkgs."mtl" or (buildDepError "mtl")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."network" or (buildDepError "network")) + (hsPkgs."ouroboros-network-testing" or (buildDepError "ouroboros-network-testing")) + (hsPkgs."pipes" or (buildDepError "pipes")) + (hsPkgs."process" or (buildDepError "process")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."splitmix" or (buildDepError "splitmix")) + (hsPkgs."stm" or (buildDepError "stm")) + (hsPkgs."tasty-hunit" or (buildDepError "tasty-hunit")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."time" or (buildDepError "time")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + ]; + buildable = true; + }; + "cddl" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cardano-binary" or (buildDepError "cardano-binary")) + (hsPkgs."cardano-prelude" or (buildDepError "cardano-prelude")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."containers" or (buildDepError "containers")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."fingertree" or (buildDepError "fingertree")) + (hsPkgs."hashable" or (buildDepError "hashable")) + (hsPkgs."io-sim" or (buildDepError "io-sim")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."network-mux" or (buildDepError "network-mux")) + (hsPkgs."pipes" or (buildDepError "pipes")) + (hsPkgs."process-extras" or (buildDepError "process-extras")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."text" or (buildDepError "text")) + (hsPkgs."typed-protocols-cbor" or (buildDepError "typed-protocols-cbor")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + ]; + buildable = if !flags.cddl then false else true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/ouroboros-network"; + rev = "c785fe64445357b806c847fa438fc7612563b42b"; + sha256 = "015ac7fj10xg5wcgv265qdgi85gdgj14cl03lrnqsmyqxsy1pjpn"; + }); + postUnpack = "sourceRoot+=/ouroboros-network; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/typed-protocols-cbor.nix b/nix/.stack.nix/typed-protocols-cbor.nix new file mode 100644 index 00000000000..29a2a3c0d71 --- /dev/null +++ b/nix/.stack.nix/typed-protocols-cbor.nix @@ -0,0 +1,93 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "typed-protocols-cbor"; version = "0.1.0.0"; }; + license = "Apache-2.0"; + copyright = "2019 Input Output (Hong Kong) Ltd."; + maintainer = "alex@well-typed.com, duncan@well-typed.com, marcin.szamotulski@iohk.io"; + author = "Alexander Vieth, Duncan Coutts, Marcin Szamotulski"; + homepage = ""; + url = ""; + synopsis = ""; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + ]; + buildable = true; + }; + tests = { + "test-typed-protocols-cbor" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."cborg" or (buildDepError "cborg")) + (hsPkgs."serialise" or (buildDepError "serialise")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."typed-protocols" or (buildDepError "typed-protocols")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/ouroboros-network"; + rev = "c785fe64445357b806c847fa438fc7612563b42b"; + sha256 = "015ac7fj10xg5wcgv265qdgi85gdgj14cl03lrnqsmyqxsy1pjpn"; + }); + postUnpack = "sourceRoot+=/typed-protocols-cbor; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/.stack.nix/typed-protocols.nix b/nix/.stack.nix/typed-protocols.nix new file mode 100644 index 00000000000..edd2e9966c2 --- /dev/null +++ b/nix/.stack.nix/typed-protocols.nix @@ -0,0 +1,92 @@ +let + buildDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (build dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + sysDepError = pkg: + builtins.throw '' + The Nixpkgs package set does not contain the package: ${pkg} (system dependency). + + You may need to augment the system package mapping in haskell.nix so that it can be found. + ''; + pkgConfDepError = pkg: + builtins.throw '' + The pkg-conf packages does not contain the package: ${pkg} (pkg-conf dependency). + + You may need to augment the pkg-conf package mapping in haskell.nix so that it can be found. + ''; + exeDepError = pkg: + builtins.throw '' + The local executable components do not include the component: ${pkg} (executable dependency). + ''; + legacyExeDepError = pkg: + builtins.throw '' + The Haskell package set does not contain the package: ${pkg} (executable dependency). + + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; + buildToolDepError = pkg: + builtins.throw '' + Neither the Haskell package set or the Nixpkgs package set contain the package: ${pkg} (build tool dependency). + + If this is a system dependency: + You may need to augment the system package mapping in haskell.nix so that it can be found. + + If this is a Haskell dependency: + If you are using Stackage, make sure that you are using a snapshot that contains the package. Otherwise you may need to update the Hackage snapshot you are using, usually by updating haskell.nix. + ''; +in { system, compiler, flags, pkgs, hsPkgs, pkgconfPkgs, ... }: + { + flags = {}; + package = { + specVersion = "1.10"; + identifier = { name = "typed-protocols"; version = "0.1.0.0"; }; + license = "Apache-2.0"; + copyright = "2019 Input Output (Hong Kong) Ltd."; + maintainer = "alex@well-typed.com, duncan@well-typed.com, marcin.szamotulski@iohk.io"; + author = "Alexander Vieth, Duncan Coutts, Marcin Szamotulski"; + homepage = ""; + url = ""; + synopsis = "A framework for strongly typed protocols"; + description = ""; + buildType = "Simple"; + isLocal = true; + }; + components = { + "library" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + tests = { + "test-protocols" = { + depends = [ + (hsPkgs."base" or (buildDepError "base")) + (hsPkgs."bytestring" or (buildDepError "bytestring")) + (hsPkgs."contra-tracer" or (buildDepError "contra-tracer")) + (hsPkgs."io-sim-classes" or (buildDepError "io-sim-classes")) + (hsPkgs."io-sim" or (buildDepError "io-sim")) + (hsPkgs."QuickCheck" or (buildDepError "QuickCheck")) + (hsPkgs."tasty" or (buildDepError "tasty")) + (hsPkgs."tasty-quickcheck" or (buildDepError "tasty-quickcheck")) + (hsPkgs."time" or (buildDepError "time")) + ]; + buildable = true; + }; + }; + }; + } // { + src = (pkgs.lib).mkDefault (pkgs.fetchgit { + url = "https://github.com/input-output-hk/ouroboros-network"; + rev = "c785fe64445357b806c847fa438fc7612563b42b"; + sha256 = "015ac7fj10xg5wcgv265qdgi85gdgj14cl03lrnqsmyqxsy1pjpn"; + }); + postUnpack = "sourceRoot+=/typed-protocols; echo source root reset to \$sourceRoot"; + } \ No newline at end of file diff --git a/nix/pkgs.nix b/nix/pkgs.nix index 2dd74ee4ae3..0526a879a6c 100644 --- a/nix/pkgs.nix +++ b/nix/pkgs.nix @@ -35,6 +35,7 @@ let packages.cardano-wallet-core-integration.src = filterSubDir /lib/core-integration; packages.cardano-wallet-cli.src = filterSubDir /lib/cli; packages.cardano-wallet-launcher.src = filterSubDir /lib/launcher; + packages.cardano-wallet-byron.src = filterSubDir /lib/byron; packages.cardano-wallet-jormungandr.src = filterSubDir /lib/jormungandr; packages.cardano-wallet-jormungandr.components.tests.unit.keepSource = true; packages.cardano-wallet-jormungandr.components.tests.integration.keepSource = true; diff --git a/stack.yaml b/stack.yaml index 419c3bae3b2..c95f54ba8ad 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,6 +9,7 @@ packages: - lib/text-class - lib/test-utils - lib/jormungandr +- lib/byron extra-deps: # Miscellaneous @@ -54,6 +55,48 @@ extra-deps: - libsystemd-journal-1.4.4 - katip-0.8.3.0 +# dependencies for cardano-wallet-shelley +- tasty-hedgehog-1.0.0.1 +- streaming-binary-0.3.0.1 +- hedgehog-1.0 +- generic-monoid-0.1.0.0 +- bimap-0.4.0@sha256:c59d587b56b575c299ba0c2fff44e630991a120a167de5a19cd7a81320f63c84,1717 +- canonical-json-0.6.0.0@sha256:9021f435ccb884a3b4c55bcc6b50eb19d5fc3cc3f29d5fcbdef016f5bbae23a2,3488 +- cborg-0.2.2.0@sha256:eaee50d09d766af95ba18348e4fc230243033b98633ed46ccb5ae85efef7dc6c,4779 +- statistics-linreg-0.3@sha256:95c6efe6c7f6b26bc6e9ada90ab2d18216371cf59a6ef2b517b4a6fd35d9a76f,2544 + +- git: https://github.com/input-output-hk/cardano-base + commit: 468d9b79ae3ac28f5f2cbb3ce52623a69923c4ef + subdirs: + - binary + - binary/test + - cardano-crypto-class + - slotting + +- git: https://github.com/input-output-hk/cardano-ledger + commit: dbdb643722e431e4d232345a0eafdc7bdeab7b60 + subdirs: + - cardano-ledger + - cardano-ledger/test + - crypto + - crypto/test + +- git: https://github.com/input-output-hk/cardano-prelude + commit: 3c40edcf5bdba8721d3430d0aaaeea8770ce9bec + subdirs: + - . + - test + +- git: https://github.com/input-output-hk/ouroboros-network + commit: c785fe64445357b806c847fa438fc7612563b42b + subdirs: + - io-sim-classes + - network-mux + - ouroboros-network + - ouroboros-consensus + - typed-protocols + - typed-protocols-cbor + flags: # Avoid a system library which causes difficulty with cross-compilation zip: