diff --git a/pkgs/default.nix b/pkgs/default.nix index 49943231c8f..d9e86d61371 100644 --- a/pkgs/default.nix +++ b/pkgs/default.nix @@ -17778,6 +17778,7 @@ license = stdenv.lib.licenses.mit; , cardano-sl-binary , cardano-sl-binary-test , cardano-sl-chain +, cardano-sl-chain-test , cardano-sl-client , cardano-sl-core , cardano-sl-core-test @@ -17791,6 +17792,7 @@ license = stdenv.lib.licenses.mit; , cardano-sl-wallet , cardano-sl-wallet-test , cassava +, cereal , conduit , connection , constraints @@ -17799,6 +17801,7 @@ license = stdenv.lib.licenses.mit; , data-default , data-default-class , directory +, ed25519 , exceptions , filepath , formatting @@ -17901,6 +17904,7 @@ cardano-sl-node-ipc cardano-sl-util cardano-sl-wallet cardano-sl-wallet-test +cereal conduit connection containers @@ -17908,6 +17912,7 @@ cryptonite data-default data-default-class directory +ed25519 exceptions formatting generics-sop @@ -18004,6 +18009,7 @@ cardano-sl cardano-sl-binary cardano-sl-binary-test cardano-sl-chain +cardano-sl-chain-test cardano-sl-client cardano-sl-core cardano-sl-core-test @@ -18012,6 +18018,7 @@ cardano-sl-db cardano-sl-util cardano-sl-util-test cardano-sl-wallet +cereal conduit constraints containers @@ -18032,6 +18039,7 @@ quickcheck-instances random reflection safe-exceptions +safecopy serokell-util servant servant-server diff --git a/wallet-new/src/Cardano/Wallet/Kernel/ChainState.hs b/wallet-new/src/Cardano/Wallet/Kernel/ChainState.hs index 1eada759c96..14fa0b33236 100644 --- a/wallet-new/src/Cardano/Wallet/Kernel/ChainState.hs +++ b/wallet-new/src/Cardano/Wallet/Kernel/ChainState.hs @@ -16,7 +16,6 @@ module Cardano.Wallet.Kernel.ChainState ( import Universum import qualified Data.Map.Strict as Map -import Data.SafeCopy (SafeCopy (..)) import Pos.Chain.Block (HeaderHash, gbHeader, headerHash, mainBlockSlot, prevBlockL) @@ -249,14 +248,6 @@ data ChainStateException = instance Exception ChainStateException -{------------------------------------------------------------------------------- - Serialization --------------------------------------------------------------------------------} - -instance SafeCopy ChainBrief where - getCopy = error "TODO: getCopy for ChainBrief" - putCopy = error "TODO: putCopy for ChainBrief" - {------------------------------------------------------------------------------- Pretty printing -------------------------------------------------------------------------------} diff --git a/wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs b/wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs index 06de861783c..0b9443ac455 100644 --- a/wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs +++ b/wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs @@ -61,7 +61,7 @@ import Cardano.Wallet.Kernel.DB.HdWallet import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD import qualified Cardano.Wallet.Kernel.DB.HdWallet.Delete as HD import qualified Cardano.Wallet.Kernel.DB.HdWallet.Update as HD -import Cardano.Wallet.Kernel.DB.InDb (InDb(InDb)) +import Cardano.Wallet.Kernel.DB.InDb (InDb (InDb)) import Cardano.Wallet.Kernel.DB.Spec import Cardano.Wallet.Kernel.DB.Spec.Pending (Pending) import qualified Cardano.Wallet.Kernel.DB.Spec.Update as Spec diff --git a/wallet-new/src/Cardano/Wallet/Kernel/DB/BlockMeta.hs b/wallet-new/src/Cardano/Wallet/Kernel/DB/BlockMeta.hs index d37118f3922..efee9e07a11 100644 --- a/wallet-new/src/Cardano/Wallet/Kernel/DB/BlockMeta.hs +++ b/wallet-new/src/Cardano/Wallet/Kernel/DB/BlockMeta.hs @@ -24,8 +24,7 @@ import Universum import Control.Lens (at, non) import Control.Lens.TH (makeLenses, makeWrapped) import qualified Data.Map.Strict as Map -import Data.SafeCopy (SafeCopy (..), base, contain, deriveSafeCopy, - safeGet, safePut) +import Data.SafeCopy (base, deriveSafeCopy) import Formatting (bprint, build, (%)) import qualified Formatting.Buildable import Serokell.Util (mapJson) @@ -63,15 +62,6 @@ instance Monoid AddressMeta where makeLenses ''AddressMeta deriveSafeCopy 1 'base ''AddressMeta -instance SafeCopy (InDb AddressMeta) where - getCopy = contain $ do - isUsed <- safeGet - isChange <- safeGet - pure . InDb $ AddressMeta isUsed isChange - putCopy (InDb (AddressMeta isUsed isChange)) = contain $ do - safePut isUsed - safePut isChange - {------------------------------------------------------------------------------- Block metadata -------------------------------------------------------------------------------} @@ -81,7 +71,7 @@ data BlockMeta = BlockMeta { -- | Slot each transaction got confirmed in _blockMetaSlotId :: !(InDb (Map Txp.TxId Core.SlotId)) -- | Address metadata - , _blockMetaAddressMeta :: !(InDb (Map Core.Address AddressMeta)) + , _blockMetaAddressMeta :: !(Map (InDb Core.Address) AddressMeta) } deriving Eq makeLenses ''BlockMeta @@ -92,12 +82,12 @@ deriveSafeCopy 1 'base ''BlockMeta -- When the block metadata does not contain any information about this address, -- we assume 'mempty'. addressMeta :: Core.Address -> Lens' BlockMeta AddressMeta -addressMeta addr = blockMetaAddressMeta . fromDb . at addr . non mempty +addressMeta addr = blockMetaAddressMeta . at (InDb addr) . non mempty emptyBlockMeta :: BlockMeta emptyBlockMeta = BlockMeta { _blockMetaSlotId = InDb Map.empty - , _blockMetaAddressMeta = InDb Map.empty + , _blockMetaAddressMeta = Map.empty } {------------------------------------------------------------------------------- @@ -125,7 +115,7 @@ appendBlockMeta :: BlockMeta -> LocalBlockMeta -> BlockMeta appendBlockMeta cur (LocalBlockMeta new) = BlockMeta { _blockMetaSlotId = combineUsing (liftA2 Map.union) _blockMetaSlotId - , _blockMetaAddressMeta = combineUsing (liftA2 (Map.unionWith (<>))) + , _blockMetaAddressMeta = combineUsing (Map.unionWith (<>)) _blockMetaAddressMeta } where @@ -171,4 +161,4 @@ instance Buildable BlockMeta where % "}" ) (_fromDb _blockMetaSlotId) - (_fromDb _blockMetaAddressMeta) + _blockMetaAddressMeta diff --git a/wallet-new/src/Cardano/Wallet/Kernel/DB/InDb.hs b/wallet-new/src/Cardano/Wallet/Kernel/DB/InDb.hs index c7bdc2eee2a..14d7630b934 100644 --- a/wallet-new/src/Cardano/Wallet/Kernel/DB/InDb.hs +++ b/wallet-new/src/Cardano/Wallet/Kernel/DB/InDb.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} module Cardano.Wallet.Kernel.DB.InDb ( InDb(..) @@ -24,7 +25,6 @@ import qualified Data.Vector as V import Test.QuickCheck (Arbitrary (..)) import qualified Pos.Chain.Block as Core -import qualified Pos.Chain.Txp as Core import qualified Pos.Core as Core import qualified Pos.Core.Attributes as Core import qualified Pos.Core.Delegation as Core @@ -35,13 +35,37 @@ import qualified Pos.Crypto as Core import qualified Cardano.Crypto.Wallet as CCW +{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-} + {------------------------------------------------------------------------------- Wrap core types so that we can make independent serialization decisions -------------------------------------------------------------------------------} --- | Wrapped type (with potentially different 'SC' instance) +-- | Wrapped type (with potentially different 'SafeCopy' instance) +-- +-- NOTE: +-- +-- 1. We want to be independent from the 'SafeCopy' instances in core. For this +-- reason, we wrap all core types in 'InDb', and provide explicit 'SafeCopy' +-- instances for 'InDb SomeCoreType'. +-- 2. We never use 'InDb' for types that we have control over in the wallet +-- itself. +-- 3. To avoid too much code bloat everywhere else, we don't nest 'InDb'; +-- i.e., we don't use @InDb (.... InDb ....)@. Instead, we use 'InDb' only +-- /around/ (possibly nested) core types; for example, we use +-- @InDb (Map SomeCoreType SomeOtherCoreType)@. We then translate this to +-- @Map (InDb SomeCoreType) (InDb SomeOtherCoreType)@ in the 'SafeCopy' +-- instances themselves, so that in the rest of the code we don't have to +-- do too much wrapping and unwrapping. +-- +-- A consequence of these rules is that something like +-- +-- > safePut (InDb x) = safePut x +-- +-- is correct /only/ if @x@ has a primitive type (i.e., not one defined in +-- the Cardano core, but in the Haskell base libraries). newtype InDb a = InDb { _fromDb :: a } - deriving (Eq, Show, Ord) + deriving (Eq, Show, Ord, Buildable) instance Functor InDb where fmap f = InDb . f . _fromDb @@ -80,7 +104,7 @@ instance SC.SafeCopy (InDb Core.AddrAttributes) where pure (InDb (Core.AddrAttributes (fmap _fromDb yiap) ast)) putCopy (InDb (Core.AddrAttributes yap asr)) = SC.contain $ do SC.safePut (fmap InDb yap) - SC.safePut asr + SC.safePut (InDb asr) instance SC.SafeCopy (InDb Core.AddrStakeDistribution) where getCopy = SC.contain $ fmap InDb $ do @@ -196,7 +220,9 @@ instance SC.SafeCopy (InDb Txp.TxInWitness) where 2 -> Txp.RedeemWitness <$> fmap _fromDb SC.safeGet <*> fmap _fromDb SC.safeGet - 3 -> Txp.RedeemWitness <$> SC.safeGet <*> SC.safeGet + 3 -> Txp.UnknownWitnessType + <$> SC.safeGet + <*> SC.safeGet (n :: Word8) -> fail $ "Expected 0,1,2,3 for tag of TxInWitness, got: " <> show n @@ -341,10 +367,14 @@ instance (SC.SafeCopy (InDb a), SC.SafeCopy (InDb b)) SC.safePut (InDb b) instance SC.SafeCopy (InDb Txp.TxIn) where - getCopy = SC.contain $ fmap InDb $ do + getCopy = SC.contain $ SC.safeGet >>= \case - 0 -> Txp.TxInUtxo <$> SC.safeGet <*> SC.safeGet - 1 -> Txp.TxInUnknown <$> SC.safeGet <*> SC.safeGet + 0 -> do InDb txId <- SC.safeGet + w <- SC.safeGet + pure (InDb (Txp.TxInUtxo txId w)) + 1 -> do w <- SC.safeGet + b <- SC.safeGet + pure (InDb (Txp.TxInUnknown w b)) (n :: Word8) -> fail $ "Expected one of 0,1 for TxIn tag, got: " <> show n diff --git a/wallet-new/src/Cardano/Wallet/Kernel/DB/Util/IxSet.hs b/wallet-new/src/Cardano/Wallet/Kernel/DB/Util/IxSet.hs index f9470e2b2f5..eae2e0ea9f8 100644 --- a/wallet-new/src/Cardano/Wallet/Kernel/DB/Util/IxSet.hs +++ b/wallet-new/src/Cardano/Wallet/Kernel/DB/Util/IxSet.hs @@ -140,10 +140,7 @@ data Indexed a = Indexed { } Lens.makeLenses ''Indexed - -instance SafeCopy a => SafeCopy (Indexed a) where - getCopy = error "TODO" - putCopy = error "TODO" +deriveSafeCopy 1 'base ''Indexed instance Buildable a => Buildable (Indexed a) where build (Indexed (AutoIncrementKey idx) r) = diff --git a/wallet-new/src/Cardano/Wallet/Kernel/PrefilterTx.hs b/wallet-new/src/Cardano/Wallet/Kernel/PrefilterTx.hs index 7a3c535c5db..0bfa2d0265c 100644 --- a/wallet-new/src/Cardano/Wallet/Kernel/PrefilterTx.hs +++ b/wallet-new/src/Cardano/Wallet/Kernel/PrefilterTx.hs @@ -309,7 +309,7 @@ mkBlockMeta slotId addrs_ = LocalBlockMeta BlockMeta{..} indexedAddrs = indexByAddr addrs_ _blockMetaSlotId = InDb . Map.fromList . map (,slotId) $ txIds' - _blockMetaAddressMeta = InDb $ Map.map mkAddressMeta indexedAddrs + _blockMetaAddressMeta = Map.map mkAddressMeta indexedAddrs -- | This function is called once for each address found in a particular block of -- transactions. The collection of address summaries passed to this function @@ -347,11 +347,11 @@ mkAddressMeta addrs -- | Index the list of address summaries by Address. -- NOTE: Since there will be at least one AddressSummary per Address, -- we can safely use NE.fromList. -indexByAddr :: [AddressSummary] -> Map Address (NE.NonEmpty AddressSummary) +indexByAddr :: [AddressSummary] -> Map (InDb Address) (NE.NonEmpty AddressSummary) indexByAddr addrs = Map.map NE.fromList (Map.fromListWith (++) addrs') where - fromAddrSummary addrSummary = (addrSummaryAddr addrSummary, [addrSummary]) + fromAddrSummary addrSummary = (InDb (addrSummaryAddr addrSummary), [addrSummary]) addrs' = map fromAddrSummary addrs fromUtxoSummary :: Map TxIn (TxOutAux,AddressSummary) diff --git a/wallet-new/test/unit/UTxO/Interpreter.hs b/wallet-new/test/unit/UTxO/Interpreter.hs index 724939a0745..23d78c65d69 100644 --- a/wallet-new/test/unit/UTxO/Interpreter.hs +++ b/wallet-new/test/unit/UTxO/Interpreter.hs @@ -558,12 +558,12 @@ instance DSL.Hash h Addr => Interpret h (BlockMeta' h) where _blockMetaAddressMeta <- intAddrMetas addrMeta' return $ BlockMeta {..} where - intAddrMetas :: Map Addr AddressMeta -> IntT h e m (InDb (Map Address AddressMeta)) - intAddrMetas addrMetas= InDb . Map.fromList <$> mapM intAddrMeta (Map.toList addrMetas) + intAddrMetas :: Map Addr AddressMeta -> IntT h e m (Map (InDb Address) AddressMeta) + intAddrMetas addrMetas= Map.fromList <$> mapM intAddrMeta (Map.toList addrMetas) -- Interpret only the key, leaving the indexed value AddressMeta unchanged - intAddrMeta :: (Addr,AddressMeta) -> IntT h e m (Address,AddressMeta) - intAddrMeta (addr,addrMeta) = (,addrMeta) . addrInfoCardano <$> int addr + intAddrMeta :: (Addr,AddressMeta) -> IntT h e m (InDb Address, AddressMeta) + intAddrMeta (addr,addrMeta) = (,addrMeta) . InDb . addrInfoCardano <$> int addr intTxIds :: Map (h (DSL.Transaction h Addr)) SlotId -> IntT h e m (InDb (Map TxId SlotId)) intTxIds txIds = InDb . Map.fromList <$> mapM intTxId (Map.toList txIds)