Merge pull request #3685 from input-output-hk/intricate+mhuesch/CO-35…

…4/fix-safecopy

[CO-354] Fix SafeCopy instance for `AddrAttributes`

core/src/Pos/Core/Common/Address.hs

@@ -30,6 +30,7 @@ module Pos.Core.Common.Address
        -- * Construction
        , IsBootstrapEraAddr (..)
        , makeAddress
+       , makeAddress'
        , makePubKeyAddress
        , makePubKeyAddressBoot
        , makeRootPubKeyAddress
@@ -170,6 +171,8 @@ decodeTextAddress = decodeAddress . encodeUtf8
 ----------------------------------------------------------------------------
 -- Constructors
 ----------------------------------------------------------------------------
+{-# ANN makeAddress ("HLint: ignore Reduce duplication" :: Text) #-}
+{-# ANN makeAddress' ("HLint: ignore Reduce duplication" :: Text) #-}
 
 -- | Make an 'Address' from spending data and attributes.
 makeAddress :: AddrSpendingData -> AddrAttributes -> Address
@@ -184,6 +187,14 @@ makeAddress spendingData attributesUnwrapped =
     attributes = mkAttributes attributesUnwrapped
     address' = Address' (addrType', spendingData, attributes)
 
+-- | Make an 'Address'' from spending data and attributes.
+makeAddress' :: AddrSpendingData -> AddrAttributes -> Address'
+makeAddress' spendingData attributesUnwrapped = address'
+  where
+    addrType' = addrSpendingDataToType spendingData
+    attributes = mkAttributes attributesUnwrapped
+    address' = Address' (addrType', spendingData, attributes)
+
 -- | This newtype exists for clarity. It is used to tell pubkey
 -- address creation functions whether an address is intended for
 -- bootstrap era.

core/test/Test/Pos/Core/ExampleHelpers.hs

@@ -7,6 +7,17 @@ module Test.Pos.Core.ExampleHelpers
         , exampleAddress2
         , exampleAddress3
         , exampleAddress4
+        , exampleAddress5
+        , exampleAddress6
+        , exampleAddress7
+        , exampleAddress'
+        , exampleAddress'1
+        , exampleAddress'2
+        , exampleAddress'3
+        , exampleAddress'4
+        , exampleAddress'5
+        , exampleAddress'6
+        , exampleAddress'7
         , exampleBlockVersion
         , exampleBlockVersionData0
         , exampleBlockVersionData1
@@ -122,13 +133,13 @@ import qualified Serokell.Util.Base16 as B16
 import qualified Cardano.Crypto.Wallet as CC
 import           Pos.Binary.Class (Raw (..), asBinary)
 import           Pos.Core.Common (AddrAttributes (..), AddrSpendingData (..),
-                                  AddrStakeDistribution (..), Address (..), BlockCount (..),
-                                  ChainDifficulty (..), Coeff (..), Coin (..), CoinPortion (..),
-                                  IsBootstrapEraAddr (..), Script (..), ScriptVersion,
-                                  SharedSeed (..), SlotLeaders, StakeholderId, StakesList,
-                                  TxFeePolicy (..), TxSizeLinear (..), addressHash,
-                                  coinPortionDenominator, makeAddress, makePubKeyAddress,
-                                  mkMultiKeyDistr)
+                                  AddrStakeDistribution (..), Address (..), Address' (..),
+                                  BlockCount (..), ChainDifficulty (..), Coeff (..), Coin (..),
+                                  CoinPortion (..), IsBootstrapEraAddr (..), Script (..),
+                                  ScriptVersion, SharedSeed (..), SlotLeaders, StakeholderId,
+                                  StakesList, TxFeePolicy (..), TxSizeLinear (..), addressHash,
+                                  coinPortionDenominator, makeAddress, makeAddress',
+                                  makePubKeyAddress, mkMultiKeyDistr)
 import           Pos.Core.Configuration
 import           Pos.Core.Delegation (HeavyDlgIndex (..), LightDlgIndices (..), ProxySKBlockInfo,
                                       ProxySKHeavy)
@@ -171,6 +182,8 @@ import           Test.Pos.Core.Gen (genProtocolConstants)
 import           Test.Pos.Crypto.Bi (getBytes)
 import           Test.Pos.Crypto.Gen (genProtocolMagic, genProtocolMagicId)
 
+{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
+
 --------------------------------------------------------------------------------
 -- Helpers
 --------------------------------------------------------------------------------
@@ -733,6 +746,86 @@ exampleAddress4 = makeAddress easd attrs
     attrs = AddrAttributes Nothing (SingleKeyDistr sId) NMNothing
     [sId] = exampleStakeholderIds 7 1
 
+exampleAddress5 :: Address
+exampleAddress5 = makeAddress easd attrs
+  where
+    easd = ScriptASD exampleScript
+    attrs = AddrAttributes hap exampleMultiKeyDistr (NMJust 12345)
+    hap = Just (HDAddressPayload (getBytes 10 32))
+
+exampleAddress6 :: Address
+exampleAddress6 = makeAddress easd attrs
+  where
+    easd = UnknownASD 200 "test value"
+    attrs = AddrAttributes Nothing (SingleKeyDistr sId) (NMJust 31337)
+    [sId] = exampleStakeholderIds 10 1
+
+exampleAddress7 :: Address
+exampleAddress7 = makeAddress easd attrs
+  where
+    easd = PubKeyASD pk
+    [pk] = examplePublicKeys 16 1
+    attrs = AddrAttributes hap BootstrapEraDistr (NMJust (- 559038737))
+    hap = Nothing
+
+exampleAddress' :: Address'
+exampleAddress' = makeAddress' exampleAddrSpendingData_PubKey attrs
+  where
+    attrs = AddrAttributes hap BootstrapEraDistr NMNothing
+    hap = Just (HDAddressPayload (getBytes 32 32))
+
+exampleAddress'1 :: Address'
+exampleAddress'1 = makeAddress' easd attrs
+  where
+    easd = PubKeyASD pk
+    [pk] = examplePublicKeys 24 1
+    attrs = AddrAttributes hap BootstrapEraDistr NMNothing
+    hap = Nothing
+
+exampleAddress'2 :: Address'
+exampleAddress'2 = makeAddress' easd attrs
+  where
+    easd = RedeemASD exampleRedeemPublicKey
+    attrs = AddrAttributes hap asd NMNothing
+    hap = Just (HDAddressPayload (getBytes 15 32))
+    asd = SingleKeyDistr exampleStakeholderId
+
+exampleAddress'3 :: Address'
+exampleAddress'3 = makeAddress' easd attrs
+  where
+    easd = ScriptASD exampleScript
+    attrs = AddrAttributes hap exampleMultiKeyDistr NMNothing
+    hap = Just (HDAddressPayload (getBytes 17 32))
+
+exampleAddress'4 :: Address'
+exampleAddress'4 = makeAddress' easd attrs
+  where
+    easd = UnknownASD 7 "test value"
+    attrs = AddrAttributes Nothing (SingleKeyDistr sId) NMNothing
+    [sId] = exampleStakeholderIds 7 1
+
+exampleAddress'5 :: Address'
+exampleAddress'5 = makeAddress' easd attrs
+  where
+    easd = ScriptASD exampleScript
+    attrs = AddrAttributes hap exampleMultiKeyDistr (NMJust 12345)
+    hap = Just (HDAddressPayload (getBytes 10 32))
+
+exampleAddress'6 :: Address'
+exampleAddress'6 = makeAddress' easd attrs
+  where
+    easd = UnknownASD 200 "test value"
+    attrs = AddrAttributes Nothing (SingleKeyDistr sId) (NMJust 31337)
+    [sId] = exampleStakeholderIds 10 1
+
+exampleAddress'7 :: Address'
+exampleAddress'7 = makeAddress' easd attrs
+  where
+    easd = PubKeyASD pk
+    [pk] = examplePublicKeys 16 1
+    attrs = AddrAttributes hap BootstrapEraDistr (NMJust (- 559038737))
+    hap = Nothing
+
 exampleMultiKeyDistr :: AddrStakeDistribution
 exampleMultiKeyDistr = case mkMultiKeyDistr (M.fromList pairs) of
     Left err -> error $

lib/cardano-sl.cabal

@@ -287,6 +287,7 @@ test-suite cardano-test
                        Test.Pos.MerkleSpec
                        Test.Pos.Infra.Slotting.TypesSpec
                        Test.Pos.Types.BlockSpec
+                       Test.Pos.Types.Golden.SafeCopy
                        Test.Pos.Types.Identity.SafeCopySpec
                        Test.Pos.Types.Identity.ShowReadSpec
                        Test.Pos.Update.Identity.SafeCopySpec
@@ -321,6 +322,7 @@ test-suite cardano-test
                      , cardano-sl-util
                      , cardano-sl-util-test
                      , cborg
+                     , cereal
                      , containers
                      , cryptonite
                      , data-default
@@ -330,6 +332,7 @@ test-suite cardano-test
                      , fmt
                      , formatting
                      , generic-arbitrary
+                     , hedgehog
                      , hspec
                      , lens
                      , log-warper

lib/src/Pos/SafeCopy.hs

@@ -29,6 +29,7 @@ import           Pos.Core.Common (AddrAttributes (..), AddrSpendingData (..),
                                   Coin, CoinPortion (..), Script (..), SharedSeed (..),
                                   TxFeePolicy (..), TxSizeLinear (..))
 import           Pos.Core.Delegation (DlgPayload (..), HeavyDlgIndex (..), LightDlgIndices (..))
+import           Pos.Core.NetworkMagic (NetworkMagic (..))
 import           Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..), LocalSlotIndex (..),
                                     SlotCount (..), SlotId (..))
 import           Pos.Core.Ssc (Commitment (..), CommitmentsMap, Opening (..), SscPayload (..),
@@ -48,7 +49,7 @@ import           Pos.Crypto.Signing.Redeem (RedeemPublicKey (..), RedeemSecretKe
 import           Pos.Crypto.Signing.Signing (ProxyCert (..), ProxySecretKey (..),
                                              ProxySignature (..), PublicKey (..), SecretKey (..),
                                              Signature (..), Signed (..))
-import           Pos.Data.Attributes (Attributes (..), UnparsedFields)
+import           Pos.Data.Attributes (Attributes (..), UnparsedFields, mkAttributes)
 import           Pos.Merkle (MerkleNode (..), MerkleRoot (..), MerkleTree (..))
 import qualified Pos.Util.Modifier as MM
 import           Pos.Util.Util (cerealError, toCerealError)
@@ -137,7 +138,30 @@ deriveSafeCopySimple 0 'base ''HDAddressPayload
 deriveSafeCopySimple 0 'base ''AddrType -- ☃
 deriveSafeCopySimple 0 'base ''AddrStakeDistribution
 deriveSafeCopySimple 0 'base ''AddrSpendingData
-deriveSafeCopySimple 0 'base ''AddrAttributes
+
+instance SafeCopy AddrAttributes where
+    -- Since there is only a Bi instance for (Attributes AddrAttributes),
+    -- we wrap our AddrAttributes before we serialize it.
+    putCopy aa = contain $ do
+        let bs = Bi.serialize (mkAttributes aa)
+        safePut bs
+
+    -- Try decoding as a BSL.ByteString containing the new format, but if that
+    -- fails go for the legacy format.
+    getCopy = contain $ label $ getNonLegacy <|> getLegacy
+      where
+        label = Cereal.label "Pos.Core.Common.AddrAttributes.AddrAttributes:"
+        --
+        getNonLegacy = do
+            eAAA <- Bi.decodeFull <$> safeGet
+            case eAAA of
+                Left  err -> fail (show err)
+                Right aaa -> pure (attrData aaa)
+        --
+        getLegacy = AddrAttributes <$> safeGet
+                                   <*> safeGet
+                                   <*> pure NMNothing
+
 deriveSafeCopySimple 0 'base ''Address'
 deriveSafeCopySimple 0 'base ''Address
 deriveSafeCopySimple 0 'base ''TxInWitness

lib/test/Test.hs

@@ -5,8 +5,13 @@ import           Test.Hspec (hspec)
 import           Spec (spec)
 
 import           Test.Pos.Configuration (defaultTestConf)
+import qualified Test.Pos.Types.Golden.SafeCopy (tests)
+import           Test.Pos.Util.Tripping (runTests)
 
 main :: IO ()
 main = do
     putText $ "default configuration: " <> show defaultTestConf
     hspec spec
+    runTests
+        [ Test.Pos.Types.Golden.SafeCopy.tests
+        ]

lib/test/Test/Pos/Types/Golden/SafeCopy.hs

@@ -0,0 +1,123 @@
+module Test.Pos.Types.Golden.SafeCopy where
+
+import           Universum
+
+import           Hedgehog (Property)
+import qualified Hedgehog as H
+
+import           Pos.SafeCopy ()
+
+import           Test.Pos.Core.ExampleHelpers (exampleAddress, exampleAddress', exampleAddress'1,
+                                               exampleAddress'2, exampleAddress'3, exampleAddress'4,
+                                               exampleAddress'5, exampleAddress'6, exampleAddress'7,
+                                               exampleAddress1, exampleAddress2, exampleAddress3,
+                                               exampleAddress4, exampleAddress5, exampleAddress6,
+                                               exampleAddress7)
+import           Test.Pos.Util.Golden (discoverGolden, goldenTestSafeCopy, goldenTestSafeCopyDec)
+
+--------------------------------------------------------------------------------
+-- Address
+--------------------------------------------------------------------------------
+
+golden_Address0 :: Property
+golden_Address0 =
+    goldenTestSafeCopyDec
+        exampleAddress
+        "test/golden/safecopy/Address0"
+
+golden_Address1 :: Property
+golden_Address1 =
+    goldenTestSafeCopyDec
+        exampleAddress1
+        "test/golden/safecopy/Address1"
+
+golden_Address2 :: Property
+golden_Address2 =
+    goldenTestSafeCopyDec
+        exampleAddress2
+        "test/golden/safecopy/Address2"
+
+golden_Address3 :: Property
+golden_Address3 =
+    goldenTestSafeCopyDec
+        exampleAddress3
+        "test/golden/safecopy/Address3"
+
+golden_Address4 :: Property
+golden_Address4 =
+    goldenTestSafeCopyDec
+        exampleAddress4
+        "test/golden/safecopy/Address4"
+
+golden_Address5 :: Property
+golden_Address5 =
+    goldenTestSafeCopy
+        exampleAddress5
+        "test/golden/safecopy/Address5"
+
+golden_Address6 :: Property
+golden_Address6 =
+    goldenTestSafeCopy
+        exampleAddress6
+        "test/golden/safecopy/Address6"
+
+golden_Address7 :: Property
+golden_Address7 =
+    goldenTestSafeCopy
+        exampleAddress7
+        "test/golden/safecopy/Address7"
+
+--------------------------------------------------------------------------------
+-- Address'
+--------------------------------------------------------------------------------
+
+golden_Address'0 :: Property
+golden_Address'0 =
+    goldenTestSafeCopyDec
+        exampleAddress'
+        "test/golden/safecopy/Address'0"
+
+golden_Address'1 :: Property
+golden_Address'1 =
+    goldenTestSafeCopyDec
+        exampleAddress'1
+        "test/golden/safecopy/Address'1"
+
+golden_Address'2 :: Property
+golden_Address'2 =
+    goldenTestSafeCopyDec
+        exampleAddress'2
+        "test/golden/safecopy/Address'2"
+
+golden_Address'3 :: Property
+golden_Address'3 =
+    goldenTestSafeCopyDec
+        exampleAddress'3
+        "test/golden/safecopy/Address'3"
+
+golden_Address'4 :: Property
+golden_Address'4 =
+    goldenTestSafeCopyDec
+        exampleAddress'4
+        "test/golden/safecopy/Address'4"
+
+golden_Address'5 :: Property
+golden_Address'5 =
+    goldenTestSafeCopy
+        exampleAddress'5
+        "test/golden/safecopy/Address'5"
+
+golden_Address'6 :: Property
+golden_Address'6 =
+    goldenTestSafeCopy
+        exampleAddress'6
+        "test/golden/safecopy/Address'6"
+
+golden_Address'7 :: Property
+golden_Address'7 =
+    goldenTestSafeCopy
+        exampleAddress'7
+        "test/golden/safecopy/Address'7"
+
+tests :: IO Bool
+tests = H.checkSequential $$discoverGolden

lib/test/Test/Pos/Types/Identity/SafeCopySpec.hs

@@ -48,6 +48,7 @@ specBody pm = withProvidedMagicConfig pm $ describe "Types" $ do
         safeCopyTest @Core.SlotId
         safeCopyTest @Core.Coin
         safeCopyTest @Core.Address
+        safeCopyTest @Core.Address'
         safeCopyTest @Core.SharedSeed
         safeCopyTest @Core.ChainDifficulty
         safeCopyTest @Core.VssCertificate