Merge #2142

2142: cardano-node: 1.19.1-patched -> 1.20.0 r=rvl a=rvl ### Issue Number ADP-307 / #2098 ### Overview Updates cardano-node to [1.20.0](https://github.com/input-output-hk/cardano-node/releases/tag/1.20.0) There are quite a few upstream API changes. Snapshot PR is input-output-hk/cardano-haskell#28. Co-authored-by: Rodney Lorrimar <rodney.lorrimar@iohk.io>
cardano-foundation · Sep 21, 2020 · 4373014 · 4373014
2 parents 55d0811 + b335bae
commit 4373014
Show file tree

Hide file tree

Showing 64 changed files with 399 additions and 337 deletions.
diff --git a/README.md b/README.md
@@ -70,7 +70,8 @@ See **Installation Instructions** for each available [release](https://github.co
 >
 > | cardano-wallet | jörmungandr (compatible versions) | cardano-node (compatible versions)
 > | --- | --- | ---
-> | `master` branch | [v0.9.0](https://github.com/input-output-hk/jormungandr/releases/tag/v0.9.0) | [1.19.1](https://github.com/input-output-hk/cardano-node/releases/tag/1.19.1)
+> | `master` branch | [v0.9.0](https://github.com/input-output-hk/jormungandr/releases/tag/v0.9.0) | [1.20.0](https://github.com/input-output-hk/cardano-node/releases/tag/1.20.0)
+> | [v2020-09-11](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-09-11)`master` branch | [v0.9.0](https://github.com/input-output-hk/jormungandr/releases/tag/v0.9.0) | [1.19.1](https://github.com/input-output-hk/cardano-node/releases/tag/1.19.1)
 > | [v2020-08-03](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-08-03) | [v0.9.0](https://github.com/input-output-hk/jormungandr/releases/tag/v0.9.0) | [1.18.0](https://github.com/input-output-hk/cardano-node/releases/tag/1.18.0)
 > | [v2020-07-28](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-07-28) | [v0.9.0](https://github.com/input-output-hk/jormungandr/releases/tag/v0.9.0) | [1.18.0](https://github.com/input-output-hk/cardano-node/releases/tag/1.18.0)
 > | [v2020-07-06](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-07-06) | [v0.9.0](https://github.com/input-output-hk/jormungandr/releases/tag/v0.9.0) | [1.14.2](https://github.com/input-output-hk/cardano-node/releases/tag/1.14.2)

diff --git a/lib/core-integration/cardano-wallet-core-integration.cabal b/lib/core-integration/cardano-wallet-core-integration.cabal
@@ -65,7 +65,6 @@ library
     , retry
     , say
     , scrypt
-    , shelley-spec-ledger
     , stm
     , template-haskell
     , temporary

diff --git a/lib/core-integration/src/Test/Integration/Framework/TestData.hs b/lib/core-integration/src/Test/Integration/Framework/TestData.hs
@@ -346,7 +346,7 @@ errMsg400WronglyEncodedTxPayload =
 
 errMsg400TxMetadataStringTooLong :: String
 errMsg400TxMetadataStringTooLong =
-    "Error in $.metadata: JSON string or bytestring is longer than 64 bytes"
+    "Text string metadata value must consist of at most 64 UTF8 bytes"
 
 errMsg400TxTooLarge :: String
 errMsg400TxTooLarge =

diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs
@@ -43,6 +43,7 @@ import Cardano.Wallet.Primitive.Types
     , Hash (..)
     , SortOrder (..)
     , TxMetadata (..)
+    , TxMetadataValue (..)
     , TxStatus (..)
     , WalletId
     )
@@ -144,7 +145,6 @@ import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Network.HTTP.Types.Status as HTTP
-import qualified Shelley.Spec.Ledger.MetaData as MD
 
 data TestCase a = TestCase
     { query :: T.Text
@@ -580,10 +580,8 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
 
         basePayload <- mkTxPayload ctx wb amt fixturePassphrase
 
-        let txMeta = [json|{
-                "1": "hello"
-            }|]
-        let expected = TxMetadata (MD.MetaData (Map.singleton 1 (MD.S "hello")))
+        let txMeta = [json|{ "1": "hello" }|]
+        let expected = TxMetadata $ Map.singleton 1 $ TxMetaText "hello"
         let payload = addTxMetadata txMeta basePayload
 
         ra <- request @(ApiTransaction n) ctx
@@ -653,7 +651,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
 
         basePayload <- mkTxPayload ctx wb amt fixturePassphrase
 
-        let txMeta = Aeson.object ["1" .= T.replicate 65 "a"]
+        let txMeta = [json|{ "1": #{T.replicate 65 "a"} }|]
         let payload = addTxMetadata txMeta basePayload
 
         r <- request @(ApiTransaction n) ctx
@@ -671,8 +669,9 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
         -- This will encode to at least 8k of CBOR. The max tx size for the
         -- integration tests cluster is 4k.
         let txMeta = Aeson.object
-                [ (toText @Int i, Aeson.String (T.replicate 64 "a"))
+                [ (toText @Int i, bytes)
                 | i <- [0..127] ]
+            bytes = Aeson.String ("0x" <> T.replicate 64 "a")
         let payload = addTxMetadata txMeta basePayload
 
         r <- request @(ApiTransaction n) ctx
@@ -715,7 +714,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
 
         basePayload <- mkTxPayload ctx wb amt fixturePassphrase
 
-        let txMeta = Aeson.object ["1" .= T.replicate 65 "a"]
+        let txMeta = [json|{ "1": #{T.replicate 65 "a"} }|]
         let payload = addTxMetadata txMeta basePayload
 
         r <- request @ApiFee ctx
@@ -733,8 +732,9 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do
         -- This will encode to at least 8k of CBOR. The max tx size for the
         -- integration tests cluster is 4k.
         let txMeta = Aeson.object
-                [ (toText @Int i, Aeson.String (T.replicate 64 "a"))
+                [ (toText @Int i, bytes)
                 | i <- [0..127] ]
+            bytes = Aeson.String ("0x" <> T.replicate 64 "a")
         let payload = addTxMetadata txMeta basePayload
         print payload
         r <- request @ApiFee ctx

diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal
@@ -86,7 +86,6 @@ library
     , servant
     , servant-client
     , servant-server
-    , shelley-spec-ledger
     , split
     , statistics
     , stm
@@ -238,7 +237,6 @@ test-suite unit
     , servant
     , servant-server
     , servant-swagger
-    , shelley-spec-ledger
     , stm
     , swagger2
     , temporary

diff --git a/lib/core/src/Cardano/Wallet/Api/Types.hs b/lib/core/src/Cardano/Wallet/Api/Types.hs
@@ -130,7 +130,9 @@ import Prelude
 import Cardano.Address.Derivation
     ( XPrv, XPub, xpubToBytes )
 import Cardano.Api.MetaData
-    ( jsonFromMetadata, jsonToMetadata, renderMetaDataJsonConversionError )
+    ( TxMetadataJsonSchema (..), metadataFromJson, metadataToJson )
+import Cardano.Api.Typed
+    ( displayError )
 import Cardano.Mnemonic
     ( MkSomeMnemonic (..)
     , MkSomeMnemonicError (..)
@@ -1253,12 +1255,12 @@ instance
     toJSON = genericToJSON defaultRecordTypeOptions
 
 instance FromJSON (ApiT TxMetadata) where
-    parseJSON = fmap ApiT . either (fail . prettyError) pure . jsonToMetadata
-      where
-        prettyError = T.unpack . renderMetaDataJsonConversionError
+    parseJSON = fmap ApiT
+        . either (fail . displayError) pure
+        . metadataFromJson TxMetadataJsonNoSchema
 
 instance ToJSON (ApiT TxMetadata) where
-    toJSON = jsonFromMetadata . getApiT
+    toJSON = metadataToJson TxMetadataJsonNoSchema . getApiT
 
 instance FromJSON ApiTxMetadata where
     parseJSON Aeson.Null = pure $ ApiTxMetadata Nothing

diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite/Types.hs
@@ -21,7 +21,9 @@ module Cardano.Wallet.DB.Sqlite.Types where
 import Prelude
 
 import Cardano.Api.MetaData
-    ( jsonFromMetadata, jsonToMetadata )
+    ( TxMetadataJsonSchema (..), metadataFromJson, metadataToJson )
+import Cardano.Api.Typed
+    ( displayError )
 import Cardano.Slotting.Slot
     ( SlotNo (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
@@ -351,9 +353,9 @@ instance PersistField TxMetadata where
         decodeUtf8 .
         BL.toStrict .
         Aeson.encode .
-        jsonFromMetadata
+        metadataToJson TxMetadataJsonDetailedSchema
     fromPersistValue =
-        (left (T.pack . show) . jsonToMetadata) <=<
+        (left (T.pack . displayError) . metadataFromJson TxMetadataJsonDetailedSchema) <=<
         (left T.pack . Aeson.eitherDecode . BL.fromStrict . encodeUtf8) <=<
         fromPersistValue
 

diff --git a/lib/core/src/Cardano/Wallet/Orphans.hs b/lib/core/src/Cardano/Wallet/Orphans.hs
@@ -13,7 +13,7 @@ module Cardano.Wallet.Orphans where
 import Prelude
 
 import Cardano.Api.Typed
-    ( TxMetadata (..) )
+    ( TxMetadata (..), TxMetadataValue (..) )
 import Cardano.Slotting.Slot
     ( SlotNo (..) )
 import Control.DeepSeq
@@ -22,8 +22,6 @@ import Data.Ord
     ( comparing )
 import Fmt
     ( Buildable (..), blockListF, hexF, nameF, unlinesF )
-import Shelley.Spec.Ledger.MetaData
-    ( MetaData (..), MetaDatum (..) )
 
 import qualified Data.Map as Map
 
@@ -36,22 +34,25 @@ instance Ord TxMetadata where
     compare = comparing show
 
 instance Buildable TxMetadata where
-    build (TxMetadata (MetaData m)) =
+    build (TxMetadata m) =
         unlinesF (map buildElem (Map.toList m))
       where
         buildElem (n, d) = nameF ("element " <> build n) $ buildDatum d
         buildDatum = \case
-            Map as -> blockListF $ mconcat
+            TxMetaMap as -> blockListF $ mconcat
                 [ [ nameF "key" (buildDatum k), nameF "val" (buildDatum v) ]
                 | (k, v) <- as ]
-            List xs -> nameF "list" $ blockListF (map buildDatum xs)
-            I i -> build i
-            B bs -> hexF bs
-            S s -> build (show s)
-
-instance NFData MetaDatum
-
-instance NFData MetaData
+            TxMetaList xs -> nameF "list" $ blockListF (map buildDatum xs)
+            TxMetaNumber i -> build i
+            TxMetaBytes bs -> hexF bs
+            TxMetaText s -> build (show s)
 
 instance NFData TxMetadata where
     rnf (TxMetadata md) = rnf md
+
+instance NFData TxMetadataValue where
+    rnf (TxMetaMap x) = rnf x
+    rnf (TxMetaList x) = rnf x
+    rnf (TxMetaNumber x) = rnf x
+    rnf (TxMetaBytes x) = rnf x
+    rnf (TxMetaText x) = rnf x
diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs
@@ -42,6 +42,7 @@ module Cardano.Wallet.Primitive.Types
     , TxOut(..)
     , TxMeta(..)
     , TxMetadata(..)
+    , TxMetadataValue(..)
     , Direction(..)
     , TxStatus(..)
     , SealedTx (..)
@@ -177,7 +178,7 @@ module Cardano.Wallet.Primitive.Types
 import Prelude
 
 import Cardano.Api.Typed
-    ( TxMetadata (..) )
+    ( TxMetadata (..), TxMetadataValue (..) )
 import Cardano.Slotting.Slot
     ( SlotNo (..) )
 import Cardano.Wallet.Orphans
@@ -279,7 +280,6 @@ import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Data.Text.Lazy.Builder as Builder
-import qualified Shelley.Spec.Ledger.MetaData as MD
 
 {-------------------------------------------------------------------------------
                              Wallet Metadata
@@ -1020,7 +1020,7 @@ fromTransactionInfo info = Tx
 
 -- | Test whether the given metadata map is empty.
 txMetadataIsNull :: TxMetadata -> Bool
-txMetadataIsNull (TxMetadata (MD.MetaData md)) = Map.null md
+txMetadataIsNull (TxMetadata md) = Map.null md
 
 -- | Drop time-specific information
 toTxHistory :: TransactionInfo -> (Tx, TxMeta)

diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs
@@ -1571,17 +1571,17 @@ instance ToSchema ByronWalletPutPassphraseData where
 
 instance ToSchema (PostTransactionData t) where
     declareNamedSchema _ = do
-        addDefinition transactionMetadatumSchema
+        addDefinition transactionMetadataValueSchema
         declareSchemaForDefinition "ApiPostTransactionData"
 
 instance ToSchema (PostTransactionFeeData t) where
     declareNamedSchema _ = do
-        addDefinition transactionMetadatumSchema
+        addDefinition transactionMetadataValueSchema
         declareSchemaForDefinition "ApiPostTransactionFeeData"
 
 instance ToSchema (ApiTransaction t) where
     declareNamedSchema _ = do
-        addDefinition transactionMetadatumSchema
+        addDefinition transactionMetadataValueSchema
         declareSchemaForDefinition "ApiTransaction"
 
 instance ToSchema ApiUtxoStatistics where
@@ -1617,11 +1617,11 @@ instance ToSchema ApiPostRandomAddressData where
 -- switched to a library that supports OpenAPI 3.0, we can remove this empty
 -- schema and use instead something like:
 --
---     addDefinition =<< declareSchemaForDefinition "TransactionMetadatum"
+--     addDefinition =<< declareSchemaForDefinition "TransactionMetadataValue"
 --
-transactionMetadatumSchema :: NamedSchema
-transactionMetadatumSchema =
-    NamedSchema (Just "TransactionMetadatum") $ mempty
+transactionMetadataValueSchema :: NamedSchema
+transactionMetadataValueSchema =
+    NamedSchema (Just "TransactionMetadataValue") $ mempty
         & additionalProperties ?~ AdditionalPropertiesAllowed True
 
 -- | Utility function to provide an ad-hoc 'ToSchema' instance for a definition:

diff --git a/lib/core/test/unit/Cardano/Wallet/Gen.hs b/lib/core/test/unit/Cardano/Wallet/Gen.hs
@@ -27,9 +27,11 @@ import Prelude
 import Cardano.Address.Derivation
     ( xpubFromBytes )
 import Cardano.Api.MetaData
-    ( jsonToMetadata )
-import Cardano.Api.Typed
-    ( TxMetadata (..) )
+    ( TxMetadata (..)
+    , TxMetadataJsonSchema (..)
+    , TxMetadataValue (..)
+    , metadataFromJson
+    )
 import Cardano.Mnemonic
     ( ConsistentEntropy, EntropySize, Mnemonic, entropyToMnemonic )
 import Cardano.Wallet.Primitive.Types
@@ -62,8 +64,6 @@ import Data.Word
     ( Word, Word32 )
 import GHC.TypeLits
     ( natVal )
-import Shelley.Spec.Ledger.MetaData
-    ( MetaData, MetaDatum )
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
@@ -91,7 +91,6 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.Map as Map
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
-import qualified Shelley.Spec.Ledger.MetaData as MD
 
 -- | Generates an arbitrary mnemonic of a size according to the type parameter.
 --
@@ -214,28 +213,25 @@ genTxMetadata = do
     d <- scale (`mod` maxBreadth) $ listOf1 (sizedMetadataValue maxDepth)
     i <- vectorOf @Word (length d) arbitrary
     let json = toJSON $ HM.fromList $ zip i d
-    case jsonToMetadata json of
+    case metadataFromJson TxMetadataJsonNoSchema json of
         Left e -> fail $ show e <> ": " <> show (Aeson.encode json)
         Right metadata -> pure metadata
 
 shrinkTxMetadata :: TxMetadata -> [TxMetadata]
-shrinkTxMetadata (TxMetadata m) = TxMetadata <$> shrinkMetaData m
-
-shrinkMetaData :: MetaData -> [MetaData]
-shrinkMetaData (MD.MetaData m) = MD.MetaData . Map.fromList
-    <$> shrinkList shrinkMetaDataEntry (Map.toList m)
+shrinkTxMetadata (TxMetadata m) = TxMetadata . Map.fromList
+    <$> shrinkList shrinkTxMetadataEntry (Map.toList m)
   where
-    shrinkMetaDataEntry (k, v) = (k,) <$> shrinkMetaDatum v
+    shrinkTxMetadataEntry (k, v) = (k,) <$> shrinkTxMetadataValue v
 
-shrinkMetaDatum :: MetaDatum -> [MetaDatum]
-shrinkMetaDatum (MD.Map xs) =
-    MD.Map . sortOn fst . nubOn fst <$> shrinkList shrinkPair xs
+shrinkTxMetadataValue :: TxMetadataValue -> [TxMetadataValue]
+shrinkTxMetadataValue (TxMetaMap xs) =
+    TxMetaMap . sortOn fst . nubOn fst <$> shrinkList shrinkPair xs
   where
     shrinkPair (k,v) =
-        ((k,) <$> shrinkMetaDatum v) ++
-        ((,v) <$> shrinkMetaDatum k)
-shrinkMetaDatum (MD.List xs) =
-    MD.List <$> filter (not . null) (shrinkList shrinkMetaDatum xs)
-shrinkMetaDatum (MD.I i) = MD.I <$> shrink i
-shrinkMetaDatum (MD.B b) = MD.B <$> shrinkByteString b
-shrinkMetaDatum (MD.S s) = MD.S <$> shrinkText s
+        ((k,) <$> shrinkTxMetadataValue v) ++
+        ((,v) <$> shrinkTxMetadataValue k)
+shrinkTxMetadataValue (TxMetaList xs) =
+    TxMetaList <$> filter (not . null) (shrinkList shrinkTxMetadataValue xs)
+shrinkTxMetadataValue (TxMetaNumber i) = TxMetaNumber <$> shrink i
+shrinkTxMetadataValue (TxMetaBytes b) = TxMetaBytes <$> shrinkByteString b
+shrinkTxMetadataValue (TxMetaText s) = TxMetaText <$> shrinkText s