Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit 3fa92ec

Browse files
disassemblerdisassembler
authored
Merge pull request #3685 from input-output-hk/intricate+mhuesch/CO-354/fix-safecopy
[CO-354] Fix SafeCopy instance for `AddrAttributes`
2 parents 9b7ff97 + 1d6d9f7 commit 3fa92ec

File tree

28 files changed

+303
-13
lines changed

28 files changed

+303
-13
lines changed

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

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ module Pos.Core.Common.Address
3030
-- * Construction
3131
, IsBootstrapEraAddr (..)
3232
, makeAddress
33+
, makeAddress'
3334
, makePubKeyAddress
3435
, makePubKeyAddressBoot
3536
, makeRootPubKeyAddress
@@ -170,6 +171,8 @@ decodeTextAddress = decodeAddress . encodeUtf8
170171
----------------------------------------------------------------------------
171172
-- Constructors
172173
----------------------------------------------------------------------------
174+
{-# ANN makeAddress ("HLint: ignore Reduce duplication" :: Text) #-}
175+
{-# ANN makeAddress' ("HLint: ignore Reduce duplication" :: Text) #-}
173176

174177
-- | Make an 'Address' from spending data and attributes.
175178
makeAddress :: AddrSpendingData -> AddrAttributes -> Address
@@ -184,6 +187,14 @@ makeAddress spendingData attributesUnwrapped =
184187
attributes = mkAttributes attributesUnwrapped
185188
address' = Address' (addrType', spendingData, attributes)
186189

190+
-- | Make an 'Address'' from spending data and attributes.
191+
makeAddress' :: AddrSpendingData -> AddrAttributes -> Address'
192+
makeAddress' spendingData attributesUnwrapped = address'
193+
where
194+
addrType' = addrSpendingDataToType spendingData
195+
attributes = mkAttributes attributesUnwrapped
196+
address' = Address' (addrType', spendingData, attributes)
197+
187198
-- | This newtype exists for clarity. It is used to tell pubkey
188199
-- address creation functions whether an address is intended for
189200
-- bootstrap era.

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

Lines changed: 100 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,17 @@ module Test.Pos.Core.ExampleHelpers
77
, exampleAddress2
88
, exampleAddress3
99
, exampleAddress4
10+
, exampleAddress5
11+
, exampleAddress6
12+
, exampleAddress7
13+
, exampleAddress'
14+
, exampleAddress'1
15+
, exampleAddress'2
16+
, exampleAddress'3
17+
, exampleAddress'4
18+
, exampleAddress'5
19+
, exampleAddress'6
20+
, exampleAddress'7
1021
, exampleBlockVersion
1122
, exampleBlockVersionData0
1223
, exampleBlockVersionData1
@@ -122,13 +133,13 @@ import qualified Serokell.Util.Base16 as B16
122133
import qualified Cardano.Crypto.Wallet as CC
123134
import Pos.Binary.Class (Raw (..), asBinary)
124135
import Pos.Core.Common (AddrAttributes (..), AddrSpendingData (..),
125-
AddrStakeDistribution (..), Address (..), BlockCount (..),
126-
ChainDifficulty (..), Coeff (..), Coin (..), CoinPortion (..),
127-
IsBootstrapEraAddr (..), Script (..), ScriptVersion,
128-
SharedSeed (..), SlotLeaders, StakeholderId, StakesList,
129-
TxFeePolicy (..), TxSizeLinear (..), addressHash,
130-
coinPortionDenominator, makeAddress, makePubKeyAddress,
131-
mkMultiKeyDistr)
136+
AddrStakeDistribution (..), Address (..), Address' (..),
137+
BlockCount (..), ChainDifficulty (..), Coeff (..), Coin (..),
138+
CoinPortion (..), IsBootstrapEraAddr (..), Script (..),
139+
ScriptVersion, SharedSeed (..), SlotLeaders, StakeholderId,
140+
StakesList, TxFeePolicy (..), TxSizeLinear (..), addressHash,
141+
coinPortionDenominator, makeAddress, makeAddress',
142+
makePubKeyAddress, mkMultiKeyDistr)
132143
import Pos.Core.Configuration
133144
import Pos.Core.Delegation (HeavyDlgIndex (..), LightDlgIndices (..), ProxySKBlockInfo,
134145
ProxySKHeavy)
@@ -171,6 +182,8 @@ import Test.Pos.Core.Gen (genProtocolConstants)
171182
import Test.Pos.Crypto.Bi (getBytes)
172183
import Test.Pos.Crypto.Gen (genProtocolMagic, genProtocolMagicId)
173184

185+
{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
186+
174187
--------------------------------------------------------------------------------
175188
-- Helpers
176189
--------------------------------------------------------------------------------
@@ -733,6 +746,86 @@ exampleAddress4 = makeAddress easd attrs
733746
attrs = AddrAttributes Nothing (SingleKeyDistr sId) NMNothing
734747
[sId] = exampleStakeholderIds 7 1
735748

749+
exampleAddress5 :: Address
750+
exampleAddress5 = makeAddress easd attrs
751+
where
752+
easd = ScriptASD exampleScript
753+
attrs = AddrAttributes hap exampleMultiKeyDistr (NMJust 12345)
754+
hap = Just (HDAddressPayload (getBytes 10 32))
755+
756+
exampleAddress6 :: Address
757+
exampleAddress6 = makeAddress easd attrs
758+
where
759+
easd = UnknownASD 200 "test value"
760+
attrs = AddrAttributes Nothing (SingleKeyDistr sId) (NMJust 31337)
761+
[sId] = exampleStakeholderIds 10 1
762+
763+
exampleAddress7 :: Address
764+
exampleAddress7 = makeAddress easd attrs
765+
where
766+
easd = PubKeyASD pk
767+
[pk] = examplePublicKeys 16 1
768+
attrs = AddrAttributes hap BootstrapEraDistr (NMJust (- 559038737))
769+
hap = Nothing
770+
771+
exampleAddress' :: Address'
772+
exampleAddress' = makeAddress' exampleAddrSpendingData_PubKey attrs
773+
where
774+
attrs = AddrAttributes hap BootstrapEraDistr NMNothing
775+
hap = Just (HDAddressPayload (getBytes 32 32))
776+
777+
exampleAddress'1 :: Address'
778+
exampleAddress'1 = makeAddress' easd attrs
779+
where
780+
easd = PubKeyASD pk
781+
[pk] = examplePublicKeys 24 1
782+
attrs = AddrAttributes hap BootstrapEraDistr NMNothing
783+
hap = Nothing
784+
785+
exampleAddress'2 :: Address'
786+
exampleAddress'2 = makeAddress' easd attrs
787+
where
788+
easd = RedeemASD exampleRedeemPublicKey
789+
attrs = AddrAttributes hap asd NMNothing
790+
hap = Just (HDAddressPayload (getBytes 15 32))
791+
asd = SingleKeyDistr exampleStakeholderId
792+
793+
exampleAddress'3 :: Address'
794+
exampleAddress'3 = makeAddress' easd attrs
795+
where
796+
easd = ScriptASD exampleScript
797+
attrs = AddrAttributes hap exampleMultiKeyDistr NMNothing
798+
hap = Just (HDAddressPayload (getBytes 17 32))
799+
800+
exampleAddress'4 :: Address'
801+
exampleAddress'4 = makeAddress' easd attrs
802+
where
803+
easd = UnknownASD 7 "test value"
804+
attrs = AddrAttributes Nothing (SingleKeyDistr sId) NMNothing
805+
[sId] = exampleStakeholderIds 7 1
806+
807+
exampleAddress'5 :: Address'
808+
exampleAddress'5 = makeAddress' easd attrs
809+
where
810+
easd = ScriptASD exampleScript
811+
attrs = AddrAttributes hap exampleMultiKeyDistr (NMJust 12345)
812+
hap = Just (HDAddressPayload (getBytes 10 32))
813+
814+
exampleAddress'6 :: Address'
815+
exampleAddress'6 = makeAddress' easd attrs
816+
where
817+
easd = UnknownASD 200 "test value"
818+
attrs = AddrAttributes Nothing (SingleKeyDistr sId) (NMJust 31337)
819+
[sId] = exampleStakeholderIds 10 1
820+
821+
exampleAddress'7 :: Address'
822+
exampleAddress'7 = makeAddress' easd attrs
823+
where
824+
easd = PubKeyASD pk
825+
[pk] = examplePublicKeys 16 1
826+
attrs = AddrAttributes hap BootstrapEraDistr (NMJust (- 559038737))
827+
hap = Nothing
828+
736829
exampleMultiKeyDistr :: AddrStakeDistribution
737830
exampleMultiKeyDistr = case mkMultiKeyDistr (M.fromList pairs) of
738831
Left err -> error $

‎lib/cardano-sl.cabal

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -287,6 +287,7 @@ test-suite cardano-test
287287
Test.Pos.MerkleSpec
288288
Test.Pos.Infra.Slotting.TypesSpec
289289
Test.Pos.Types.BlockSpec
290+
Test.Pos.Types.Golden.SafeCopy
290291
Test.Pos.Types.Identity.SafeCopySpec
291292
Test.Pos.Types.Identity.ShowReadSpec
292293
Test.Pos.Update.Identity.SafeCopySpec
@@ -321,6 +322,7 @@ test-suite cardano-test
321322
, cardano-sl-util
322323
, cardano-sl-util-test
323324
, cborg
325+
, cereal
324326
, containers
325327
, cryptonite
326328
, data-default
@@ -330,6 +332,7 @@ test-suite cardano-test
330332
, fmt
331333
, formatting
332334
, generic-arbitrary
335+
, hedgehog
333336
, hspec
334337
, lens
335338
, log-warper

‎lib/src/Pos/SafeCopy.hs

Lines changed: 26 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ import Pos.Core.Common (AddrAttributes (..), AddrSpendingData (..),
2929
Coin, CoinPortion (..), Script (..), SharedSeed (..),
3030
TxFeePolicy (..), TxSizeLinear (..))
3131
import Pos.Core.Delegation (DlgPayload (..), HeavyDlgIndex (..), LightDlgIndices (..))
32+
import Pos.Core.NetworkMagic (NetworkMagic (..))
3233
import Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..), LocalSlotIndex (..),
3334
SlotCount (..), SlotId (..))
3435
import Pos.Core.Ssc (Commitment (..), CommitmentsMap, Opening (..), SscPayload (..),
@@ -48,7 +49,7 @@ import Pos.Crypto.Signing.Redeem (RedeemPublicKey (..), RedeemSecretKe
4849
import Pos.Crypto.Signing.Signing (ProxyCert (..), ProxySecretKey (..),
4950
ProxySignature (..), PublicKey (..), SecretKey (..),
5051
Signature (..), Signed (..))
51-
import Pos.Data.Attributes (Attributes (..), UnparsedFields)
52+
import Pos.Data.Attributes (Attributes (..), UnparsedFields, mkAttributes)
5253
import Pos.Merkle (MerkleNode (..), MerkleRoot (..), MerkleTree (..))
5354
import qualified Pos.Util.Modifier as MM
5455
import Pos.Util.Util (cerealError, toCerealError)
@@ -137,7 +138,30 @@ deriveSafeCopySimple 0 'base ''HDAddressPayload
137138
deriveSafeCopySimple 0 'base ''AddrType -- ☃
138139
deriveSafeCopySimple 0 'base ''AddrStakeDistribution
139140
deriveSafeCopySimple 0 'base ''AddrSpendingData
140-
deriveSafeCopySimple 0 'base ''AddrAttributes
141+
142+
instance SafeCopy AddrAttributes where
143+
-- Since there is only a Bi instance for (Attributes AddrAttributes),
144+
-- we wrap our AddrAttributes before we serialize it.
145+
putCopy aa = contain $ do
146+
let bs = Bi.serialize (mkAttributes aa)
147+
safePut bs
148+
149+
-- Try decoding as a BSL.ByteString containing the new format, but if that
150+
-- fails go for the legacy format.
151+
getCopy = contain $ label $ getNonLegacy <|> getLegacy
152+
where
153+
label = Cereal.label "Pos.Core.Common.AddrAttributes.AddrAttributes:"
154+
--
155+
getNonLegacy = do
156+
eAAA <- Bi.decodeFull <$> safeGet
157+
case eAAA of
158+
Left err -> fail (show err)
159+
Right aaa -> pure (attrData aaa)
160+
--
161+
getLegacy = AddrAttributes <$> safeGet
162+
<*> safeGet
163+
<*> pure NMNothing
164+
141165
deriveSafeCopySimple 0 'base ''Address'
142166
deriveSafeCopySimple 0 'base ''Address
143167
deriveSafeCopySimple 0 'base ''TxInWitness

‎lib/test/Test.hs

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,13 @@ import Test.Hspec (hspec)
55
import Spec (spec)
66

77
import Test.Pos.Configuration (defaultTestConf)
8+
import qualified Test.Pos.Types.Golden.SafeCopy (tests)
9+
import Test.Pos.Util.Tripping (runTests)
810

911
main :: IO ()
1012
main = do
1113
putText $ "default configuration: " <> show defaultTestConf
1214
hspec spec
15+
runTests
16+
[ Test.Pos.Types.Golden.SafeCopy.tests
17+
]

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

Lines changed: 123 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,123 @@
1+
module Test.Pos.Types.Golden.SafeCopy where
2+
3+
import Universum
4+
5+
import Hedgehog (Property)
6+
import qualified Hedgehog as H
7+
8+
import Pos.SafeCopy ()
9+
10+
import Test.Pos.Core.ExampleHelpers (exampleAddress, exampleAddress', exampleAddress'1,
11+
exampleAddress'2, exampleAddress'3, exampleAddress'4,
12+
exampleAddress'5, exampleAddress'6, exampleAddress'7,
13+
exampleAddress1, exampleAddress2, exampleAddress3,
14+
exampleAddress4, exampleAddress5, exampleAddress6,
15+
exampleAddress7)
16+
import Test.Pos.Util.Golden (discoverGolden, goldenTestSafeCopy, goldenTestSafeCopyDec)
17+
18+
--------------------------------------------------------------------------------
19+
-- Address
20+
--------------------------------------------------------------------------------
21+
22+
golden_Address0 :: Property
23+
golden_Address0 =
24+
goldenTestSafeCopyDec
25+
exampleAddress
26+
"test/golden/safecopy/Address0"
27+
28+
golden_Address1 :: Property
29+
golden_Address1 =
30+
goldenTestSafeCopyDec
31+
exampleAddress1
32+
"test/golden/safecopy/Address1"
33+
34+
golden_Address2 :: Property
35+
golden_Address2 =
36+
goldenTestSafeCopyDec
37+
exampleAddress2
38+
"test/golden/safecopy/Address2"
39+
40+
golden_Address3 :: Property
41+
golden_Address3 =
42+
goldenTestSafeCopyDec
43+
exampleAddress3
44+
"test/golden/safecopy/Address3"
45+
46+
golden_Address4 :: Property
47+
golden_Address4 =
48+
goldenTestSafeCopyDec
49+
exampleAddress4
50+
"test/golden/safecopy/Address4"
51+
52+
golden_Address5 :: Property
53+
golden_Address5 =
54+
goldenTestSafeCopy
55+
exampleAddress5
56+
"test/golden/safecopy/Address5"
57+
58+
golden_Address6 :: Property
59+
golden_Address6 =
60+
goldenTestSafeCopy
61+
exampleAddress6
62+
"test/golden/safecopy/Address6"
63+
64+
golden_Address7 :: Property
65+
golden_Address7 =
66+
goldenTestSafeCopy
67+
exampleAddress7
68+
"test/golden/safecopy/Address7"
69+
70+
--------------------------------------------------------------------------------
71+
-- Address'
72+
--------------------------------------------------------------------------------
73+
74+
golden_Address'0 :: Property
75+
golden_Address'0 =
76+
goldenTestSafeCopyDec
77+
exampleAddress'
78+
"test/golden/safecopy/Address'0"
79+
80+
golden_Address'1 :: Property
81+
golden_Address'1 =
82+
goldenTestSafeCopyDec
83+
exampleAddress'1
84+
"test/golden/safecopy/Address'1"
85+
86+
golden_Address'2 :: Property
87+
golden_Address'2 =
88+
goldenTestSafeCopyDec
89+
exampleAddress'2
90+
"test/golden/safecopy/Address'2"
91+
92+
golden_Address'3 :: Property
93+
golden_Address'3 =
94+
goldenTestSafeCopyDec
95+
exampleAddress'3
96+
"test/golden/safecopy/Address'3"
97+
98+
golden_Address'4 :: Property
99+
golden_Address'4 =
100+
goldenTestSafeCopyDec
101+
exampleAddress'4
102+
"test/golden/safecopy/Address'4"
103+
104+
golden_Address'5 :: Property
105+
golden_Address'5 =
106+
goldenTestSafeCopy
107+
exampleAddress'5
108+
"test/golden/safecopy/Address'5"
109+
110+
golden_Address'6 :: Property
111+
golden_Address'6 =
112+
goldenTestSafeCopy
113+
exampleAddress'6
114+
"test/golden/safecopy/Address'6"
115+
116+
golden_Address'7 :: Property
117+
golden_Address'7 =
118+
goldenTestSafeCopy
119+
exampleAddress'7
120+
"test/golden/safecopy/Address'7"
121+
122+
tests :: IO Bool
123+
tests = H.checkSequential $$discoverGolden

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ specBody pm = withProvidedMagicConfig pm $ describe "Types" $ do
4848
safeCopyTest @Core.SlotId
4949
safeCopyTest @Core.Coin
5050
safeCopyTest @Core.Address
51+
safeCopyTest @Core.Address'
5152
safeCopyTest @Core.SharedSeed
5253
safeCopyTest @Core.ChainDifficulty
5354
safeCopyTest @Core.VssCertificate

‎lib/test/golden/safecopy/Address'0

208 Bytes
Binary file not shown.

‎lib/test/golden/safecopy/Address'1

160 Bytes
Binary file not shown.

‎lib/test/golden/safecopy/Address'2

206 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)