Merge pull request #3381 from input-output-hk/rc-cbr-305

[CBR-305] SafeCopy instances for InDb types
input-output-hk · Aug 23, 2018 · 47ab0a5 · 47ab0a5
2 parents def30e7 + 7928afc
commit 47ab0a5
Show file tree

Hide file tree

Showing 10 changed files with 901 additions and 107 deletions.
diff --git 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,13 +17904,15 @@ cardano-sl-node-ipc
 cardano-sl-util
 cardano-sl-wallet
 cardano-sl-wallet-test
+cereal
 conduit
 connection
 containers
 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/cardano-sl-wallet-new.cabal b/wallet-new/cardano-sl-wallet-new.cabal
@@ -177,13 +177,15 @@ library
                      , cardano-sl-util
                      , cardano-sl-wallet
                      , cardano-sl-wallet-test
+                     , cereal
                      , conduit
                      , connection
                      , containers
                      , cryptonite
                      , data-default
                      , data-default-class
                      , directory
+                     , ed25519
                      , exceptions
                      , formatting
                      , formatting
@@ -536,7 +538,7 @@ test-suite wallet-unit-tests
                     , time
 
 test-suite wallet-new-specs
-  ghc-options:      -Wall
+  ghc-options:      -Wall -O2 -threaded -rtsopts
   type:             exitcode-stdio-1.0
   main-is:          Spec.hs
   hs-source-dirs:   test test/unit
@@ -580,17 +582,20 @@ test-suite wallet-new-specs
   build-depends:      base
                     , aeson
                     , bytestring
+                    , cardano-crypto
                     , cardano-sl
                     , cardano-sl-binary-test
                     , cardano-sl-client
                     , cardano-sl-client
+                    , cardano-sl-chain-test
                     , cardano-sl-core
                     , cardano-sl-core-test
                     , cardano-sl-crypto
                     , cardano-sl-chain
                     , cardano-sl-util-test
                     , cardano-sl-wallet
                     , cardano-sl-wallet-new
+                    , cereal
                     , data-default
                     , directory
                     , directory
@@ -600,6 +605,7 @@ test-suite wallet-new-specs
                     , lens
                     , QuickCheck
                     , quickcheck-instances
+                    , safecopy
                     , safe-exceptions
                     , servant
                     , servant-server

diff --git 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
@@ -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
+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
@@ -180,7 +180,7 @@ ensureExistsHdAddress newAddress = do
 -- transactions for all the wallets managed by this edge node.
 cancelPending :: Map HdAccountId (InDb (Set TxId)) -> Update DB ()
 cancelPending cancelled = void . runUpdate' . zoom dbHdWallets $
-    forM_ (Map.toList cancelled) $ \(accountId, InDb txids) ->
+    forM_ (Map.toList cancelled) $ \(accountId, InDb txids) -> do
         -- Here we are deliberately swallowing the possible exception
         -- returned by the wrapped 'zoom' as the only reason why this update
         -- might fail is if, in the meantime, the target account was cancelled,

diff --git 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)
@@ -72,28 +71,23 @@ 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
-
--- TODO @uroboros/ryan [CBR 305] Implement Safecopy instances independently from legacy wallet
-instance SafeCopy (InDb (Map Core.Address AddressMeta)) where
-    putCopy (InDb h) = contain $ safePut h
-    getCopy = contain $ InDb <$> safeGet
-
 deriveSafeCopy 1 'base ''BlockMeta
+
 -- | Address metadata for the specified address
 --
 -- 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
     }
 
 {-------------------------------------------------------------------------------
@@ -121,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
@@ -167,4 +161,4 @@ instance Buildable BlockMeta where
         % "}"
         )
         (_fromDb _blockMetaSlotId)
-        (_fromDb _blockMetaAddressMeta)
+        _blockMetaAddressMeta