From 7308605c14db5f5e66b426f8596d699e6bfae822 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Thu, 2 May 2024 18:33:42 +0300 Subject: [PATCH 01/19] Add toJSON and fromJSON to BareBlockItemType --- haskell-src/Concordium/Cost.hs | 11 ++++--- haskell-src/Concordium/Types.hs | 1 + haskell-src/Concordium/Types/Transactions.hs | 32 ++++++++++++++++++++ haskell-src/Concordium/Wasm.hs | 4 +-- 4 files changed, 41 insertions(+), 7 deletions(-) diff --git a/haskell-src/Concordium/Cost.hs b/haskell-src/Concordium/Cost.hs index 03d041efa..1a19db449 100644 --- a/haskell-src/Concordium/Cost.hs +++ b/haskell-src/Concordium/Cost.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DerivingVia, TypeFamilies #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE TypeFamilies #-} -- | -- Definition of cost functions for the different transactions. @@ -237,11 +238,11 @@ initializeContractInstanceCreateCost = 200 updateContractInstanceBaseCost :: Energy updateContractInstanceBaseCost = 300 --- |Maximum amount of nested V1 contract calls. That is, the maximum amount of --- execution frames that need to be kept alive at the same time. +-- | Maximum amount of nested V1 contract calls. That is, the maximum amount of +-- execution frames that need to be kept alive at the same time. -- --- Since each frame that is kept alive can consume up to 32MB of memory this limits --- the worst case memory use of contract calls. +-- Since each frame that is kept alive can consume up to 32MB of memory this limits +-- the worst case memory use of contract calls. allowedContractCallDepth :: SProtocolVersion pv -> Word -> Bool allowedContractCallDepth spv n = demoteProtocolVersion spv <= P6 || n < 384 diff --git a/haskell-src/Concordium/Types.hs b/haskell-src/Concordium/Types.hs index e1fed8678..d10c5ddae 100644 --- a/haskell-src/Concordium/Types.hs +++ b/haskell-src/Concordium/Types.hs @@ -996,6 +996,7 @@ instance S.Serialize PayloadSize where -- | Serialized payload of the transaction newtype EncodedPayload = EncodedPayload {_spayload :: BSS.ShortByteString} deriving (Eq, Show) + deriving (AE.ToJSON, AE.FromJSON) via BSH.ByteStringHex -- | There is no corresponding getter (to fit into the Serialize instance) since -- encoded payload does not encode its own length. See 'getPayload' below. diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index b58cc1a12..a738518a7 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -160,6 +160,23 @@ data AccountTransaction = AccountTransaction } deriving (Eq, Show) +instance ToJSON AccountTransaction where + toJSON (AccountTransaction signature header payload signHash) = + AE.object + [ "signature" AE..= signature, + "header" AE..= header, + "payload" AE..= payload, + "signHash" AE..= signHash + ] + +instance FromJSON AccountTransaction where + parseJSON = AE.withObject "AccountTransaction" $ \obj -> do + atrSignature <- obj AE..: "signature" + atrHeader <- obj AE..: "header" + atrPayload <- obj AE..: "payload" + atrSignHash <- obj AE..: "signHash" + return AccountTransaction{..} + -- | Construct an 'AccountTransaction', computing the correct -- 'TransactionSignHash'. makeAccountTransaction :: TransactionSignature -> TransactionHeader -> EncodedPayload -> AccountTransaction @@ -341,6 +358,21 @@ data BareBlockItem } deriving (Eq, Show) +-- | Concordium-client can output partially signed transactions into a JSON-file to support multi-sig. +-- 'CredentialDeployment' and 'ChainUpdate' are not created by regular user accounts +-- hence the `ToJSON` is not implemented for these types of transactions. +instance ToJSON BareBlockItem where + toJSON (NormalTransaction transaction) = + toJSON transaction + toJSON (CredentialDeployment _transaction) = + error "ToJSON for CredentialDeployment in BareBlockItem is not implemented" + toJSON (ChainUpdate _transaction) = + error "ToJSON for ChainUpdate in BareBlockItem is not implemented" + +instance FromJSON BareBlockItem where + parseJSON = AE.withObject "BareBlockItem" $ \obj -> do + NormalTransaction <$> parseJSON (AE.Object obj) + instance HashableTo TransactionHash BareBlockItem where getHash = transactionHashFromBareBlockItem diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index 4afaa125b..b002caeab 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -193,8 +193,8 @@ pvCostSemanticsVersion = \case SP6 -> CSV0 SP7 -> CSV1 --- |Convert the version to a Word8. This is used when transferring information --- via FFI. +-- | Convert the version to a Word8. This is used when transferring information +-- via FFI. costSemanticsVersionToWord8 :: CostSemanticsVersion -> Word8 costSemanticsVersionToWord8 = \case CSV0 -> 0 From 841526d34c38c938bdbb78c84405553cb50ce9c4 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Fri, 3 May 2024 18:54:39 +0300 Subject: [PATCH 02/19] Remove bareblockItem to and from JSON implementation --- haskell-src/Concordium/Types/Transactions.hs | 15 --------------- 1 file changed, 15 deletions(-) diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index a738518a7..7b6f8786c 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -358,21 +358,6 @@ data BareBlockItem } deriving (Eq, Show) --- | Concordium-client can output partially signed transactions into a JSON-file to support multi-sig. --- 'CredentialDeployment' and 'ChainUpdate' are not created by regular user accounts --- hence the `ToJSON` is not implemented for these types of transactions. -instance ToJSON BareBlockItem where - toJSON (NormalTransaction transaction) = - toJSON transaction - toJSON (CredentialDeployment _transaction) = - error "ToJSON for CredentialDeployment in BareBlockItem is not implemented" - toJSON (ChainUpdate _transaction) = - error "ToJSON for ChainUpdate in BareBlockItem is not implemented" - -instance FromJSON BareBlockItem where - parseJSON = AE.withObject "BareBlockItem" $ \obj -> do - NormalTransaction <$> parseJSON (AE.Object obj) - instance HashableTo TransactionHash BareBlockItem where getHash = transactionHashFromBareBlockItem From e9e71c168600edecabe02be0974719665a7cd55a Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Sun, 5 May 2024 12:48:53 +0300 Subject: [PATCH 03/19] Add toJson for bareblockItem --- haskell-src/Concordium/Types/Transactions.hs | 11 +++++++++++ stack.yaml | 2 ++ 2 files changed, 13 insertions(+) diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index 7b6f8786c..d176dfba3 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -358,6 +358,17 @@ data BareBlockItem } deriving (Eq, Show) +-- | Concordium-client can output partially signed transactions into a JSON-file to support multi-sig. +-- 'CredentialDeployment' and 'ChainUpdate' are not created by regular user accounts +-- hence the `ToJSON` is not implemented for these types of transactions. +instance ToJSON BareBlockItem where + toJSON (NormalTransaction transaction) = + toJSON transaction + toJSON (CredentialDeployment _transaction) = + error "ToJSON for CredentialDeployment in BareBlockItem is not implemented" + toJSON (ChainUpdate _transaction) = + error "ToJSON for ChainUpdate in BareBlockItem is not implemented" + instance HashableTo TransactionHash BareBlockItem where getHash = transactionHashFromBareBlockItem diff --git a/stack.yaml b/stack.yaml index 1c583fd04..9dcdc7f37 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,6 +41,8 @@ packages: extra-lib-dirs: - ./lib/ +system-ghc: true + extra-deps: - proto-lens-setup-0.4.0.7@sha256:acca0b04e033ea0a017f809d91a7dbc942e025ec6bc275fa21647352722c74cc,3122 - proto-lens-protoc-0.8.0.0@sha256:a146ee8c9af9e445ab05651e688deb0ff849357d320657d6cea5be33cb54b960,2235 From fec8b61cec08ecb32fdc39e91b6ad0757ab34f72 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Fri, 10 May 2024 11:16:06 +0300 Subject: [PATCH 04/19] Add SignTransaction type --- haskell-src/Concordium/Types/Transactions.hs | 111 ++++++++++++++++++- 1 file changed, 107 insertions(+), 4 deletions(-) diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index d176dfba3..df9a83053 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -30,6 +30,7 @@ import qualified Data.Vector as Vec import Concordium.ID.Types import Concordium.Types +import Concordium.Types.Execution import Concordium.Types.HashableTo import Concordium.Types.Updates import Concordium.Utils @@ -320,6 +321,110 @@ fromICDI wmdArrivalTime messageExpiry icdi = wmdHash = getHash (CredentialDeployment wmdData) in WithMetadata{..} +signedTransactionVersion :: Int +signedTransactionVersion = 1 + +----------------------------------------------------------------- + +-- * JSON representation of a signed/partially-signed transaction + +----------------------------------------------------------------- + +-- TODO: convert expiryTime to a human-readable RFC 3339 string + +-- | A 'SignedTransaction' is a transaction that is signed by an account (the signer) +-- with some keys. The representation might be a fully signed transaction ready to be +-- sent on-chain or a partially-signed transaction that needs additional signatures +-- added to be ready to be sent on-chain. +-- +-- The `ToJSON` instance has the purpose converting the object into a human-readable +-- representation ready to be printed into a JSON file. This file can be shared among +-- different tools of the Concordium ecosystem for adding additional signatures. +-- +-- The chosen representation is the minimal necessary data needed to construct the +-- 'TransactionSignHash' which is the value that is signed by the signer. The +-- 'TransactionSignHash' and 'payloadSize' should be re-computed when processing a +-- 'SignedTransaction' (e.g. when adding signatures or sending the transaction on-chain). +-- +-- The representation has a `version` field. +data SignedTransaction = SignedTransaction + { -- | Signature + stVersion :: !Int, + -- | Header + stTransactionType :: !TransactionType, + -- | Hash used for signing + stEnergy :: !Energy, + -- | Hash used for signing + stExpiryTime :: !TransactionExpiryTime, + -- | Hash used for signing + stNonce :: !Nonce, + -- | Hash used for signing + stSigner :: !AccountAddress, + -- | Hash used for signing payload find something better TODO + stPayload :: !Payload, + -- | Serialized + stSignature :: !TransactionSignature + } + deriving (Eq, Show) + +instance ToJSON SignedTransaction where + toJSON (SignedTransaction stVersion stTransactionType stEnergy stExpiryTime stNonce stSigner stPayload stSignature) = + let payload = case stTransactionType of + TTUpdate -> + AE.object + [ "address" AE..= uAddress stPayload, + "amount" AE..= uAmount stPayload, + "message" AE..= uMessage stPayload, + "receiveName" AE..= uReceiveName stPayload + ] + _ -> error "Unrecognized 'TransactionType' tag: TODO: add tag in error message TODO add additional types" + in AE.object + [ "version" AE..= stVersion, + "transactionType" AE..= stTransactionType, + "energy" AE..= stEnergy, + "expiryTime" AE..= stExpiryTime, + "nonce" AE..= stNonce, + "signer" AE..= stSigner, + "payload" AE..= payload, + "signature" AE..= stSignature + ] + +instance FromJSON SignedTransaction where + parseJSON = AE.withObject "SignedTransaction" $ \obj -> do + stVersion <- obj AE..: "version" + stTransactionType <- obj AE..: "transactionType" + stEnergy <- obj AE..: "energy" + stExpiryTime <- obj AE..: "expiryTime" + stNonce <- obj AE..: "nonce" + stSigner <- obj AE..: "signer" + stSignature <- obj AE..: "signature" + tempPayload <- obj AE..: "payload" + + stPayload <- case stTransactionType of + TTUpdate -> do + uMessage <- tempPayload AE..: "message" + uReceiveName <- tempPayload AE..: "receiveName" + uAddress <- tempPayload AE..: "address" + uAmount <- tempPayload AE..: "amount" + + let updatePayload :: Payload + updatePayload = + Update uAmount uAddress uReceiveName uMessage + return updatePayload + _ -> fail "Unrecognized 'TransactionType' tag: TODO: add `tag` in error message TODO add additional types" + + return + SignedTransaction + { stVersion = stVersion, + stEnergy = stEnergy, + stExpiryTime = stExpiryTime, + stNonce = stNonce, + stSigner = stSigner, + stSignature = stSignature, + stPayload = stPayload, + stTransactionType = stTransactionType + } + ----------------- -- * Block items @@ -554,15 +659,13 @@ signTransactionSingle kp = signTransaction [(0, [(0, kp)])] -- * @SPEC: <$DOCS/Transactions#transaction-signature> signTransaction :: [(CredentialIndex, [(KeyIndex, KeyPair)])] -> TransactionHeader -> EncodedPayload -> AccountTransaction signTransaction keys atrHeader atrPayload = - let - atrSignHash = transactionSignHashFromHeaderPayload atrHeader atrPayload + let atrSignHash = transactionSignHashFromHeaderPayload atrHeader atrPayload -- only sign the hash of the transaction bodyHash = transactionSignHashToByteString atrSignHash credSignature cKeys = Map.fromList $ map (\(idx, key) -> (idx, SigScheme.sign key bodyHash)) cKeys tsSignatures = Map.fromList $ map (\(idx, cKeys) -> (idx, credSignature cKeys)) keys atrSignature = TransactionSignature{..} - in - AccountTransaction{..} + in AccountTransaction{..} -- | Verify credential signatures. This checks -- From e690cb5b53216fa0b2024ba03cbe2d90d98d5f37 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Fri, 10 May 2024 20:33:58 +0300 Subject: [PATCH 05/19] Extend fromJSON and toJSON to all payload types --- .../Concordium/Crypto/EncryptedTransfers.hs | 6 ++ haskell-src/Concordium/ID/Types.hs | 3 + haskell-src/Concordium/Types/Execution.hs | 21 +++++++ haskell-src/Concordium/Types/Transactions.hs | 63 ++++--------------- haskell-src/Concordium/Wasm.hs | 7 +++ 5 files changed, 49 insertions(+), 51 deletions(-) diff --git a/haskell-src/Concordium/Crypto/EncryptedTransfers.hs b/haskell-src/Concordium/Crypto/EncryptedTransfers.hs index f0db085f7..2c2f6bd3d 100644 --- a/haskell-src/Concordium/Crypto/EncryptedTransfers.hs +++ b/haskell-src/Concordium/Crypto/EncryptedTransfers.hs @@ -297,6 +297,9 @@ instance FromJSON EncryptedAmountTransferData where eatdProof <- v .: "proof" return EncryptedAmountTransferData{..} +instance ToJSON EncryptedAmountTransferData where + toJSON = error "Will not be implemented since feature will be deprecated soon" + withEncryptedAmountTransferData :: EncryptedAmountTransferData -> (Ptr ElgamalCipher -> Ptr ElgamalCipher -> Ptr ElgamalCipher -> Ptr ElgamalCipher -> EncryptedAmountAggIndex -> Word64 -> Ptr CChar -> IO a) -> @@ -491,6 +494,9 @@ instance FromJSON SecToPubAmountTransferData where stpatdProof <- v .: "proof" return SecToPubAmountTransferData{..} +instance ToJSON SecToPubAmountTransferData where + toJSON = error "Will not be implemented since feature will be deprecated soon" + withSecToPubAmountTransferData :: SecToPubAmountTransferData -> (Ptr ElgamalCipher -> Ptr ElgamalCipher -> Word64 -> EncryptedAmountAggIndex -> Word64 -> Ptr CChar -> IO a) -> diff --git a/haskell-src/Concordium/ID/Types.hs b/haskell-src/Concordium/ID/Types.hs index cb6736266..3e717ca37 100644 --- a/haskell-src/Concordium/ID/Types.hs +++ b/haskell-src/Concordium/ID/Types.hs @@ -773,6 +773,9 @@ data CredentialDeploymentInformation = CredentialDeploymentInformation } deriving (Show) +instance ToJSON CredentialDeploymentInformation where + toJSON = error "Not yet implemented" + -- | NB: This must match the one defined in rust. In particular the -- proof is serialized with 4 byte length. instance Serialize CredentialDeploymentInformation where diff --git a/haskell-src/Concordium/Types/Execution.hs b/haskell-src/Concordium/Types/Execution.hs index a80ff5e8f..27af4b397 100644 --- a/haskell-src/Concordium/Types/Execution.hs +++ b/haskell-src/Concordium/Types/Execution.hs @@ -46,6 +46,7 @@ import Concordium.Types.Execution.TH import Concordium.Types.Updates import Concordium.Utils import qualified Concordium.Wasm as Wasm +import Data.Char (isLower) -- | We assume that the list is non-empty and at most 255 elements long. newtype AccountOwnershipProof = AccountOwnershipProof [(KeyIndex, Dlog25519Proof)] @@ -159,6 +160,12 @@ bakerKeysWithProofsSize :: Int bakerKeysWithProofsSize = VRF.publicKeySize + dlogProofSize + Sig.publicKeySize + dlogProofSize + Bls.publicKeySize + Bls.proofSize +instance AE.FromJSON BakerKeysWithProofs where + parseJSON = error "Not yet implemented" + +instance AE.ToJSON BakerKeysWithProofs where + toJSON = error "Not yet implemented" + -- | The transaction payload. Defines the supported kinds of transactions. -- -- * @SPEC: <$DOCS/Transactions#transaction-body> @@ -404,6 +411,20 @@ instance S.Serialize TransactionType where 20 -> return TTConfigureDelegation n -> fail $ "Unrecognized TransactionType tag: " ++ show n +-- Implement `FromJSON` and `ToJSON` instances for `Payload`. +$( deriveJSON + defaultOptions + { AE.constructorTagModifier = firstLower, + AE.fieldLabelModifier = firstLower . dropWhile isLower, + AE.sumEncoding = + AE.TaggedObject + { AE.tagFieldName = "transactionType", + AE.contentsFieldName = "" + } + } + ''Payload + ) + -- | Payload serialization according to -- -- * @SPEC: <$DOCS/Transactions#transaction-body> diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index df9a83053..c9e140440 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -350,8 +350,6 @@ signedTransactionVersion = 1 data SignedTransaction = SignedTransaction { -- | Signature stVersion :: !Int, - -- | Header - stTransactionType :: !TransactionType, -- | Hash used for signing stEnergy :: !Energy, -- | Hash used for signing @@ -368,50 +366,25 @@ data SignedTransaction = SignedTransaction deriving (Eq, Show) instance ToJSON SignedTransaction where - toJSON (SignedTransaction stVersion stTransactionType stEnergy stExpiryTime stNonce stSigner stPayload stSignature) = - let payload = case stTransactionType of - TTUpdate -> - AE.object - [ "address" AE..= uAddress stPayload, - "amount" AE..= uAmount stPayload, - "message" AE..= uMessage stPayload, - "receiveName" AE..= uReceiveName stPayload - ] - _ -> error "Unrecognized 'TransactionType' tag: TODO: add tag in error message TODO add additional types" - in AE.object - [ "version" AE..= stVersion, - "transactionType" AE..= stTransactionType, - "energy" AE..= stEnergy, - "expiryTime" AE..= stExpiryTime, - "nonce" AE..= stNonce, - "signer" AE..= stSigner, - "payload" AE..= payload, - "signature" AE..= stSignature - ] - + toJSON (SignedTransaction stVersion stEnergy stExpiryTime stNonce stSigner stPayload stSignature) = + AE.object + [ "version" AE..= stVersion, + "energy" AE..= stEnergy, + "expiryTime" AE..= stExpiryTime, + "nonce" AE..= stNonce, + "signer" AE..= stSigner, + "payload" AE..= stPayload, + "signature" AE..= stSignature + ] instance FromJSON SignedTransaction where parseJSON = AE.withObject "SignedTransaction" $ \obj -> do stVersion <- obj AE..: "version" - stTransactionType <- obj AE..: "transactionType" stEnergy <- obj AE..: "energy" stExpiryTime <- obj AE..: "expiryTime" stNonce <- obj AE..: "nonce" stSigner <- obj AE..: "signer" stSignature <- obj AE..: "signature" - tempPayload <- obj AE..: "payload" - - stPayload <- case stTransactionType of - TTUpdate -> do - uMessage <- tempPayload AE..: "message" - uReceiveName <- tempPayload AE..: "receiveName" - uAddress <- tempPayload AE..: "address" - uAmount <- tempPayload AE..: "amount" - - let updatePayload :: Payload - updatePayload = - Update uAmount uAddress uReceiveName uMessage - return updatePayload - _ -> fail "Unrecognized 'TransactionType' tag: TODO: add `tag` in error message TODO add additional types" + stPayload <- obj AE..: "payload" return SignedTransaction @@ -421,8 +394,7 @@ instance FromJSON SignedTransaction where stNonce = stNonce, stSigner = stSigner, stSignature = stSignature, - stPayload = stPayload, - stTransactionType = stTransactionType + stPayload = stPayload } ----------------- @@ -463,17 +435,6 @@ data BareBlockItem } deriving (Eq, Show) --- | Concordium-client can output partially signed transactions into a JSON-file to support multi-sig. --- 'CredentialDeployment' and 'ChainUpdate' are not created by regular user accounts --- hence the `ToJSON` is not implemented for these types of transactions. -instance ToJSON BareBlockItem where - toJSON (NormalTransaction transaction) = - toJSON transaction - toJSON (CredentialDeployment _transaction) = - error "ToJSON for CredentialDeployment in BareBlockItem is not implemented" - toJSON (ChainUpdate _transaction) = - error "ToJSON for ChainUpdate in BareBlockItem is not implemented" - instance HashableTo TransactionHash BareBlockItem where getHash = transactionHashFromBareBlockItem diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index b002caeab..3ff854106 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -4,6 +4,7 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} -- | @@ -311,6 +312,12 @@ data WasmModule | WasmModuleV1 (WasmModuleV V1) deriving (Eq, Show) +instance AE.FromJSON WasmModule where + parseJSON = error "Not yet implemented" + +instance AE.ToJSON WasmModule where + toJSON = error "Not yet implemented" + getModuleRef :: forall v. (IsWasmVersion v) => WasmModuleV v -> ModuleRef getModuleRef wm = case getWasmVersion @v of SV0 -> ModuleRef (getHash wm) From 7baf5a3ec97d49e63af7b44734799779dbce7340 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Mon, 13 May 2024 17:18:27 +0300 Subject: [PATCH 06/19] Use deriveJSON --- haskell-src/Concordium/Types/Transactions.hs | 148 ++++++++----------- 1 file changed, 59 insertions(+), 89 deletions(-) diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index c9e140440..3b4f5d695 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -18,6 +18,7 @@ import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as AE import Data.Aeson.TH import qualified Data.ByteString as BS +import Data.Char (isLower) import Data.List (foldl') import qualified Data.Map.Strict as Map import qualified Data.Serialize as S @@ -140,6 +141,57 @@ instance S.Serialize TransactionSignature where accumulateSigs (Map.insert idx sigmap accum) (Just idx) (count - 1) TransactionSignature <$> accumulateSigs Map.empty Nothing len +----------------------------------------------------------------- + +-- * JSON representation of a signed/partially-signed transaction + +----------------------------------------------------------------- + +-- TODO: convert expiryTime to a human-readable RFC 3339 string + +-- | A 'SignedTransaction' is a transaction that is signed by an account (the signer) +-- with some keys. The representation might be a fully signed transaction ready to be +-- sent on-chain or a partially-signed transaction that needs additional signatures +-- added to be ready to be sent on-chain. +-- +-- The `ToJSON` instance has the purpose converting the object into a human-readable +-- representation ready to be printed into a JSON file. This file can be shared among +-- different tools of the Concordium ecosystem for adding additional signatures. +-- +-- The chosen representation is the minimal necessary data needed to construct the +-- 'TransactionSignHash' which is the value that is signed by the signer. The +-- 'TransactionSignHash' and 'payloadSize' should be re-computed when processing a +-- 'SignedTransaction' (e.g. when adding signatures or sending the transaction on-chain). +-- +-- The representation has a `version` field. +data SignedTransaction = SignedTransaction + { -- | A version to destinguish between future formats of signed/partially-signed transactions. + -- The initial version is 1 and will be incremented for every new format. + stVersion :: !Int, + -- | Amount of energy dedicated for the execution of this transaction. + stEnergy :: !Energy, + -- | Absolute expiration time after which transaction will not be executed. + stExpiryTime :: !TransactionExpiryTime, + -- | Account nonce. + stNonce :: !Nonce, + -- | Signer account address. + stSigner :: !AccountAddress, + -- | The payload of the transaction. + stPayload :: !Payload, + -- | Signatures generated by the signer account. This map might be contain enough signatures to send the transaction on-chain or + -- additional signatures are needed before the transaction is considered fully signed. + stSignature :: !TransactionSignature + } + deriving (Eq, Show) + +-- | Implement `FromJSON` and `ToJSON` instances for `SignedTransaction`. +$( deriveJSON + defaultOptions + { AE.fieldLabelModifier = firstLower . dropWhile isLower + } + ''SignedTransaction + ) + -- | An 'AccountTransaction' is a transaction that originates from -- a specific account (the sender), and is paid for by the sender. -- @@ -161,22 +213,13 @@ data AccountTransaction = AccountTransaction } deriving (Eq, Show) -instance ToJSON AccountTransaction where - toJSON (AccountTransaction signature header payload signHash) = - AE.object - [ "signature" AE..= signature, - "header" AE..= header, - "payload" AE..= payload, - "signHash" AE..= signHash - ] - -instance FromJSON AccountTransaction where - parseJSON = AE.withObject "AccountTransaction" $ \obj -> do - atrSignature <- obj AE..: "signature" - atrHeader <- obj AE..: "header" - atrPayload <- obj AE..: "payload" - atrSignHash <- obj AE..: "signHash" - return AccountTransaction{..} +-- Implement `FromJSON` and `ToJSON` instances for `AccountTransaction`. +$( deriveJSON + defaultOptions + { AE.fieldLabelModifier = firstLower . dropWhile isLower + } + ''AccountTransaction + ) -- | Construct an 'AccountTransaction', computing the correct -- 'TransactionSignHash'. @@ -324,79 +367,6 @@ fromICDI wmdArrivalTime messageExpiry icdi = signedTransactionVersion :: Int signedTransactionVersion = 1 ------------------------------------------------------------------ - --- * JSON representation of a signed/partially-signed transaction - ------------------------------------------------------------------ - --- TODO: convert expiryTime to a human-readable RFC 3339 string - --- | A 'SignedTransaction' is a transaction that is signed by an account (the signer) --- with some keys. The representation might be a fully signed transaction ready to be --- sent on-chain or a partially-signed transaction that needs additional signatures --- added to be ready to be sent on-chain. --- --- The `ToJSON` instance has the purpose converting the object into a human-readable --- representation ready to be printed into a JSON file. This file can be shared among --- different tools of the Concordium ecosystem for adding additional signatures. --- --- The chosen representation is the minimal necessary data needed to construct the --- 'TransactionSignHash' which is the value that is signed by the signer. The --- 'TransactionSignHash' and 'payloadSize' should be re-computed when processing a --- 'SignedTransaction' (e.g. when adding signatures or sending the transaction on-chain). --- --- The representation has a `version` field. -data SignedTransaction = SignedTransaction - { -- | Signature - stVersion :: !Int, - -- | Hash used for signing - stEnergy :: !Energy, - -- | Hash used for signing - stExpiryTime :: !TransactionExpiryTime, - -- | Hash used for signing - stNonce :: !Nonce, - -- | Hash used for signing - stSigner :: !AccountAddress, - -- | Hash used for signing payload find something better TODO - stPayload :: !Payload, - -- | Serialized - stSignature :: !TransactionSignature - } - deriving (Eq, Show) - -instance ToJSON SignedTransaction where - toJSON (SignedTransaction stVersion stEnergy stExpiryTime stNonce stSigner stPayload stSignature) = - AE.object - [ "version" AE..= stVersion, - "energy" AE..= stEnergy, - "expiryTime" AE..= stExpiryTime, - "nonce" AE..= stNonce, - "signer" AE..= stSigner, - "payload" AE..= stPayload, - "signature" AE..= stSignature - ] -instance FromJSON SignedTransaction where - parseJSON = AE.withObject "SignedTransaction" $ \obj -> do - stVersion <- obj AE..: "version" - stEnergy <- obj AE..: "energy" - stExpiryTime <- obj AE..: "expiryTime" - stNonce <- obj AE..: "nonce" - stSigner <- obj AE..: "signer" - stSignature <- obj AE..: "signature" - stPayload <- obj AE..: "payload" - - return - SignedTransaction - { stVersion = stVersion, - stEnergy = stEnergy, - stExpiryTime = stExpiryTime, - stNonce = stNonce, - stSigner = stSigner, - stSignature = stSignature, - stPayload = stPayload - } - ----------------- -- * Block items From 98b7368aa733065336c5b818b525eb7a02d07080 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 14 May 2024 09:39:09 +0300 Subject: [PATCH 07/19] Add fromJSON and toJSON for wasmModule --- haskell-src/Concordium/Wasm.hs | 42 +++++++++++++++++++++++++++++----- 1 file changed, 36 insertions(+), 6 deletions(-) diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index 3ff854106..d67fa64e3 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -147,13 +147,14 @@ module Concordium.Wasm ( import Control.Monad import qualified Data.Aeson as AE +import Data.Aeson.TH import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as BS16 import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as BSS import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.Char (isAlphaNum, isAscii, isPunctuation) +import Data.Char (isAlphaNum, isAscii, isLower, isPunctuation) import qualified Data.HashMap.Strict as HM import Data.Hashable import Data.Int (Int32) @@ -175,6 +176,7 @@ import qualified Concordium.Crypto.SHA256 as H import Concordium.ID.Types import Concordium.Types import Concordium.Types.HashableTo +import Concordium.Utils import Concordium.Utils.Serialization -------------------------------------------------------------------------------- @@ -266,6 +268,17 @@ demoteWasmVersion SV1 = V1 newtype ModuleSource (v :: WasmVersion) = ModuleSource {moduleSource :: ByteString} deriving (Eq, Show) +-- Implement `ToJSON` instances for `ModuleSource`. +instance AE.ToJSON (ModuleSource v) where + toJSON (ModuleSource v) = AE.String (Text.decodeUtf8 (BS16.encode v)) + +-- Implement `FromJSON` instances for `ModuleSource`. +instance AE.FromJSON (ModuleSource v) where + parseJSON = AE.withText "source" $ \t -> + case BS16.decode (Text.encodeUtf8 t) of + Right bs -> return $ ModuleSource bs + Left _ -> fail "Could not decode ModuleSource from JSON" + instance Serialize (ModuleSource V0) where get = do len <- getWord32be @@ -291,6 +304,15 @@ moduleSourceLength = fromIntegral . BS.length . moduleSource newtype WasmModuleV (v :: WasmVersion) = WasmModuleV {wmvSource :: ModuleSource v} deriving (Eq, Show) +-- Implement `FromJSON` and `ToJSON` instances for `WasmModuleV`. +$( deriveJSON + defaultOptions + { AE.constructorTagModifier = firstLower, + AE.fieldLabelModifier = firstLower . dropWhile isLower + } + ''WasmModuleV + ) + instance (IsWasmVersion v) => Serialize (WasmModuleV v) where put (WasmModuleV ws) = case getWasmVersion @v of SV0 -> put V0 <> put ws @@ -312,11 +334,19 @@ data WasmModule | WasmModuleV1 (WasmModuleV V1) deriving (Eq, Show) -instance AE.FromJSON WasmModule where - parseJSON = error "Not yet implemented" - -instance AE.ToJSON WasmModule where - toJSON = error "Not yet implemented" +-- Implement `FromJSON` and `ToJSON` instances for `WasmModule`. +$( deriveJSON + defaultOptions + { AE.constructorTagModifier = firstLower, + AE.fieldLabelModifier = firstLower . dropWhile isLower, + AE.sumEncoding = + AE.TaggedObject + { AE.tagFieldName = "version", + AE.contentsFieldName = "content" + } + } + ''WasmModule + ) getModuleRef :: forall v. (IsWasmVersion v) => WasmModuleV v -> ModuleRef getModuleRef wm = case getWasmVersion @v of From bb9483b01d5d3f23c4698474df4f7a18a1e701f7 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 14 May 2024 11:53:20 +0300 Subject: [PATCH 08/19] Add fromJSON and toJSON for BakerKeysWithProofs --- haskell-src/Concordium/ID/Types.hs | 8 +++++--- haskell-src/Concordium/Types/Execution.hs | 12 +++++++----- haskell-src/Concordium/Types/Transactions.hs | 7 ++++--- 3 files changed, 16 insertions(+), 11 deletions(-) diff --git a/haskell-src/Concordium/ID/Types.hs b/haskell-src/Concordium/ID/Types.hs index 3e717ca37..a6bfcf02a 100644 --- a/haskell-src/Concordium/ID/Types.hs +++ b/haskell-src/Concordium/ID/Types.hs @@ -773,9 +773,6 @@ data CredentialDeploymentInformation = CredentialDeploymentInformation } deriving (Show) -instance ToJSON CredentialDeploymentInformation where - toJSON = error "Not yet implemented" - -- | NB: This must match the one defined in rust. In particular the -- proof is serialized with 4 byte length. instance Serialize CredentialDeploymentInformation where @@ -787,6 +784,7 @@ instance Serialize CredentialDeploymentInformation where instance Eq CredentialDeploymentInformation where cdi1 == cdi2 = cdiValues cdi1 == cdiValues cdi2 +-- Implement `FromJSON` instances for `CredentialDeploymentInformation`. instance FromJSON CredentialDeploymentInformation where parseJSON = withObject "CredentialDeploymentInformation" $ \x -> do cdiValues <- parseJSON (Object x) @@ -800,6 +798,10 @@ instance FromJSON CredentialDeploymentInformation where } Left _ -> fail "\"proofs\" is not a valid base16 string." +-- Implement `ToJSON` instances for `CredentialDeploymentInformation`. +instance ToJSON CredentialDeploymentInformation where + toJSON = error "Not yet implemented" + -- | Information about the account that should be created as part of the initial -- credential deployment. data InitialCredentialAccount = InitialCredentialAccount diff --git a/haskell-src/Concordium/Types/Execution.hs b/haskell-src/Concordium/Types/Execution.hs index 27af4b397..f5846c64c 100644 --- a/haskell-src/Concordium/Types/Execution.hs +++ b/haskell-src/Concordium/Types/Execution.hs @@ -160,11 +160,13 @@ bakerKeysWithProofsSize :: Int bakerKeysWithProofsSize = VRF.publicKeySize + dlogProofSize + Sig.publicKeySize + dlogProofSize + Bls.publicKeySize + Bls.proofSize -instance AE.FromJSON BakerKeysWithProofs where - parseJSON = error "Not yet implemented" - -instance AE.ToJSON BakerKeysWithProofs where - toJSON = error "Not yet implemented" +-- Implement `FromJSON` and `ToJSON` instances for `BakerKeysWithProofs`. +$( deriveJSON + defaultOptions + { AE.fieldLabelModifier = firstLower . dropWhile isLower + } + ''BakerKeysWithProofs + ) -- | The transaction payload. Defines the supported kinds of transactions. -- diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index 3b4f5d695..db7f85b63 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -192,6 +192,10 @@ $( deriveJSON ''SignedTransaction ) +-- | The initial version `SignedTransaction`. The version will be incremented when introducing a new format in the future. +signedTransactionVersion :: Int +signedTransactionVersion = 1 + -- | An 'AccountTransaction' is a transaction that originates from -- a specific account (the sender), and is paid for by the sender. -- @@ -364,9 +368,6 @@ fromICDI wmdArrivalTime messageExpiry icdi = wmdHash = getHash (CredentialDeployment wmdData) in WithMetadata{..} -signedTransactionVersion :: Int -signedTransactionVersion = 1 - ----------------- -- * Block items From 587c21fd5102ffc4c6ff7ec24dd08eda875b6a69 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 14 May 2024 14:59:23 +0300 Subject: [PATCH 09/19] Use RFC 3339 timestamp format --- haskell-src/Concordium/Types.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/haskell-src/Concordium/Types.hs b/haskell-src/Concordium/Types.hs index d10c5ddae..d51b9f50b 100644 --- a/haskell-src/Concordium/Types.hs +++ b/haskell-src/Concordium/Types.hs @@ -711,7 +711,23 @@ instance Show Address where -- | Time in seconds since the unix epoch newtype TransactionTime = TransactionTime {ttsSeconds :: Word64} - deriving (Show, Read, Eq, Num, Ord, FromJSON, ToJSON, Real, Enum, Integral) via Word64 + deriving (Show, Read, Eq, Num, Ord, Real, Enum, Integral) via Word64 + +-- Implement `ToJSON` instances for `TransactionTime`. +instance ToJSON TransactionTime where + toJSON (TransactionTime seconds) = + String $ T.pack $ formatTime defaultTimeLocale "%FT%T%QZ+00:00" (posixSecondsToUTCTime (fromIntegral seconds)) + +-- Implement `FromJSON` instances for `TransactionTime`. +instance FromJSON TransactionTime where + parseJSON (String v) = + case parseTimeM True defaultTimeLocale "%FT%T%QZ+00:00" (T.unpack v) of + Just time -> return $ TransactionTime (convertToWord64 $ utcTimeToPOSIXSeconds time) + Nothing -> fail "Invalid RFC 3339 timestamp format for TransactionTime (expect %FT%T%QZ+00:00)" + parseJSON _ = fail "Expect JSON string for TransactionTime" + +convertToWord64 :: NominalDiffTime -> Word64 +convertToWord64 = floor . nominalDiffTimeToSeconds instance S.Serialize TransactionTime where put = P.putWord64be . ttsSeconds From 91ef10f5f8d02d3ab2d07b86d8c9085281726620 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 14 May 2024 15:29:53 +0300 Subject: [PATCH 10/19] Fix small typos --- haskell-src/Concordium/ID/Types.hs | 4 ++-- haskell-src/Concordium/Types.hs | 4 ++-- haskell-src/Concordium/Types/Transactions.hs | 11 +++++------ haskell-src/Concordium/Wasm.hs | 4 ++-- 4 files changed, 11 insertions(+), 12 deletions(-) diff --git a/haskell-src/Concordium/ID/Types.hs b/haskell-src/Concordium/ID/Types.hs index a6bfcf02a..6c651b3d9 100644 --- a/haskell-src/Concordium/ID/Types.hs +++ b/haskell-src/Concordium/ID/Types.hs @@ -784,7 +784,7 @@ instance Serialize CredentialDeploymentInformation where instance Eq CredentialDeploymentInformation where cdi1 == cdi2 = cdiValues cdi1 == cdiValues cdi2 --- Implement `FromJSON` instances for `CredentialDeploymentInformation`. +-- Implement `FromJSON` instance for `CredentialDeploymentInformation`. instance FromJSON CredentialDeploymentInformation where parseJSON = withObject "CredentialDeploymentInformation" $ \x -> do cdiValues <- parseJSON (Object x) @@ -798,7 +798,7 @@ instance FromJSON CredentialDeploymentInformation where } Left _ -> fail "\"proofs\" is not a valid base16 string." --- Implement `ToJSON` instances for `CredentialDeploymentInformation`. +-- Implement `ToJSON` instance for `CredentialDeploymentInformation`. instance ToJSON CredentialDeploymentInformation where toJSON = error "Not yet implemented" diff --git a/haskell-src/Concordium/Types.hs b/haskell-src/Concordium/Types.hs index d51b9f50b..736c06ccd 100644 --- a/haskell-src/Concordium/Types.hs +++ b/haskell-src/Concordium/Types.hs @@ -713,12 +713,12 @@ instance Show Address where newtype TransactionTime = TransactionTime {ttsSeconds :: Word64} deriving (Show, Read, Eq, Num, Ord, Real, Enum, Integral) via Word64 --- Implement `ToJSON` instances for `TransactionTime`. +-- Implement `ToJSON` instance for `TransactionTime`. instance ToJSON TransactionTime where toJSON (TransactionTime seconds) = String $ T.pack $ formatTime defaultTimeLocale "%FT%T%QZ+00:00" (posixSecondsToUTCTime (fromIntegral seconds)) --- Implement `FromJSON` instances for `TransactionTime`. +-- Implement `FromJSON` instance for `TransactionTime`. instance FromJSON TransactionTime where parseJSON (String v) = case parseTimeM True defaultTimeLocale "%FT%T%QZ+00:00" (T.unpack v) of diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index db7f85b63..54d79a3f4 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -147,8 +147,6 @@ instance S.Serialize TransactionSignature where ----------------------------------------------------------------- --- TODO: convert expiryTime to a human-readable RFC 3339 string - -- | A 'SignedTransaction' is a transaction that is signed by an account (the signer) -- with some keys. The representation might be a fully signed transaction ready to be -- sent on-chain or a partially-signed transaction that needs additional signatures @@ -165,10 +163,10 @@ instance S.Serialize TransactionSignature where -- -- The representation has a `version` field. data SignedTransaction = SignedTransaction - { -- | A version to destinguish between future formats of signed/partially-signed transactions. + { -- | A version to distinguish between future formats of signed/partially-signed transactions. -- The initial version is 1 and will be incremented for every new format. stVersion :: !Int, - -- | Amount of energy dedicated for the execution of this transaction. + -- | Amount of energy dedicated to the execution of this transaction. stEnergy :: !Energy, -- | Absolute expiration time after which transaction will not be executed. stExpiryTime :: !TransactionExpiryTime, @@ -178,7 +176,7 @@ data SignedTransaction = SignedTransaction stSigner :: !AccountAddress, -- | The payload of the transaction. stPayload :: !Payload, - -- | Signatures generated by the signer account. This map might be contain enough signatures to send the transaction on-chain or + -- | Signatures generated by the signer account. This map might contain enough signatures to send the transaction on-chain or -- additional signatures are needed before the transaction is considered fully signed. stSignature :: !TransactionSignature } @@ -192,7 +190,8 @@ $( deriveJSON ''SignedTransaction ) --- | The initial version `SignedTransaction`. The version will be incremented when introducing a new format in the future. +-- | The initial version of the above `SignedTransaction` type. +-- The version will be incremented when introducing a new format in the future. signedTransactionVersion :: Int signedTransactionVersion = 1 diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index d67fa64e3..e8ebbbfff 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -268,11 +268,11 @@ demoteWasmVersion SV1 = V1 newtype ModuleSource (v :: WasmVersion) = ModuleSource {moduleSource :: ByteString} deriving (Eq, Show) --- Implement `ToJSON` instances for `ModuleSource`. +-- Implement `ToJSON` instance for `ModuleSource`. instance AE.ToJSON (ModuleSource v) where toJSON (ModuleSource v) = AE.String (Text.decodeUtf8 (BS16.encode v)) --- Implement `FromJSON` instances for `ModuleSource`. +-- Implement `FromJSON` instance for `ModuleSource`. instance AE.FromJSON (ModuleSource v) where parseJSON = AE.withText "source" $ \t -> case BS16.decode (Text.encodeUtf8 t) of From 0c58cb158c7b7417e12dcb2ff24fbdc71dca2050 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 14 May 2024 20:40:23 +0300 Subject: [PATCH 11/19] Address comments --- .../Concordium/Crypto/EncryptedTransfers.hs | 17 ++++++-- haskell-src/Concordium/ID/Types.hs | 5 ++- haskell-src/Concordium/Types.hs | 18 +------- haskell-src/Concordium/Types/Transactions.hs | 43 +++++++++++++------ 4 files changed, 48 insertions(+), 35 deletions(-) diff --git a/haskell-src/Concordium/Crypto/EncryptedTransfers.hs b/haskell-src/Concordium/Crypto/EncryptedTransfers.hs index 2c2f6bd3d..8bc7970f5 100644 --- a/haskell-src/Concordium/Crypto/EncryptedTransfers.hs +++ b/haskell-src/Concordium/Crypto/EncryptedTransfers.hs @@ -298,7 +298,13 @@ instance FromJSON EncryptedAmountTransferData where return EncryptedAmountTransferData{..} instance ToJSON EncryptedAmountTransferData where - toJSON = error "Will not be implemented since feature will be deprecated soon" + toJSON EncryptedAmountTransferData{..} = + object + [ "remainingAmount" .= eatdRemainingAmount, + "transferAmount" .= eatdTransferAmount, + "index" .= eatdIndex, + "proof" .= eatdProof + ] withEncryptedAmountTransferData :: EncryptedAmountTransferData -> @@ -495,8 +501,13 @@ instance FromJSON SecToPubAmountTransferData where return SecToPubAmountTransferData{..} instance ToJSON SecToPubAmountTransferData where - toJSON = error "Will not be implemented since feature will be deprecated soon" - + toJSON SecToPubAmountTransferData{..} = + object + [ "remainingAmount" .= stpatdRemainingAmount, + "transferAmount" .= stpatdTransferAmount, + "index" .= stpatdIndex, + "proof" .= stpatdProof + ] withSecToPubAmountTransferData :: SecToPubAmountTransferData -> (Ptr ElgamalCipher -> Ptr ElgamalCipher -> Word64 -> EncryptedAmountAggIndex -> Word64 -> Ptr CChar -> IO a) -> diff --git a/haskell-src/Concordium/ID/Types.hs b/haskell-src/Concordium/ID/Types.hs index 6c651b3d9..8cfd5966b 100644 --- a/haskell-src/Concordium/ID/Types.hs +++ b/haskell-src/Concordium/ID/Types.hs @@ -800,7 +800,10 @@ instance FromJSON CredentialDeploymentInformation where -- Implement `ToJSON` instance for `CredentialDeploymentInformation`. instance ToJSON CredentialDeploymentInformation where - toJSON = error "Not yet implemented" + toJSON CredentialDeploymentInformation{..} = + object $ + ("proofs" .= cdiProofs) + : credentialDeploymentValuesList cdiValues -- | Information about the account that should be created as part of the initial -- credential deployment. diff --git a/haskell-src/Concordium/Types.hs b/haskell-src/Concordium/Types.hs index 736c06ccd..2829f9b98 100644 --- a/haskell-src/Concordium/Types.hs +++ b/haskell-src/Concordium/Types.hs @@ -711,23 +711,7 @@ instance Show Address where -- | Time in seconds since the unix epoch newtype TransactionTime = TransactionTime {ttsSeconds :: Word64} - deriving (Show, Read, Eq, Num, Ord, Real, Enum, Integral) via Word64 - --- Implement `ToJSON` instance for `TransactionTime`. -instance ToJSON TransactionTime where - toJSON (TransactionTime seconds) = - String $ T.pack $ formatTime defaultTimeLocale "%FT%T%QZ+00:00" (posixSecondsToUTCTime (fromIntegral seconds)) - --- Implement `FromJSON` instance for `TransactionTime`. -instance FromJSON TransactionTime where - parseJSON (String v) = - case parseTimeM True defaultTimeLocale "%FT%T%QZ+00:00" (T.unpack v) of - Just time -> return $ TransactionTime (convertToWord64 $ utcTimeToPOSIXSeconds time) - Nothing -> fail "Invalid RFC 3339 timestamp format for TransactionTime (expect %FT%T%QZ+00:00)" - parseJSON _ = fail "Expect JSON string for TransactionTime" - -convertToWord64 :: NominalDiffTime -> Word64 -convertToWord64 = floor . nominalDiffTimeToSeconds + deriving (Show, Read, Eq, Num, Ord, Real, FromJSON, ToJSON, Enum, Integral) via Word64 instance S.Serialize TransactionTime where put = P.putWord64be . ttsSeconds diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index 54d79a3f4..042f8cb3e 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -160,13 +160,8 @@ instance S.Serialize TransactionSignature where -- 'TransactionSignHash' which is the value that is signed by the signer. The -- 'TransactionSignHash' and 'payloadSize' should be re-computed when processing a -- 'SignedTransaction' (e.g. when adding signatures or sending the transaction on-chain). --- --- The representation has a `version` field. data SignedTransaction = SignedTransaction - { -- | A version to distinguish between future formats of signed/partially-signed transactions. - -- The initial version is 1 and will be incremented for every new format. - stVersion :: !Int, - -- | Amount of energy dedicated to the execution of this transaction. + { -- | Amount of energy dedicated to the execution of this transaction. stEnergy :: !Energy, -- | Absolute expiration time after which transaction will not be executed. stExpiryTime :: !TransactionExpiryTime, @@ -183,14 +178,34 @@ data SignedTransaction = SignedTransaction deriving (Eq, Show) -- | Implement `FromJSON` and `ToJSON` instances for `SignedTransaction`. -$( deriveJSON - defaultOptions - { AE.fieldLabelModifier = firstLower . dropWhile isLower - } - ''SignedTransaction - ) - --- | The initial version of the above `SignedTransaction` type. +instance ToJSON SignedTransaction where + toJSON SignedTransaction{..} = + AE.object + [ "version" AE..= signedTransactionVersion, + "energy" AE..= stEnergy, + "expiryTime" AE..= stExpiryTime, + "nonce" AE..= stNonce, + "signer" AE..= stSigner, + "payload" AE..= stPayload, + "signature" AE..= stSignature + ] + +-- Implement `FromJSON` instance for `SignedTransaction`. +instance FromJSON SignedTransaction where + parseJSON = AE.withObject "SignedTransaction" $ \obj -> do + stVersion <- obj AE..: "version" + if stVersion /= signedTransactionVersion + then fail $ "Unexpected version: " ++ show stVersion + else do + stEnergy <- obj AE..: "energy" + stExpiryTime <- obj AE..: "expiryTime" + stNonce <- obj AE..: "nonce" + stSigner <- obj AE..: "signer" + stSignature <- obj AE..: "signature" + stPayload <- obj AE..: "payload" + return SignedTransaction{..} + +-- | The initial version of the above `SignedTransaction` JSON representation. -- The version will be incremented when introducing a new format in the future. signedTransactionVersion :: Int signedTransactionVersion = 1 From 1abaf56aee9c812f3c66a499394fd7059a0dd74c Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Thu, 16 May 2024 15:10:19 +0300 Subject: [PATCH 12/19] Add tests --- concordium-base.cabal | 1 + haskell-tests/Spec.hs | 2 + haskell-tests/Types/PayloadSpec.hs | 101 +++++++++++++++++++++++++++++ 3 files changed, 104 insertions(+) create mode 100644 haskell-tests/Types/PayloadSpec.hs diff --git a/concordium-base.cabal b/concordium-base.cabal index 0ca7d9597..526a6f0d7 100644 --- a/concordium-base.cabal +++ b/concordium-base.cabal @@ -315,6 +315,7 @@ test-suite test Types.AmountSpec Types.ParametersSpec Types.PayloadSerializationSpec + Types.PayloadSpec Types.TransactionSerializationSpec Types.TransactionSummarySpec Types.UpdatesSpec diff --git a/haskell-tests/Spec.hs b/haskell-tests/Spec.hs index fa96b815e..f92a0603f 100644 --- a/haskell-tests/Spec.hs +++ b/haskell-tests/Spec.hs @@ -22,6 +22,7 @@ import qualified Types.AmountFraction import qualified Types.AmountSpec import qualified Types.ParametersSpec import qualified Types.PayloadSerializationSpec +import qualified Types.PayloadSpec import qualified Types.TransactionSerializationSpec import qualified Types.TransactionSummarySpec import qualified Types.UpdatesSpec @@ -53,4 +54,5 @@ main = hspec $ parallel $ do Types.TransactionSummarySpec.tests Types.AddressesSpec.tests Types.ParametersSpec.tests + Types.PayloadSpec.tests Genesis.ParametersSpec.tests diff --git a/haskell-tests/Types/PayloadSpec.hs b/haskell-tests/Types/PayloadSpec.hs new file mode 100644 index 000000000..e96317014 --- /dev/null +++ b/haskell-tests/Types/PayloadSpec.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE MonoLocalBinds #-} + +-- | Tests for JSON encoding and decoding of 'Payload'. +module Types.PayloadSpec (tests) where + +import Concordium.Crypto.SHA256 +import qualified Concordium.ID.Types as IDTypes +import Concordium.Types +import Concordium.Types.Execution +import Concordium.Wasm +import qualified Data.Aeson as AE +import qualified Data.ByteString.Char8 as BS +import Data.ByteString.Short as SBS +import Data.FixedByteString +import Data.Primitive.ByteArray +import qualified Data.Text as T +import Data.Word (Word8) +import Test.Hspec + +exampleHash :: FixedByteString DigestSize +exampleHash = FixedByteString $ byteArrayFromListN 32 ([1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16] :: [Word8]) + +exampleShortByteString :: ShortByteString +exampleShortByteString = SBS.pack ([1, 2] :: [Word8]) + +exampleAmount :: Amount +exampleAmount = 3 + +exampleTimestamp :: Timestamp +exampleTimestamp = Timestamp 3 + +exampleParameter :: Parameter +exampleParameter = Parameter{parameter = exampleShortByteString} + +exampleContractAddress :: ContractAddress +exampleContractAddress = ContractAddress 2 3 + +exampleAccountAddress :: IDTypes.AccountAddress +exampleAccountAddress = case IDTypes.addressFromText $ T.pack "2zR4h351M1bqhrL9UywsbHrP3ucA1xY3TBTFRuTsRout8JnLD6" of + Right addr -> addr + -- This does not happen since the format + -- of the text is that of a valid address. + Left str -> error str + +exampleTransferPayload :: Payload +exampleTransferPayload = Transfer{tToAddress = exampleAccountAddress, tAmount = exampleAmount} + +exampleDeployModulePayload :: Payload +exampleDeployModulePayload = DeployModule{dmMod = WasmModuleV1 (WasmModuleV{wmvSource = ModuleSource{moduleSource = BS.pack "ByteString"}})} + +exampleInitContractPayload :: Payload +exampleInitContractPayload = InitContract{icAmount = exampleAmount, icModRef = ModuleRef{moduleRef = Hash exampleHash}, icInitName = InitName{initName = T.pack "init_name"}, icParam = exampleParameter} + +exampleUpdateContractPayload :: Payload +exampleUpdateContractPayload = + Update + { uAmount = exampleAmount, + uAddress = exampleContractAddress, + uReceiveName = ReceiveName{receiveName = T.pack "receive.name"}, + uMessage = exampleParameter + } + +exampleRegisterDataPayload :: Payload +exampleRegisterDataPayload = RegisterData{rdData = RegisteredData exampleShortByteString} + +exampleTransferWithMemoPayload :: Payload +exampleTransferWithMemoPayload = TransferWithMemo{twmToAddress = exampleAccountAddress, twmAmount = exampleAmount, twmMemo = Memo exampleShortByteString} + +exampleTransferWithSchedulePayload :: Payload +exampleTransferWithSchedulePayload = TransferWithSchedule{twsTo = exampleAccountAddress, twsSchedule = [(exampleTimestamp, exampleAmount)]} + +exampleTransferWithScheduleAndMemoPayload :: Payload +exampleTransferWithScheduleAndMemoPayload = TransferWithScheduleAndMemo{twswmTo = exampleAccountAddress, twswmMemo = Memo exampleShortByteString, twswmSchedule = [(exampleTimestamp, exampleAmount)]} + +exampleConfigureDelegationPayload :: Payload +exampleConfigureDelegationPayload = ConfigureDelegation{cdCapital = Nothing, cdRestakeEarnings = Just True, cdDelegationTarget = Nothing} + +-- tests +tests :: Spec +tests = describe "payload JSON encode and decode" $ do + specify "register data payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleRegisterDataPayload) `shouldBe` Right exampleRegisterDataPayload + specify "deploy module payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleDeployModulePayload) `shouldBe` Right exampleDeployModulePayload + specify "init contract payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleInitContractPayload) `shouldBe` Right exampleInitContractPayload + specify "update contract payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleUpdateContractPayload) `shouldBe` Right exampleUpdateContractPayload + specify "transfer payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleTransferPayload) `shouldBe` Right exampleTransferPayload + specify "transfer with memo payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleTransferWithMemoPayload) `shouldBe` Right exampleTransferWithMemoPayload + specify "transfer with schedule payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleTransferWithSchedulePayload) `shouldBe` Right exampleTransferWithSchedulePayload + specify "transfer with schedule payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleTransferWithSchedulePayload) `shouldBe` Right exampleTransferWithSchedulePayload + specify "transfer with schedule and memo payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleTransferWithScheduleAndMemoPayload) `shouldBe` Right exampleTransferWithScheduleAndMemoPayload + specify "configure delegation payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleConfigureDelegationPayload) `shouldBe` Right exampleConfigureDelegationPayload From a5d3b70987681462db9849ce115ea306a620de52 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Thu, 16 May 2024 16:24:59 +0300 Subject: [PATCH 13/19] Improve toJSON and fromJSON WasmModule instance --- haskell-src/Concordium/Wasm.hs | 28 ++++++++-------- haskell-tests/Spec.hs | 52 +++++++++++++++--------------- haskell-tests/Types/PayloadSpec.hs | 15 ++++++++- stack.yaml | 2 -- 4 files changed, 55 insertions(+), 42 deletions(-) diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index e8ebbbfff..15a0aba44 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -334,19 +334,21 @@ data WasmModule | WasmModuleV1 (WasmModuleV V1) deriving (Eq, Show) --- Implement `FromJSON` and `ToJSON` instances for `WasmModule`. -$( deriveJSON - defaultOptions - { AE.constructorTagModifier = firstLower, - AE.fieldLabelModifier = firstLower . dropWhile isLower, - AE.sumEncoding = - AE.TaggedObject - { AE.tagFieldName = "version", - AE.contentsFieldName = "content" - } - } - ''WasmModule - ) +-- Custom implementation of ToJSON for WasmModule +instance AE.ToJSON WasmModule where + toJSON (WasmModuleV0 wasmV0) = AE.object ["version" AE..= (0 :: Int), "content" AE..= AE.toJSON wasmV0] + toJSON (WasmModuleV1 wasmV1) = AE.object ["version" AE..= (1 :: Int), "content" AE..= AE.toJSON wasmV1] + +-- Custom implementation of FromJSON for WasmModule +instance AE.FromJSON WasmModule where + parseJSON = AE.withObject "WasmModule" $ \obj -> do + version <- obj AE..: "version" + content <- obj AE..: "content" + case version :: Int of + 0 -> WasmModuleV0 <$> AE.parseJSON content + 1 -> WasmModuleV1 <$> AE.parseJSON content + _ -> fail "Invalid version number" + getModuleRef :: forall v. (IsWasmVersion v) => WasmModuleV v -> ModuleRef getModuleRef wm = case getWasmVersion @v of diff --git a/haskell-tests/Spec.hs b/haskell-tests/Spec.hs index f92a0603f..71238f8ad 100644 --- a/haskell-tests/Spec.hs +++ b/haskell-tests/Spec.hs @@ -29,30 +29,30 @@ import qualified Types.UpdatesSpec main :: IO () main = hspec $ parallel $ do - ConcordiumTests.Common.Version.tests - ConcordiumTests.Crypto.FFIVerify.tests - ConcordiumTests.Crypto.FFIDataTypes.tests - ConcordiumTests.Crypto.SHA256.tests - ConcordiumTests.Crypto.Ed25519Signature.tests - ConcordiumTests.Crypto.VRF.tests - ConcordiumTests.Crypto.BlsSignature.tests - ConcordiumTests.Data.Base58Encoding.tests - ConcordiumTests.ID.Types.tests - ConcordiumTests.Crypto.Ed25519DlogProofs.tests - ConcordiumTests.Crypto.EncryptedTransfers.tests - ConcordiumTests.Utils.Encryption.tests - ConcordiumTests.MerkleProofs.tests - -- NB: The following tests are far from complete. They do not test what - -- happens when data is corrupt in various ways (number of commmitted values - -- is incorrect, or similar) - Types.PayloadSerializationSpec.tests - Types.TransactionSerializationSpec.tests - Types.AmountSpec.tests - Types.UpdatesSpec.tests - Types.AccountEncryptedAmountSpec.tests - Types.AmountFraction.tests - Types.TransactionSummarySpec.tests - Types.AddressesSpec.tests - Types.ParametersSpec.tests + -- ConcordiumTests.Common.Version.tests + -- ConcordiumTests.Crypto.FFIVerify.tests + -- ConcordiumTests.Crypto.FFIDataTypes.tests + -- ConcordiumTests.Crypto.SHA256.tests + -- ConcordiumTests.Crypto.Ed25519Signature.tests + -- ConcordiumTests.Crypto.VRF.tests + -- ConcordiumTests.Crypto.BlsSignature.tests + -- ConcordiumTests.Data.Base58Encoding.tests + -- ConcordiumTests.ID.Types.tests + -- ConcordiumTests.Crypto.Ed25519DlogProofs.tests + -- ConcordiumTests.Crypto.EncryptedTransfers.tests + -- ConcordiumTests.Utils.Encryption.tests + -- ConcordiumTests.MerkleProofs.tests + -- -- NB: The following tests are far from complete. They do not test what + -- -- happens when data is corrupt in various ways (number of commmitted values + -- -- is incorrect, or similar) + -- Types.PayloadSerializationSpec.tests + -- Types.TransactionSerializationSpec.tests + -- Types.AmountSpec.tests + -- Types.UpdatesSpec.tests + -- Types.AccountEncryptedAmountSpec.tests + -- Types.AmountFraction.tests + -- Types.TransactionSummarySpec.tests + -- Types.AddressesSpec.tests + -- Types.ParametersSpec.tests Types.PayloadSpec.tests - Genesis.ParametersSpec.tests + -- Genesis.ParametersSpec.tests diff --git a/haskell-tests/Types/PayloadSpec.hs b/haskell-tests/Types/PayloadSpec.hs index e96317014..621572ab4 100644 --- a/haskell-tests/Types/PayloadSpec.hs +++ b/haskell-tests/Types/PayloadSpec.hs @@ -7,7 +7,8 @@ module Types.PayloadSpec (tests) where import Concordium.Crypto.SHA256 import qualified Concordium.ID.Types as IDTypes import Concordium.Types -import Concordium.Types.Execution +import Concordium.Types.Execution +import Concordium.Types.Transactions (SignedTransaction (SignedTransaction)) import Concordium.Wasm import qualified Data.Aeson as AE import qualified Data.ByteString.Char8 as BS @@ -76,6 +77,15 @@ exampleTransferWithScheduleAndMemoPayload = TransferWithScheduleAndMemo{twswmTo exampleConfigureDelegationPayload :: Payload exampleConfigureDelegationPayload = ConfigureDelegation{cdCapital = Nothing, cdRestakeEarnings = Just True, cdDelegationTarget = Nothing} +-- exampleSignedTransaction :: SignedTransaction +-- exampleSignedTransaction = SignedTransaction {stEnergy =Energy, +-- stExpiryTime =exampleTimestamp, +-- stNonce =Nonce, +-- stSigner =exampleAccountAddress, +-- stPayload =exampleTransferWithSchedulePayload, +-- stSignature =TransactionSignature +-- } + -- tests tests :: Spec tests = describe "payload JSON encode and decode" $ do @@ -99,3 +109,6 @@ tests = describe "payload JSON encode and decode" $ do (AE.eitherDecode . AE.encode $ exampleTransferWithScheduleAndMemoPayload) `shouldBe` Right exampleTransferWithScheduleAndMemoPayload specify "configure delegation payload example:" $ do (AE.eitherDecode . AE.encode $ exampleConfigureDelegationPayload) `shouldBe` Right exampleConfigureDelegationPayload + -- specify "configure delegation payload example:" $ do + -- (AE.eitherDecode . AE.encode $ exampleSignedTransaction) `shouldBe` Right exampleSignedTransaction + diff --git a/stack.yaml b/stack.yaml index 9dcdc7f37..1c583fd04 100644 --- a/stack.yaml +++ b/stack.yaml @@ -41,8 +41,6 @@ packages: extra-lib-dirs: - ./lib/ -system-ghc: true - extra-deps: - proto-lens-setup-0.4.0.7@sha256:acca0b04e033ea0a017f809d91a7dbc942e025ec6bc275fa21647352722c74cc,3122 - proto-lens-protoc-0.8.0.0@sha256:a146ee8c9af9e445ab05651e688deb0ff849357d320657d6cea5be33cb54b960,2235 From 870b69b9ecd4e07b571984d3ad83275d7bef5a06 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Thu, 16 May 2024 16:48:39 +0300 Subject: [PATCH 14/19] Add test for SignedTransaction --- haskell-src/Concordium/Wasm.hs | 1 - haskell-tests/Spec.hs | 3 ++- haskell-tests/Types/PayloadSpec.hs | 43 ++++++++++++++++++++---------- 3 files changed, 31 insertions(+), 16 deletions(-) diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index 15a0aba44..56574e91e 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -349,7 +349,6 @@ instance AE.FromJSON WasmModule where 1 -> WasmModuleV1 <$> AE.parseJSON content _ -> fail "Invalid version number" - getModuleRef :: forall v. (IsWasmVersion v) => WasmModuleV v -> ModuleRef getModuleRef wm = case getWasmVersion @v of SV0 -> ModuleRef (getHash wm) diff --git a/haskell-tests/Spec.hs b/haskell-tests/Spec.hs index 71238f8ad..f514979c1 100644 --- a/haskell-tests/Spec.hs +++ b/haskell-tests/Spec.hs @@ -55,4 +55,5 @@ main = hspec $ parallel $ do -- Types.AddressesSpec.tests -- Types.ParametersSpec.tests Types.PayloadSpec.tests - -- Genesis.ParametersSpec.tests + +-- Genesis.ParametersSpec.tests diff --git a/haskell-tests/Types/PayloadSpec.hs b/haskell-tests/Types/PayloadSpec.hs index 621572ab4..b3349444d 100644 --- a/haskell-tests/Types/PayloadSpec.hs +++ b/haskell-tests/Types/PayloadSpec.hs @@ -1,19 +1,21 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE MonoLocalBinds #-} --- | Tests for JSON encoding and decoding of 'Payload'. +-- | Tests for JSON encoding and decoding of 'Payload' and 'SignedTransaction'. module Types.PayloadSpec (tests) where import Concordium.Crypto.SHA256 +import qualified Concordium.Crypto.SignatureScheme as ID import qualified Concordium.ID.Types as IDTypes import Concordium.Types -import Concordium.Types.Execution -import Concordium.Types.Transactions (SignedTransaction (SignedTransaction)) +import Concordium.Types.Execution +import Concordium.Types.Transactions as ST import Concordium.Wasm import qualified Data.Aeson as AE import qualified Data.ByteString.Char8 as BS import Data.ByteString.Short as SBS import Data.FixedByteString +import qualified Data.Map.Strict as Map import Data.Primitive.ByteArray import qualified Data.Text as T import Data.Word (Word8) @@ -77,14 +79,28 @@ exampleTransferWithScheduleAndMemoPayload = TransferWithScheduleAndMemo{twswmTo exampleConfigureDelegationPayload :: Payload exampleConfigureDelegationPayload = ConfigureDelegation{cdCapital = Nothing, cdRestakeEarnings = Just True, cdDelegationTarget = Nothing} --- exampleSignedTransaction :: SignedTransaction --- exampleSignedTransaction = SignedTransaction {stEnergy =Energy, --- stExpiryTime =exampleTimestamp, --- stNonce =Nonce, --- stSigner =exampleAccountAddress, --- stPayload =exampleTransferWithSchedulePayload, --- stSignature =TransactionSignature --- } +exampleSignatureMapEmpty :: Map.Map IDTypes.KeyIndex ID.Signature +exampleSignatureMapEmpty = Map.empty + +exampleSignatureMap :: Map.Map IDTypes.KeyIndex ID.Signature +exampleSignatureMap = Map.insert (1 :: IDTypes.KeyIndex) (ID.Signature exampleShortByteString) exampleSignatureMapEmpty + +exampleCredentialSignatureMapEmpty :: Map.Map IDTypes.CredentialIndex (Map.Map IDTypes.KeyIndex ID.Signature) +exampleCredentialSignatureMapEmpty = Map.empty + +exampleCredentialSignatureMap :: Map.Map IDTypes.CredentialIndex (Map.Map IDTypes.KeyIndex ID.Signature) +exampleCredentialSignatureMap = Map.insert (1 :: IDTypes.CredentialIndex) exampleSignatureMap exampleCredentialSignatureMapEmpty + +exampleSignedTransaction :: ST.SignedTransaction +exampleSignedTransaction = + ST.SignedTransaction + { stEnergy = Energy 1, + stExpiryTime = TransactionTime 2, + stNonce = Nonce 3, + stSigner = exampleAccountAddress, + stPayload = exampleTransferWithSchedulePayload, + stSignature = TransactionSignature exampleCredentialSignatureMap + } -- tests tests :: Spec @@ -109,6 +125,5 @@ tests = describe "payload JSON encode and decode" $ do (AE.eitherDecode . AE.encode $ exampleTransferWithScheduleAndMemoPayload) `shouldBe` Right exampleTransferWithScheduleAndMemoPayload specify "configure delegation payload example:" $ do (AE.eitherDecode . AE.encode $ exampleConfigureDelegationPayload) `shouldBe` Right exampleConfigureDelegationPayload - -- specify "configure delegation payload example:" $ do - -- (AE.eitherDecode . AE.encode $ exampleSignedTransaction) `shouldBe` Right exampleSignedTransaction - + specify "configure delegation payload example:" $ do + (AE.eitherDecode . AE.encode $ exampleSignedTransaction) `shouldBe` Right exampleSignedTransaction From a1e6511dbd56ecd76e2441ba6a245bfd09e9c7ab Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Thu, 16 May 2024 19:45:15 +0300 Subject: [PATCH 15/19] Add manual implementation of toJSON and fromJSON for payload --- haskell-src/Concordium/Types/Execution.hs | 149 ++++++++++++++++++++-- 1 file changed, 135 insertions(+), 14 deletions(-) diff --git a/haskell-src/Concordium/Types/Execution.hs b/haskell-src/Concordium/Types/Execution.hs index f5846c64c..be7b1d4f8 100644 --- a/haskell-src/Concordium/Types/Execution.hs +++ b/haskell-src/Concordium/Types/Execution.hs @@ -4,6 +4,7 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-} @@ -18,6 +19,7 @@ import Concordium.Utils.Serialization import Data.Aeson ((.:), (.=)) import qualified Data.Aeson as AE import Data.Aeson.TH +import Data.Aeson.Types (Parser) import Data.Bits import qualified Data.ByteString as BS import qualified Data.ByteString.Short as BSS @@ -155,7 +157,7 @@ instance S.Serialize BakerKeysWithProofs where get = BakerKeysWithProofs <$> S.get <*> S.get <*> S.get <*> S.get <*> S.get <*> S.get --- | Size of a serialized 'BakerKeysWithProofs' structure +-- | Size of a serialized 'BakerKeysWithProofs' bakerKeysWithProofsSize :: Int bakerKeysWithProofsSize = VRF.publicKeySize + dlogProofSize + Sig.publicKeySize + dlogProofSize + Bls.publicKeySize + Bls.proofSize @@ -413,19 +415,138 @@ instance S.Serialize TransactionType where 20 -> return TTConfigureDelegation n -> fail $ "Unrecognized TransactionType tag: " ++ show n --- Implement `FromJSON` and `ToJSON` instances for `Payload`. -$( deriveJSON - defaultOptions - { AE.constructorTagModifier = firstLower, - AE.fieldLabelModifier = firstLower . dropWhile isLower, - AE.sumEncoding = - AE.TaggedObject - { AE.tagFieldName = "transactionType", - AE.contentsFieldName = "" - } - } - ''Payload - ) +instance AE.ToJSON Payload where + -- `mod` was renamed to `module` + toJSON DeployModule{dmMod} = AE.object ["module" AE..= dmMod, "transactionType" AE..= AE.String "deployModule"] + toJSON InitContract{icAmount, icModRef, icInitName, icParam} = AE.object ["amount" AE..= icAmount, "modRef" AE..= icModRef, "initName" AE..= icInitName, "param" AE..= icParam, "transactionType" AE..= AE.String "initContract"] + toJSON Update{uAmount, uAddress, uReceiveName, uMessage} = AE.object ["amount" AE..= uAmount, "address" AE..= uAddress, "receiveName" AE..= uReceiveName, "message" AE..= uMessage, "transactionType" AE..= AE.String "update"] + toJSON Transfer{tToAddress, tAmount} = AE.object ["toAddress" AE..= tToAddress, "amount" AE..= tAmount, "transactionType" AE..= AE.String "transfer"] + toJSON UpdateCredentialKeys{uckCredId, uckKeys} = AE.object ["credId" AE..= uckCredId, "keys" AE..= uckKeys, "transactionType" AE..= AE.String "updateCredentialKeys"] + toJSON EncryptedAmountTransfer{eatTo, eatData} = AE.object ["to" AE..= eatTo, "data" AE..= eatData, "transactionType" AE..= AE.String "encryptedAmountTransfer"] + toJSON TransferToEncrypted{tteAmount} = AE.object ["amount" AE..= tteAmount, "transactionType" AE..= AE.String "transferToEncrypted"] + toJSON TransferToPublic{ttpData} = AE.object ["data" AE..= ttpData, "transactionType" AE..= AE.String "transferToPublic"] + toJSON TransferWithSchedule{twsTo, twsSchedule} = AE.object ["to" AE..= twsTo, "schedule" AE..= twsSchedule, "transactionType" AE..= AE.String "transferWithSchedule"] + toJSON UpdateCredentials{ucNewCredInfos, ucRemoveCredIds, ucNewThreshold} = AE.object ["newCredInfos" AE..= ucNewCredInfos, "removeCredIds" AE..= ucRemoveCredIds, "newThreshold" AE..= ucNewThreshold, "transactionType" AE..= AE.String "updateCredentials"] + toJSON RegisterData{rdData} = AE.object ["data" AE..= rdData, "transactionType" AE..= AE.String "registerData"] + toJSON TransferWithMemo{twmToAddress, twmMemo, twmAmount} = AE.object ["toAddress" AE..= twmToAddress, "memo" AE..= twmMemo, "amount" AE..= twmAmount, "transactionType" AE..= AE.String "transferWithMemo"] + toJSON EncryptedAmountTransferWithMemo{eatwmTo, eatwmMemo, eatwmData} = AE.object ["to" AE..= eatwmTo, "memo" AE..= eatwmMemo, "data" AE..= eatwmData, "transactionType" AE..= AE.String "encryptedAmountTransferWithMemo"] + toJSON TransferWithScheduleAndMemo{twswmTo, twswmMemo, twswmSchedule} = AE.object ["to" AE..= twswmTo, "memo" AE..= twswmMemo, "schedule" AE..= twswmSchedule, "transactionType" AE..= AE.String "transferWithScheduleAndMemo"] + -- `configureBaker` was renamed to `configureValidator` + toJSON ConfigureBaker{cbCapital, cbRestakeEarnings, cbOpenForDelegation, cbKeysWithProofs, cbMetadataURL, cbTransactionFeeCommission, cbBakingRewardCommission, cbFinalizationRewardCommission} = AE.object ["capital" AE..= cbCapital, "restakeEarnings" AE..= cbRestakeEarnings, "openForDelegation" AE..= cbOpenForDelegation, "keysWithProofs" AE..= cbKeysWithProofs, "metadataURL" AE..= cbMetadataURL, "transactionFeeCommission" AE..= cbTransactionFeeCommission, "bakingRewardCommission" AE..= cbBakingRewardCommission, "finalizationRewardCommission" AE..= cbFinalizationRewardCommission, "transactionType" AE..= AE.String "configureValidator"] + toJSON ConfigureDelegation{cdCapital, cdRestakeEarnings, cdDelegationTarget} = AE.object ["capital" AE..= cdCapital, "restakeEarnings" AE..= cdRestakeEarnings, "delegationTarget" AE..= cdDelegationTarget, "transactionType" AE..= AE.String "configureDelegation"] + toJSON AddBaker{abElectionVerifyKey, abSignatureVerifyKey, abAggregationVerifyKey, abProofSig, abProofElection, abProofAggregation, abBakingStake, abRestakeEarnings} = AE.object ["electionVerifyKey" AE..= abElectionVerifyKey, "signatureVerifyKey" AE..= abSignatureVerifyKey, "aggregationVerifyKey" AE..= abAggregationVerifyKey, "proofSig" AE..= abProofSig, "proofElection" AE..= abProofElection, "proofAggregation" AE..= abProofAggregation, "bakingStake" AE..= abBakingStake, "restakeEarnings" AE..= abRestakeEarnings, "transactionType" AE..= AE.String "addBaker"] + toJSON RemoveBaker = AE.object ["transactionType" AE..= AE.String "removeBaker"] + toJSON UpdateBakerStake{ubsStake} = AE.object ["stake" AE..= ubsStake, "transactionType" AE..= AE.String "updateBakerStake"] + toJSON UpdateBakerRestakeEarnings{ubreRestakeEarnings} = AE.object ["restakeEarnings" AE..= ubreRestakeEarnings, "transactionType" AE..= AE.String "updateBakerRestakeEarnings"] + toJSON UpdateBakerKeys{ubkElectionVerifyKey, ubkSignatureVerifyKey, ubkAggregationVerifyKey, ubkProofSig, ubkProofElection, ubkProofAggregation} = AE.object ["electionVerifyKey" AE..= ubkElectionVerifyKey, "signatureVerifyKey" AE..= ubkSignatureVerifyKey, "aggregationVerifyKey" AE..= ubkAggregationVerifyKey, "proofSig" AE..= ubkProofSig, "proofElection" AE..= ubkProofElection, "proofAggregation" AE..= ubkProofAggregation, "transactionType" AE..= AE.String "updateBakerKeys"] + +instance AE.FromJSON Payload where + parseJSON = AE.withObject "payload" $ \obj -> do + transactionType <- obj AE..: "transactionType" :: Parser String + + case transactionType of + "deployModule" -> do + dmMod <- obj AE..: "module" + return DeployModule{dmMod} + "initContract" -> do + icAmount <- obj AE..: "amount" + icModRef <- obj AE..: "modRef" + icInitName <- obj AE..: "initName" + icParam <- obj AE..: "param" + return InitContract{icAmount, icModRef, icInitName, icParam} + "update" -> do + uAmount <- obj AE..: "amount" + uAddress <- obj AE..: "address" + uReceiveName <- obj AE..: "receiveName" + uMessage <- obj AE..: "message" + return Update{uAmount, uAddress, uReceiveName, uMessage} + "transfer" -> do + tToAddress <- obj AE..: "toAddress" + tAmount <- obj AE..: "amount" + return Transfer{tToAddress, tAmount} + "UpdateBakerStake" -> do + ubsStake <- obj AE..: "stake" + return UpdateBakerStake{ubsStake} + "updateBakerRestakeEarnings" -> do + ubreRestakeEarnings <- obj AE..: "restakeEarnings" + return UpdateBakerRestakeEarnings{ubreRestakeEarnings} + "updateBakerKeys" -> do + ubkElectionVerifyKey <- obj AE..: "electionVerifyKey" + ubkSignatureVerifyKey <- obj AE..: "signatureVerifyKey" + ubkAggregationVerifyKey <- obj AE..: "aggregationVerifyKey" + ubkProofSig <- obj AE..: "proofSig" + ubkProofElection <- obj AE..: "proofElection" + ubkProofAggregation <- obj AE..: "proofAggregation" + return UpdateBakerKeys{ubkElectionVerifyKey, ubkSignatureVerifyKey, ubkAggregationVerifyKey, ubkProofSig, ubkProofElection, ubkProofAggregation} + "updateCredentialKeys" -> do + uckCredId <- obj AE..: "credId" + uckKeys <- obj AE..: "keys" + return UpdateCredentialKeys{uckCredId, uckKeys} + "removeBaker" -> do + return RemoveBaker + "addBaker" -> do + abElectionVerifyKey <- obj AE..: "electionVerifyKey" + abSignatureVerifyKey <- obj AE..: "signatureVerifyKey" + abAggregationVerifyKey <- obj AE..: "aggregationVerifyKey" + abProofSig <- obj AE..: "proofSig" + abProofElection <- obj AE..: "proofElection" + abProofAggregation <- obj AE..: "proofAggregation" + abBakingStake <- obj AE..: "bakingStake" + abRestakeEarnings <- obj AE..: "restakeEarnings" + return AddBaker{abElectionVerifyKey, abSignatureVerifyKey, abAggregationVerifyKey, abProofSig, abProofElection, abProofAggregation, abBakingStake, abRestakeEarnings} + "encryptedAmountTransfer" -> do + eatTo <- obj AE..: "to" + eatData <- obj AE..: "data" + return EncryptedAmountTransfer{eatTo, eatData} + "transferToEncrypted" -> do + tteAmount <- obj AE..: "amount" + return TransferToEncrypted{tteAmount} + "transferToPublic" -> do + ttpData <- obj AE..: "data" + return TransferToPublic{ttpData} + "transferWithSchedule" -> do + twsTo <- obj AE..: "to" + twsSchedule <- obj AE..: "schedule" + return TransferWithSchedule{twsTo, twsSchedule} + "updateCredentials" -> do + ucNewCredInfos <- obj AE..: "newCredInfos" + ucRemoveCredIds <- obj AE..: "removeCredIds" + ucNewThreshold <- obj AE..: "newThreshold" + return UpdateCredentials{ucNewCredInfos, ucRemoveCredIds, ucNewThreshold} + "registerData" -> do + rdData <- obj AE..: "data" + return RegisterData{rdData} + "transferWithMemo" -> do + twmToAddress <- obj AE..: "toAddress" + twmMemo <- obj AE..: "memo" + twmAmount <- obj AE..: "amount" + return TransferWithMemo{twmToAddress, twmMemo, twmAmount} + "encryptedAmountTransferWithMemo" -> do + eatwmTo <- obj AE..: "to" + eatwmMemo <- obj AE..: "memo" + eatwmData <- obj AE..: "data" + return EncryptedAmountTransferWithMemo{eatwmTo, eatwmMemo, eatwmData} + "transferWithScheduleAndMemo" -> do + twswmTo <- obj AE..: "to" + twswmMemo <- obj AE..: "memo" + twswmSchedule <- obj AE..: "schedule" + return TransferWithScheduleAndMemo{twswmTo, twswmMemo, twswmSchedule} + "configureValidator" -> do + cbCapital <- obj AE..: "capital" + cbRestakeEarnings <- obj AE..: "restakeEarnings" + cbOpenForDelegation <- obj AE..: "openForDelegation" + cbKeysWithProofs <- obj AE..: "keysWithProofs" + cbMetadataURL <- obj AE..: "metadataURL" + cbTransactionFeeCommission <- obj AE..: "transactionFeeCommission" + cbBakingRewardCommission <- obj AE..: "bakingRewardCommission" + cbFinalizationRewardCommission <- obj AE..: "finalizationRewardCommission" + return ConfigureBaker{cbCapital, cbRestakeEarnings, cbOpenForDelegation, cbKeysWithProofs, cbMetadataURL, cbTransactionFeeCommission, cbBakingRewardCommission, cbFinalizationRewardCommission} + "configureDelegation" -> do + cdCapital <- obj AE..: "capital" + cdRestakeEarnings <- obj AE..: "restakeEarnings" + cdDelegationTarget <- obj AE..: "delegationTarget" + return ConfigureDelegation{cdCapital, cdRestakeEarnings, cdDelegationTarget} + _ -> fail "Unrecognized 'TransactionType' tag" -- | Payload serialization according to -- From b1b795c17a815959b2e6ecc1afd6c5085e201501 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Fri, 17 May 2024 09:33:08 +0300 Subject: [PATCH 16/19] Enable tests again --- haskell-src/Concordium/Types/Execution.hs | 2 +- haskell-tests/Spec.hs | 53 +++++++++++------------ 2 files changed, 27 insertions(+), 28 deletions(-) diff --git a/haskell-src/Concordium/Types/Execution.hs b/haskell-src/Concordium/Types/Execution.hs index be7b1d4f8..812eb93bc 100644 --- a/haskell-src/Concordium/Types/Execution.hs +++ b/haskell-src/Concordium/Types/Execution.hs @@ -157,7 +157,7 @@ instance S.Serialize BakerKeysWithProofs where get = BakerKeysWithProofs <$> S.get <*> S.get <*> S.get <*> S.get <*> S.get <*> S.get --- | Size of a serialized 'BakerKeysWithProofs' +-- | Size of a serialized 'BakerKeysWithProofs' structure bakerKeysWithProofsSize :: Int bakerKeysWithProofsSize = VRF.publicKeySize + dlogProofSize + Sig.publicKeySize + dlogProofSize + Bls.publicKeySize + Bls.proofSize diff --git a/haskell-tests/Spec.hs b/haskell-tests/Spec.hs index f514979c1..f92a0603f 100644 --- a/haskell-tests/Spec.hs +++ b/haskell-tests/Spec.hs @@ -29,31 +29,30 @@ import qualified Types.UpdatesSpec main :: IO () main = hspec $ parallel $ do - -- ConcordiumTests.Common.Version.tests - -- ConcordiumTests.Crypto.FFIVerify.tests - -- ConcordiumTests.Crypto.FFIDataTypes.tests - -- ConcordiumTests.Crypto.SHA256.tests - -- ConcordiumTests.Crypto.Ed25519Signature.tests - -- ConcordiumTests.Crypto.VRF.tests - -- ConcordiumTests.Crypto.BlsSignature.tests - -- ConcordiumTests.Data.Base58Encoding.tests - -- ConcordiumTests.ID.Types.tests - -- ConcordiumTests.Crypto.Ed25519DlogProofs.tests - -- ConcordiumTests.Crypto.EncryptedTransfers.tests - -- ConcordiumTests.Utils.Encryption.tests - -- ConcordiumTests.MerkleProofs.tests - -- -- NB: The following tests are far from complete. They do not test what - -- -- happens when data is corrupt in various ways (number of commmitted values - -- -- is incorrect, or similar) - -- Types.PayloadSerializationSpec.tests - -- Types.TransactionSerializationSpec.tests - -- Types.AmountSpec.tests - -- Types.UpdatesSpec.tests - -- Types.AccountEncryptedAmountSpec.tests - -- Types.AmountFraction.tests - -- Types.TransactionSummarySpec.tests - -- Types.AddressesSpec.tests - -- Types.ParametersSpec.tests + ConcordiumTests.Common.Version.tests + ConcordiumTests.Crypto.FFIVerify.tests + ConcordiumTests.Crypto.FFIDataTypes.tests + ConcordiumTests.Crypto.SHA256.tests + ConcordiumTests.Crypto.Ed25519Signature.tests + ConcordiumTests.Crypto.VRF.tests + ConcordiumTests.Crypto.BlsSignature.tests + ConcordiumTests.Data.Base58Encoding.tests + ConcordiumTests.ID.Types.tests + ConcordiumTests.Crypto.Ed25519DlogProofs.tests + ConcordiumTests.Crypto.EncryptedTransfers.tests + ConcordiumTests.Utils.Encryption.tests + ConcordiumTests.MerkleProofs.tests + -- NB: The following tests are far from complete. They do not test what + -- happens when data is corrupt in various ways (number of commmitted values + -- is incorrect, or similar) + Types.PayloadSerializationSpec.tests + Types.TransactionSerializationSpec.tests + Types.AmountSpec.tests + Types.UpdatesSpec.tests + Types.AccountEncryptedAmountSpec.tests + Types.AmountFraction.tests + Types.TransactionSummarySpec.tests + Types.AddressesSpec.tests + Types.ParametersSpec.tests Types.PayloadSpec.tests - --- Genesis.ParametersSpec.tests + Genesis.ParametersSpec.tests From 558b094e1ca5c1ade5d10fcc85be70cd647b43f2 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 21 May 2024 15:43:38 +0300 Subject: [PATCH 17/19] Addres comments --- haskell-src/Concordium/Types.hs | 1 - haskell-src/Concordium/Types/Transactions.hs | 77 -------------------- haskell-tests/Types/PayloadSpec.hs | 32 +------- 3 files changed, 1 insertion(+), 109 deletions(-) diff --git a/haskell-src/Concordium/Types.hs b/haskell-src/Concordium/Types.hs index 2829f9b98..c4809fe23 100644 --- a/haskell-src/Concordium/Types.hs +++ b/haskell-src/Concordium/Types.hs @@ -996,7 +996,6 @@ instance S.Serialize PayloadSize where -- | Serialized payload of the transaction newtype EncodedPayload = EncodedPayload {_spayload :: BSS.ShortByteString} deriving (Eq, Show) - deriving (AE.ToJSON, AE.FromJSON) via BSH.ByteStringHex -- | There is no corresponding getter (to fit into the Serialize instance) since -- encoded payload does not encode its own length. See 'getPayload' below. diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index 042f8cb3e..38522ef35 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -141,75 +141,6 @@ instance S.Serialize TransactionSignature where accumulateSigs (Map.insert idx sigmap accum) (Just idx) (count - 1) TransactionSignature <$> accumulateSigs Map.empty Nothing len ------------------------------------------------------------------ - --- * JSON representation of a signed/partially-signed transaction - ------------------------------------------------------------------ - --- | A 'SignedTransaction' is a transaction that is signed by an account (the signer) --- with some keys. The representation might be a fully signed transaction ready to be --- sent on-chain or a partially-signed transaction that needs additional signatures --- added to be ready to be sent on-chain. --- --- The `ToJSON` instance has the purpose converting the object into a human-readable --- representation ready to be printed into a JSON file. This file can be shared among --- different tools of the Concordium ecosystem for adding additional signatures. --- --- The chosen representation is the minimal necessary data needed to construct the --- 'TransactionSignHash' which is the value that is signed by the signer. The --- 'TransactionSignHash' and 'payloadSize' should be re-computed when processing a --- 'SignedTransaction' (e.g. when adding signatures or sending the transaction on-chain). -data SignedTransaction = SignedTransaction - { -- | Amount of energy dedicated to the execution of this transaction. - stEnergy :: !Energy, - -- | Absolute expiration time after which transaction will not be executed. - stExpiryTime :: !TransactionExpiryTime, - -- | Account nonce. - stNonce :: !Nonce, - -- | Signer account address. - stSigner :: !AccountAddress, - -- | The payload of the transaction. - stPayload :: !Payload, - -- | Signatures generated by the signer account. This map might contain enough signatures to send the transaction on-chain or - -- additional signatures are needed before the transaction is considered fully signed. - stSignature :: !TransactionSignature - } - deriving (Eq, Show) - --- | Implement `FromJSON` and `ToJSON` instances for `SignedTransaction`. -instance ToJSON SignedTransaction where - toJSON SignedTransaction{..} = - AE.object - [ "version" AE..= signedTransactionVersion, - "energy" AE..= stEnergy, - "expiryTime" AE..= stExpiryTime, - "nonce" AE..= stNonce, - "signer" AE..= stSigner, - "payload" AE..= stPayload, - "signature" AE..= stSignature - ] - --- Implement `FromJSON` instance for `SignedTransaction`. -instance FromJSON SignedTransaction where - parseJSON = AE.withObject "SignedTransaction" $ \obj -> do - stVersion <- obj AE..: "version" - if stVersion /= signedTransactionVersion - then fail $ "Unexpected version: " ++ show stVersion - else do - stEnergy <- obj AE..: "energy" - stExpiryTime <- obj AE..: "expiryTime" - stNonce <- obj AE..: "nonce" - stSigner <- obj AE..: "signer" - stSignature <- obj AE..: "signature" - stPayload <- obj AE..: "payload" - return SignedTransaction{..} - --- | The initial version of the above `SignedTransaction` JSON representation. --- The version will be incremented when introducing a new format in the future. -signedTransactionVersion :: Int -signedTransactionVersion = 1 - -- | An 'AccountTransaction' is a transaction that originates from -- a specific account (the sender), and is paid for by the sender. -- @@ -231,14 +162,6 @@ data AccountTransaction = AccountTransaction } deriving (Eq, Show) --- Implement `FromJSON` and `ToJSON` instances for `AccountTransaction`. -$( deriveJSON - defaultOptions - { AE.fieldLabelModifier = firstLower . dropWhile isLower - } - ''AccountTransaction - ) - -- | Construct an 'AccountTransaction', computing the correct -- 'TransactionSignHash'. makeAccountTransaction :: TransactionSignature -> TransactionHeader -> EncodedPayload -> AccountTransaction diff --git a/haskell-tests/Types/PayloadSpec.hs b/haskell-tests/Types/PayloadSpec.hs index b3349444d..a35f23b4e 100644 --- a/haskell-tests/Types/PayloadSpec.hs +++ b/haskell-tests/Types/PayloadSpec.hs @@ -1,21 +1,18 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE MonoLocalBinds #-} --- | Tests for JSON encoding and decoding of 'Payload' and 'SignedTransaction'. +-- | Tests for JSON encoding and decoding of 'Payload'. module Types.PayloadSpec (tests) where import Concordium.Crypto.SHA256 -import qualified Concordium.Crypto.SignatureScheme as ID import qualified Concordium.ID.Types as IDTypes import Concordium.Types import Concordium.Types.Execution -import Concordium.Types.Transactions as ST import Concordium.Wasm import qualified Data.Aeson as AE import qualified Data.ByteString.Char8 as BS import Data.ByteString.Short as SBS import Data.FixedByteString -import qualified Data.Map.Strict as Map import Data.Primitive.ByteArray import qualified Data.Text as T import Data.Word (Word8) @@ -79,29 +76,6 @@ exampleTransferWithScheduleAndMemoPayload = TransferWithScheduleAndMemo{twswmTo exampleConfigureDelegationPayload :: Payload exampleConfigureDelegationPayload = ConfigureDelegation{cdCapital = Nothing, cdRestakeEarnings = Just True, cdDelegationTarget = Nothing} -exampleSignatureMapEmpty :: Map.Map IDTypes.KeyIndex ID.Signature -exampleSignatureMapEmpty = Map.empty - -exampleSignatureMap :: Map.Map IDTypes.KeyIndex ID.Signature -exampleSignatureMap = Map.insert (1 :: IDTypes.KeyIndex) (ID.Signature exampleShortByteString) exampleSignatureMapEmpty - -exampleCredentialSignatureMapEmpty :: Map.Map IDTypes.CredentialIndex (Map.Map IDTypes.KeyIndex ID.Signature) -exampleCredentialSignatureMapEmpty = Map.empty - -exampleCredentialSignatureMap :: Map.Map IDTypes.CredentialIndex (Map.Map IDTypes.KeyIndex ID.Signature) -exampleCredentialSignatureMap = Map.insert (1 :: IDTypes.CredentialIndex) exampleSignatureMap exampleCredentialSignatureMapEmpty - -exampleSignedTransaction :: ST.SignedTransaction -exampleSignedTransaction = - ST.SignedTransaction - { stEnergy = Energy 1, - stExpiryTime = TransactionTime 2, - stNonce = Nonce 3, - stSigner = exampleAccountAddress, - stPayload = exampleTransferWithSchedulePayload, - stSignature = TransactionSignature exampleCredentialSignatureMap - } - -- tests tests :: Spec tests = describe "payload JSON encode and decode" $ do @@ -119,11 +93,7 @@ tests = describe "payload JSON encode and decode" $ do (AE.eitherDecode . AE.encode $ exampleTransferWithMemoPayload) `shouldBe` Right exampleTransferWithMemoPayload specify "transfer with schedule payload example:" $ do (AE.eitherDecode . AE.encode $ exampleTransferWithSchedulePayload) `shouldBe` Right exampleTransferWithSchedulePayload - specify "transfer with schedule payload example:" $ do - (AE.eitherDecode . AE.encode $ exampleTransferWithSchedulePayload) `shouldBe` Right exampleTransferWithSchedulePayload specify "transfer with schedule and memo payload example:" $ do (AE.eitherDecode . AE.encode $ exampleTransferWithScheduleAndMemoPayload) `shouldBe` Right exampleTransferWithScheduleAndMemoPayload specify "configure delegation payload example:" $ do (AE.eitherDecode . AE.encode $ exampleConfigureDelegationPayload) `shouldBe` Right exampleConfigureDelegationPayload - specify "configure delegation payload example:" $ do - (AE.eitherDecode . AE.encode $ exampleSignedTransaction) `shouldBe` Right exampleSignedTransaction From 84de5de807b95c9103866fad25a76ac5eb8e2383 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Tue, 21 May 2024 18:05:54 +0300 Subject: [PATCH 18/19] Address comments --- haskell-src/Concordium/Types/Execution.hs | 113 +++++++++++-------- haskell-src/Concordium/Types/Transactions.hs | 2 - 2 files changed, 64 insertions(+), 51 deletions(-) diff --git a/haskell-src/Concordium/Types/Execution.hs b/haskell-src/Concordium/Types/Execution.hs index 812eb93bc..d1aeab410 100644 --- a/haskell-src/Concordium/Types/Execution.hs +++ b/haskell-src/Concordium/Types/Execution.hs @@ -4,9 +4,9 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Concordium.Types.Execution where @@ -48,7 +48,6 @@ import Concordium.Types.Execution.TH import Concordium.Types.Updates import Concordium.Utils import qualified Concordium.Wasm as Wasm -import Data.Char (isLower) -- | We assume that the list is non-empty and at most 255 elements long. newtype AccountOwnershipProof = AccountOwnershipProof [(KeyIndex, Dlog25519Proof)] @@ -162,13 +161,28 @@ bakerKeysWithProofsSize :: Int bakerKeysWithProofsSize = VRF.publicKeySize + dlogProofSize + Sig.publicKeySize + dlogProofSize + Bls.publicKeySize + Bls.proofSize --- Implement `FromJSON` and `ToJSON` instances for `BakerKeysWithProofs`. -$( deriveJSON - defaultOptions - { AE.fieldLabelModifier = firstLower . dropWhile isLower - } - ''BakerKeysWithProofs - ) +-- Implement `ToJSON` instance for `BakerKeysWithProofs`. +instance AE.ToJSON BakerKeysWithProofs where + toJSON BakerKeysWithProofs{..} = + AE.object + [ "electionVerifyKey" AE..= bkwpElectionVerifyKey, + "electionKeyOwnershipProof" AE..= bkwpProofElection, + "signatureVerifyKey" AE..= bkwpSignatureVerifyKey, + "signatureKeyOwnershipProof" AE..= bkwpProofSig, + "aggregationVerifyKey" AE..= bkwpAggregationVerifyKey, + "aggregationKeyOwnershipProof" AE..= bkwpProofAggregation + ] + +-- Implement `FromJSON` instance for `BakerKeysWithProofs`. +instance AE.FromJSON BakerKeysWithProofs where + parseJSON = AE.withObject "BakerKeysWithProofs" $ \obj -> do + bkwpElectionVerifyKey <- obj AE..: "electionVerifyKey" + bkwpProofElection <- obj AE..: "electionKeyOwnershipProof" + bkwpSignatureVerifyKey <- obj AE..: "signatureVerifyKey" + bkwpProofSig <- obj AE..: "signatureKeyOwnershipProof" + bkwpAggregationVerifyKey <- obj AE..: "aggregationVerifyKey" + bkwpProofAggregation <- obj AE..: "aggregationKeyOwnershipProof" + return BakerKeysWithProofs{..} -- | The transaction payload. Defines the supported kinds of transactions. -- @@ -417,28 +431,28 @@ instance S.Serialize TransactionType where instance AE.ToJSON Payload where -- `mod` was renamed to `module` - toJSON DeployModule{dmMod} = AE.object ["module" AE..= dmMod, "transactionType" AE..= AE.String "deployModule"] - toJSON InitContract{icAmount, icModRef, icInitName, icParam} = AE.object ["amount" AE..= icAmount, "modRef" AE..= icModRef, "initName" AE..= icInitName, "param" AE..= icParam, "transactionType" AE..= AE.String "initContract"] - toJSON Update{uAmount, uAddress, uReceiveName, uMessage} = AE.object ["amount" AE..= uAmount, "address" AE..= uAddress, "receiveName" AE..= uReceiveName, "message" AE..= uMessage, "transactionType" AE..= AE.String "update"] - toJSON Transfer{tToAddress, tAmount} = AE.object ["toAddress" AE..= tToAddress, "amount" AE..= tAmount, "transactionType" AE..= AE.String "transfer"] - toJSON UpdateCredentialKeys{uckCredId, uckKeys} = AE.object ["credId" AE..= uckCredId, "keys" AE..= uckKeys, "transactionType" AE..= AE.String "updateCredentialKeys"] - toJSON EncryptedAmountTransfer{eatTo, eatData} = AE.object ["to" AE..= eatTo, "data" AE..= eatData, "transactionType" AE..= AE.String "encryptedAmountTransfer"] - toJSON TransferToEncrypted{tteAmount} = AE.object ["amount" AE..= tteAmount, "transactionType" AE..= AE.String "transferToEncrypted"] - toJSON TransferToPublic{ttpData} = AE.object ["data" AE..= ttpData, "transactionType" AE..= AE.String "transferToPublic"] - toJSON TransferWithSchedule{twsTo, twsSchedule} = AE.object ["to" AE..= twsTo, "schedule" AE..= twsSchedule, "transactionType" AE..= AE.String "transferWithSchedule"] - toJSON UpdateCredentials{ucNewCredInfos, ucRemoveCredIds, ucNewThreshold} = AE.object ["newCredInfos" AE..= ucNewCredInfos, "removeCredIds" AE..= ucRemoveCredIds, "newThreshold" AE..= ucNewThreshold, "transactionType" AE..= AE.String "updateCredentials"] - toJSON RegisterData{rdData} = AE.object ["data" AE..= rdData, "transactionType" AE..= AE.String "registerData"] - toJSON TransferWithMemo{twmToAddress, twmMemo, twmAmount} = AE.object ["toAddress" AE..= twmToAddress, "memo" AE..= twmMemo, "amount" AE..= twmAmount, "transactionType" AE..= AE.String "transferWithMemo"] - toJSON EncryptedAmountTransferWithMemo{eatwmTo, eatwmMemo, eatwmData} = AE.object ["to" AE..= eatwmTo, "memo" AE..= eatwmMemo, "data" AE..= eatwmData, "transactionType" AE..= AE.String "encryptedAmountTransferWithMemo"] - toJSON TransferWithScheduleAndMemo{twswmTo, twswmMemo, twswmSchedule} = AE.object ["to" AE..= twswmTo, "memo" AE..= twswmMemo, "schedule" AE..= twswmSchedule, "transactionType" AE..= AE.String "transferWithScheduleAndMemo"] + toJSON DeployModule{..} = AE.object ["module" AE..= dmMod, "transactionType" AE..= AE.String "deployModule"] + toJSON InitContract{..} = AE.object ["amount" AE..= icAmount, "modRef" AE..= icModRef, "initName" AE..= icInitName, "param" AE..= icParam, "transactionType" AE..= AE.String "initContract"] + toJSON Update{..} = AE.object ["amount" AE..= uAmount, "address" AE..= uAddress, "receiveName" AE..= uReceiveName, "message" AE..= uMessage, "transactionType" AE..= AE.String "update"] + toJSON Transfer{..} = AE.object ["toAddress" AE..= tToAddress, "amount" AE..= tAmount, "transactionType" AE..= AE.String "transfer"] + toJSON UpdateCredentialKeys{..} = AE.object ["credId" AE..= uckCredId, "keys" AE..= uckKeys, "transactionType" AE..= AE.String "updateCredentialKeys"] + toJSON EncryptedAmountTransfer{..} = AE.object ["to" AE..= eatTo, "data" AE..= eatData, "transactionType" AE..= AE.String "encryptedAmountTransfer"] + toJSON TransferToEncrypted{..} = AE.object ["amount" AE..= tteAmount, "transactionType" AE..= AE.String "transferToEncrypted"] + toJSON TransferToPublic{..} = AE.object ["data" AE..= ttpData, "transactionType" AE..= AE.String "transferToPublic"] + toJSON TransferWithSchedule{..} = AE.object ["to" AE..= twsTo, "schedule" AE..= twsSchedule, "transactionType" AE..= AE.String "transferWithSchedule"] + toJSON UpdateCredentials{..} = AE.object ["newCredInfos" AE..= ucNewCredInfos, "removeCredIds" AE..= ucRemoveCredIds, "newThreshold" AE..= ucNewThreshold, "transactionType" AE..= AE.String "updateCredentials"] + toJSON RegisterData{..} = AE.object ["data" AE..= rdData, "transactionType" AE..= AE.String "registerData"] + toJSON TransferWithMemo{..} = AE.object ["toAddress" AE..= twmToAddress, "memo" AE..= twmMemo, "amount" AE..= twmAmount, "transactionType" AE..= AE.String "transferWithMemo"] + toJSON EncryptedAmountTransferWithMemo{..} = AE.object ["to" AE..= eatwmTo, "memo" AE..= eatwmMemo, "data" AE..= eatwmData, "transactionType" AE..= AE.String "encryptedAmountTransferWithMemo"] + toJSON TransferWithScheduleAndMemo{..} = AE.object ["to" AE..= twswmTo, "memo" AE..= twswmMemo, "schedule" AE..= twswmSchedule, "transactionType" AE..= AE.String "transferWithScheduleAndMemo"] -- `configureBaker` was renamed to `configureValidator` - toJSON ConfigureBaker{cbCapital, cbRestakeEarnings, cbOpenForDelegation, cbKeysWithProofs, cbMetadataURL, cbTransactionFeeCommission, cbBakingRewardCommission, cbFinalizationRewardCommission} = AE.object ["capital" AE..= cbCapital, "restakeEarnings" AE..= cbRestakeEarnings, "openForDelegation" AE..= cbOpenForDelegation, "keysWithProofs" AE..= cbKeysWithProofs, "metadataURL" AE..= cbMetadataURL, "transactionFeeCommission" AE..= cbTransactionFeeCommission, "bakingRewardCommission" AE..= cbBakingRewardCommission, "finalizationRewardCommission" AE..= cbFinalizationRewardCommission, "transactionType" AE..= AE.String "configureValidator"] - toJSON ConfigureDelegation{cdCapital, cdRestakeEarnings, cdDelegationTarget} = AE.object ["capital" AE..= cdCapital, "restakeEarnings" AE..= cdRestakeEarnings, "delegationTarget" AE..= cdDelegationTarget, "transactionType" AE..= AE.String "configureDelegation"] - toJSON AddBaker{abElectionVerifyKey, abSignatureVerifyKey, abAggregationVerifyKey, abProofSig, abProofElection, abProofAggregation, abBakingStake, abRestakeEarnings} = AE.object ["electionVerifyKey" AE..= abElectionVerifyKey, "signatureVerifyKey" AE..= abSignatureVerifyKey, "aggregationVerifyKey" AE..= abAggregationVerifyKey, "proofSig" AE..= abProofSig, "proofElection" AE..= abProofElection, "proofAggregation" AE..= abProofAggregation, "bakingStake" AE..= abBakingStake, "restakeEarnings" AE..= abRestakeEarnings, "transactionType" AE..= AE.String "addBaker"] + toJSON ConfigureBaker{..} = AE.object ["capital" AE..= cbCapital, "restakeEarnings" AE..= cbRestakeEarnings, "openForDelegation" AE..= cbOpenForDelegation, "keysWithProofs" AE..= cbKeysWithProofs, "metadataURL" AE..= cbMetadataURL, "transactionFeeCommission" AE..= cbTransactionFeeCommission, "bakingRewardCommission" AE..= cbBakingRewardCommission, "finalizationRewardCommission" AE..= cbFinalizationRewardCommission, "transactionType" AE..= AE.String "configureValidator"] + toJSON ConfigureDelegation{..} = AE.object ["capital" AE..= cdCapital, "restakeEarnings" AE..= cdRestakeEarnings, "delegationTarget" AE..= cdDelegationTarget, "transactionType" AE..= AE.String "configureDelegation"] + toJSON AddBaker{..} = AE.object ["electionVerifyKey" AE..= abElectionVerifyKey, "signatureVerifyKey" AE..= abSignatureVerifyKey, "aggregationVerifyKey" AE..= abAggregationVerifyKey, "proofSig" AE..= abProofSig, "proofElection" AE..= abProofElection, "proofAggregation" AE..= abProofAggregation, "bakingStake" AE..= abBakingStake, "restakeEarnings" AE..= abRestakeEarnings, "transactionType" AE..= AE.String "addBaker"] toJSON RemoveBaker = AE.object ["transactionType" AE..= AE.String "removeBaker"] - toJSON UpdateBakerStake{ubsStake} = AE.object ["stake" AE..= ubsStake, "transactionType" AE..= AE.String "updateBakerStake"] - toJSON UpdateBakerRestakeEarnings{ubreRestakeEarnings} = AE.object ["restakeEarnings" AE..= ubreRestakeEarnings, "transactionType" AE..= AE.String "updateBakerRestakeEarnings"] - toJSON UpdateBakerKeys{ubkElectionVerifyKey, ubkSignatureVerifyKey, ubkAggregationVerifyKey, ubkProofSig, ubkProofElection, ubkProofAggregation} = AE.object ["electionVerifyKey" AE..= ubkElectionVerifyKey, "signatureVerifyKey" AE..= ubkSignatureVerifyKey, "aggregationVerifyKey" AE..= ubkAggregationVerifyKey, "proofSig" AE..= ubkProofSig, "proofElection" AE..= ubkProofElection, "proofAggregation" AE..= ubkProofAggregation, "transactionType" AE..= AE.String "updateBakerKeys"] + toJSON UpdateBakerStake{..} = AE.object ["stake" AE..= ubsStake, "transactionType" AE..= AE.String "updateBakerStake"] + toJSON UpdateBakerRestakeEarnings{..} = AE.object ["restakeEarnings" AE..= ubreRestakeEarnings, "transactionType" AE..= AE.String "updateBakerRestakeEarnings"] + toJSON UpdateBakerKeys{..} = AE.object ["electionVerifyKey" AE..= ubkElectionVerifyKey, "signatureVerifyKey" AE..= ubkSignatureVerifyKey, "aggregationVerifyKey" AE..= ubkAggregationVerifyKey, "proofSig" AE..= ubkProofSig, "proofElection" AE..= ubkProofElection, "proofAggregation" AE..= ubkProofAggregation, "transactionType" AE..= AE.String "updateBakerKeys"] instance AE.FromJSON Payload where parseJSON = AE.withObject "payload" $ \obj -> do @@ -447,29 +461,29 @@ instance AE.FromJSON Payload where case transactionType of "deployModule" -> do dmMod <- obj AE..: "module" - return DeployModule{dmMod} + return DeployModule{..} "initContract" -> do icAmount <- obj AE..: "amount" icModRef <- obj AE..: "modRef" icInitName <- obj AE..: "initName" icParam <- obj AE..: "param" - return InitContract{icAmount, icModRef, icInitName, icParam} + return InitContract{..} "update" -> do uAmount <- obj AE..: "amount" uAddress <- obj AE..: "address" uReceiveName <- obj AE..: "receiveName" uMessage <- obj AE..: "message" - return Update{uAmount, uAddress, uReceiveName, uMessage} + return Update{..} "transfer" -> do tToAddress <- obj AE..: "toAddress" tAmount <- obj AE..: "amount" - return Transfer{tToAddress, tAmount} + return Transfer{..} "UpdateBakerStake" -> do ubsStake <- obj AE..: "stake" - return UpdateBakerStake{ubsStake} + return UpdateBakerStake{..} "updateBakerRestakeEarnings" -> do ubreRestakeEarnings <- obj AE..: "restakeEarnings" - return UpdateBakerRestakeEarnings{ubreRestakeEarnings} + return UpdateBakerRestakeEarnings{..} "updateBakerKeys" -> do ubkElectionVerifyKey <- obj AE..: "electionVerifyKey" ubkSignatureVerifyKey <- obj AE..: "signatureVerifyKey" @@ -477,11 +491,11 @@ instance AE.FromJSON Payload where ubkProofSig <- obj AE..: "proofSig" ubkProofElection <- obj AE..: "proofElection" ubkProofAggregation <- obj AE..: "proofAggregation" - return UpdateBakerKeys{ubkElectionVerifyKey, ubkSignatureVerifyKey, ubkAggregationVerifyKey, ubkProofSig, ubkProofElection, ubkProofAggregation} + return UpdateBakerKeys{..} "updateCredentialKeys" -> do uckCredId <- obj AE..: "credId" uckKeys <- obj AE..: "keys" - return UpdateCredentialKeys{uckCredId, uckKeys} + return UpdateCredentialKeys{..} "removeBaker" -> do return RemoveBaker "addBaker" -> do @@ -493,44 +507,44 @@ instance AE.FromJSON Payload where abProofAggregation <- obj AE..: "proofAggregation" abBakingStake <- obj AE..: "bakingStake" abRestakeEarnings <- obj AE..: "restakeEarnings" - return AddBaker{abElectionVerifyKey, abSignatureVerifyKey, abAggregationVerifyKey, abProofSig, abProofElection, abProofAggregation, abBakingStake, abRestakeEarnings} + return AddBaker{..} "encryptedAmountTransfer" -> do eatTo <- obj AE..: "to" eatData <- obj AE..: "data" - return EncryptedAmountTransfer{eatTo, eatData} + return EncryptedAmountTransfer{..} "transferToEncrypted" -> do tteAmount <- obj AE..: "amount" - return TransferToEncrypted{tteAmount} + return TransferToEncrypted{..} "transferToPublic" -> do ttpData <- obj AE..: "data" - return TransferToPublic{ttpData} + return TransferToPublic{..} "transferWithSchedule" -> do twsTo <- obj AE..: "to" twsSchedule <- obj AE..: "schedule" - return TransferWithSchedule{twsTo, twsSchedule} + return TransferWithSchedule{..} "updateCredentials" -> do ucNewCredInfos <- obj AE..: "newCredInfos" ucRemoveCredIds <- obj AE..: "removeCredIds" ucNewThreshold <- obj AE..: "newThreshold" - return UpdateCredentials{ucNewCredInfos, ucRemoveCredIds, ucNewThreshold} + return UpdateCredentials{..} "registerData" -> do rdData <- obj AE..: "data" - return RegisterData{rdData} + return RegisterData{..} "transferWithMemo" -> do twmToAddress <- obj AE..: "toAddress" twmMemo <- obj AE..: "memo" twmAmount <- obj AE..: "amount" - return TransferWithMemo{twmToAddress, twmMemo, twmAmount} + return TransferWithMemo{..} "encryptedAmountTransferWithMemo" -> do eatwmTo <- obj AE..: "to" eatwmMemo <- obj AE..: "memo" eatwmData <- obj AE..: "data" - return EncryptedAmountTransferWithMemo{eatwmTo, eatwmMemo, eatwmData} + return EncryptedAmountTransferWithMemo{..} "transferWithScheduleAndMemo" -> do twswmTo <- obj AE..: "to" twswmMemo <- obj AE..: "memo" twswmSchedule <- obj AE..: "schedule" - return TransferWithScheduleAndMemo{twswmTo, twswmMemo, twswmSchedule} + return TransferWithScheduleAndMemo{..} "configureValidator" -> do cbCapital <- obj AE..: "capital" cbRestakeEarnings <- obj AE..: "restakeEarnings" @@ -540,12 +554,12 @@ instance AE.FromJSON Payload where cbTransactionFeeCommission <- obj AE..: "transactionFeeCommission" cbBakingRewardCommission <- obj AE..: "bakingRewardCommission" cbFinalizationRewardCommission <- obj AE..: "finalizationRewardCommission" - return ConfigureBaker{cbCapital, cbRestakeEarnings, cbOpenForDelegation, cbKeysWithProofs, cbMetadataURL, cbTransactionFeeCommission, cbBakingRewardCommission, cbFinalizationRewardCommission} + return ConfigureBaker{..} "configureDelegation" -> do cdCapital <- obj AE..: "capital" cdRestakeEarnings <- obj AE..: "restakeEarnings" cdDelegationTarget <- obj AE..: "delegationTarget" - return ConfigureDelegation{cdCapital, cdRestakeEarnings, cdDelegationTarget} + return ConfigureDelegation{..} _ -> fail "Unrecognized 'TransactionType' tag" -- | Payload serialization according to @@ -2402,6 +2416,7 @@ instance S.Serialize RejectReason where n -> fail $ "Unrecognized RejectReason tag: " ++ show n instance AE.ToJSON RejectReason + instance AE.FromJSON RejectReason -- | Reasons for the execution of a transaction to fail on the current block state. diff --git a/haskell-src/Concordium/Types/Transactions.hs b/haskell-src/Concordium/Types/Transactions.hs index 38522ef35..e36af1b91 100644 --- a/haskell-src/Concordium/Types/Transactions.hs +++ b/haskell-src/Concordium/Types/Transactions.hs @@ -18,7 +18,6 @@ import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as AE import Data.Aeson.TH import qualified Data.ByteString as BS -import Data.Char (isLower) import Data.List (foldl') import qualified Data.Map.Strict as Map import qualified Data.Serialize as S @@ -31,7 +30,6 @@ import qualified Data.Vector as Vec import Concordium.ID.Types import Concordium.Types -import Concordium.Types.Execution import Concordium.Types.HashableTo import Concordium.Types.Updates import Concordium.Utils From 377398d920e8b09f4105287de52f69f013af1c00 Mon Sep 17 00:00:00 2001 From: Doris Benda Date: Fri, 24 May 2024 11:08:12 +0300 Subject: [PATCH 19/19] Address comments --- haskell-src/Concordium/Types/Execution.hs | 126 +++++++++++++++++++--- haskell-src/Concordium/Wasm.hs | 43 ++++---- 2 files changed, 136 insertions(+), 33 deletions(-) diff --git a/haskell-src/Concordium/Types/Execution.hs b/haskell-src/Concordium/Types/Execution.hs index d1aeab410..aee761421 100644 --- a/haskell-src/Concordium/Types/Execution.hs +++ b/haskell-src/Concordium/Types/Execution.hs @@ -432,27 +432,123 @@ instance S.Serialize TransactionType where instance AE.ToJSON Payload where -- `mod` was renamed to `module` toJSON DeployModule{..} = AE.object ["module" AE..= dmMod, "transactionType" AE..= AE.String "deployModule"] - toJSON InitContract{..} = AE.object ["amount" AE..= icAmount, "modRef" AE..= icModRef, "initName" AE..= icInitName, "param" AE..= icParam, "transactionType" AE..= AE.String "initContract"] - toJSON Update{..} = AE.object ["amount" AE..= uAmount, "address" AE..= uAddress, "receiveName" AE..= uReceiveName, "message" AE..= uMessage, "transactionType" AE..= AE.String "update"] - toJSON Transfer{..} = AE.object ["toAddress" AE..= tToAddress, "amount" AE..= tAmount, "transactionType" AE..= AE.String "transfer"] - toJSON UpdateCredentialKeys{..} = AE.object ["credId" AE..= uckCredId, "keys" AE..= uckKeys, "transactionType" AE..= AE.String "updateCredentialKeys"] - toJSON EncryptedAmountTransfer{..} = AE.object ["to" AE..= eatTo, "data" AE..= eatData, "transactionType" AE..= AE.String "encryptedAmountTransfer"] + toJSON InitContract{..} = + AE.object + [ "amount" AE..= icAmount, + "modRef" AE..= icModRef, + "initName" AE..= icInitName, + "param" AE..= icParam, + "transactionType" AE..= AE.String "initContract" + ] + toJSON Update{..} = + AE.object + [ "amount" AE..= uAmount, + "address" AE..= uAddress, + "receiveName" AE..= uReceiveName, + "message" AE..= uMessage, + "transactionType" AE..= AE.String "update" + ] + toJSON Transfer{..} = + AE.object + ["toAddress" AE..= tToAddress, "amount" AE..= tAmount, "transactionType" AE..= AE.String "transfer"] + toJSON UpdateCredentialKeys{..} = + AE.object + [ "credId" AE..= uckCredId, + "keys" AE..= uckKeys, + "transactionType" AE..= AE.String "updateCredentialKeys" + ] + toJSON EncryptedAmountTransfer{..} = + AE.object + [ "to" AE..= eatTo, + "data" AE..= eatData, + "transactionType" AE..= AE.String "encryptedAmountTransfer" + ] toJSON TransferToEncrypted{..} = AE.object ["amount" AE..= tteAmount, "transactionType" AE..= AE.String "transferToEncrypted"] toJSON TransferToPublic{..} = AE.object ["data" AE..= ttpData, "transactionType" AE..= AE.String "transferToPublic"] - toJSON TransferWithSchedule{..} = AE.object ["to" AE..= twsTo, "schedule" AE..= twsSchedule, "transactionType" AE..= AE.String "transferWithSchedule"] - toJSON UpdateCredentials{..} = AE.object ["newCredInfos" AE..= ucNewCredInfos, "removeCredIds" AE..= ucRemoveCredIds, "newThreshold" AE..= ucNewThreshold, "transactionType" AE..= AE.String "updateCredentials"] + toJSON TransferWithSchedule{..} = + AE.object + [ "to" AE..= twsTo, + "schedule" AE..= twsSchedule, + "transactionType" AE..= AE.String "transferWithSchedule" + ] + toJSON UpdateCredentials{..} = + AE.object + [ "newCredInfos" AE..= ucNewCredInfos, + "removeCredIds" AE..= ucRemoveCredIds, + "newThreshold" AE..= ucNewThreshold, + "transactionType" AE..= AE.String "updateCredentials" + ] toJSON RegisterData{..} = AE.object ["data" AE..= rdData, "transactionType" AE..= AE.String "registerData"] - toJSON TransferWithMemo{..} = AE.object ["toAddress" AE..= twmToAddress, "memo" AE..= twmMemo, "amount" AE..= twmAmount, "transactionType" AE..= AE.String "transferWithMemo"] - toJSON EncryptedAmountTransferWithMemo{..} = AE.object ["to" AE..= eatwmTo, "memo" AE..= eatwmMemo, "data" AE..= eatwmData, "transactionType" AE..= AE.String "encryptedAmountTransferWithMemo"] - toJSON TransferWithScheduleAndMemo{..} = AE.object ["to" AE..= twswmTo, "memo" AE..= twswmMemo, "schedule" AE..= twswmSchedule, "transactionType" AE..= AE.String "transferWithScheduleAndMemo"] + toJSON TransferWithMemo{..} = + AE.object + [ "toAddress" AE..= twmToAddress, + "memo" AE..= twmMemo, + "amount" AE..= twmAmount, + "transactionType" AE..= AE.String "transferWithMemo" + ] + toJSON EncryptedAmountTransferWithMemo{..} = + AE.object + [ "to" AE..= eatwmTo, + "memo" AE..= eatwmMemo, + "data" AE..= eatwmData, + "transactionType" AE..= AE.String "encryptedAmountTransferWithMemo" + ] + toJSON TransferWithScheduleAndMemo{..} = + AE.object + [ "to" AE..= twswmTo, + "memo" AE..= twswmMemo, + "schedule" AE..= twswmSchedule, + "transactionType" AE..= AE.String "transferWithScheduleAndMemo" + ] -- `configureBaker` was renamed to `configureValidator` - toJSON ConfigureBaker{..} = AE.object ["capital" AE..= cbCapital, "restakeEarnings" AE..= cbRestakeEarnings, "openForDelegation" AE..= cbOpenForDelegation, "keysWithProofs" AE..= cbKeysWithProofs, "metadataURL" AE..= cbMetadataURL, "transactionFeeCommission" AE..= cbTransactionFeeCommission, "bakingRewardCommission" AE..= cbBakingRewardCommission, "finalizationRewardCommission" AE..= cbFinalizationRewardCommission, "transactionType" AE..= AE.String "configureValidator"] - toJSON ConfigureDelegation{..} = AE.object ["capital" AE..= cdCapital, "restakeEarnings" AE..= cdRestakeEarnings, "delegationTarget" AE..= cdDelegationTarget, "transactionType" AE..= AE.String "configureDelegation"] - toJSON AddBaker{..} = AE.object ["electionVerifyKey" AE..= abElectionVerifyKey, "signatureVerifyKey" AE..= abSignatureVerifyKey, "aggregationVerifyKey" AE..= abAggregationVerifyKey, "proofSig" AE..= abProofSig, "proofElection" AE..= abProofElection, "proofAggregation" AE..= abProofAggregation, "bakingStake" AE..= abBakingStake, "restakeEarnings" AE..= abRestakeEarnings, "transactionType" AE..= AE.String "addBaker"] + toJSON ConfigureBaker{..} = + AE.object + [ "capital" AE..= cbCapital, + "restakeEarnings" AE..= cbRestakeEarnings, + "openForDelegation" AE..= cbOpenForDelegation, + "keysWithProofs" AE..= cbKeysWithProofs, + "metadataURL" AE..= cbMetadataURL, + "transactionFeeCommission" AE..= cbTransactionFeeCommission, + "bakingRewardCommission" AE..= cbBakingRewardCommission, + "finalizationRewardCommission" AE..= cbFinalizationRewardCommission, + "transactionType" AE..= AE.String "configureValidator" + ] + toJSON ConfigureDelegation{..} = + AE.object + [ "capital" AE..= cdCapital, + "restakeEarnings" AE..= cdRestakeEarnings, + "delegationTarget" AE..= cdDelegationTarget, + "transactionType" AE..= AE.String "configureDelegation" + ] + toJSON AddBaker{..} = + AE.object + [ "electionVerifyKey" AE..= abElectionVerifyKey, + "signatureVerifyKey" AE..= abSignatureVerifyKey, + "aggregationVerifyKey" AE..= abAggregationVerifyKey, + "proofSig" AE..= abProofSig, + "proofElection" AE..= abProofElection, + "proofAggregation" AE..= abProofAggregation, + "bakingStake" AE..= abBakingStake, + "restakeEarnings" AE..= abRestakeEarnings, + "transactionType" AE..= AE.String "addBaker" + ] toJSON RemoveBaker = AE.object ["transactionType" AE..= AE.String "removeBaker"] toJSON UpdateBakerStake{..} = AE.object ["stake" AE..= ubsStake, "transactionType" AE..= AE.String "updateBakerStake"] - toJSON UpdateBakerRestakeEarnings{..} = AE.object ["restakeEarnings" AE..= ubreRestakeEarnings, "transactionType" AE..= AE.String "updateBakerRestakeEarnings"] - toJSON UpdateBakerKeys{..} = AE.object ["electionVerifyKey" AE..= ubkElectionVerifyKey, "signatureVerifyKey" AE..= ubkSignatureVerifyKey, "aggregationVerifyKey" AE..= ubkAggregationVerifyKey, "proofSig" AE..= ubkProofSig, "proofElection" AE..= ubkProofElection, "proofAggregation" AE..= ubkProofAggregation, "transactionType" AE..= AE.String "updateBakerKeys"] + toJSON UpdateBakerRestakeEarnings{..} = + AE.object + [ "restakeEarnings" AE..= ubreRestakeEarnings, + "transactionType" AE..= AE.String "updateBakerRestakeEarnings" + ] + toJSON UpdateBakerKeys{..} = + AE.object + [ "electionVerifyKey" AE..= ubkElectionVerifyKey, + "signatureVerifyKey" AE..= ubkSignatureVerifyKey, + "aggregationVerifyKey" AE..= ubkAggregationVerifyKey, + "proofSig" AE..= ubkProofSig, + "proofElection" AE..= ubkProofElection, + "proofAggregation" AE..= ubkProofAggregation, + "transactionType" AE..= AE.String "updateBakerKeys" + ] instance AE.FromJSON Payload where parseJSON = AE.withObject "payload" $ \obj -> do diff --git a/haskell-src/Concordium/Wasm.hs b/haskell-src/Concordium/Wasm.hs index 56574e91e..4af7615d2 100644 --- a/haskell-src/Concordium/Wasm.hs +++ b/haskell-src/Concordium/Wasm.hs @@ -147,14 +147,13 @@ module Concordium.Wasm ( import Control.Monad import qualified Data.Aeson as AE -import Data.Aeson.TH import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as BS16 import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as BSS import Data.ByteString.Unsafe (unsafeUseAsCStringLen) -import Data.Char (isAlphaNum, isAscii, isLower, isPunctuation) +import Data.Char (isAlphaNum, isAscii, isPunctuation) import qualified Data.HashMap.Strict as HM import Data.Hashable import Data.Int (Int32) @@ -176,7 +175,6 @@ import qualified Concordium.Crypto.SHA256 as H import Concordium.ID.Types import Concordium.Types import Concordium.Types.HashableTo -import Concordium.Utils import Concordium.Utils.Serialization -------------------------------------------------------------------------------- @@ -304,14 +302,23 @@ moduleSourceLength = fromIntegral . BS.length . moduleSource newtype WasmModuleV (v :: WasmVersion) = WasmModuleV {wmvSource :: ModuleSource v} deriving (Eq, Show) --- Implement `FromJSON` and `ToJSON` instances for `WasmModuleV`. -$( deriveJSON - defaultOptions - { AE.constructorTagModifier = firstLower, - AE.fieldLabelModifier = firstLower . dropWhile isLower - } - ''WasmModuleV - ) +-- Implement `ToJSON` instance for `WasmModuleV`. +instance (IsWasmVersion v) => AE.ToJSON (WasmModuleV v) where + toJSON (WasmModuleV ws) = + AE.object + [ "version" AE..= wasmVersionToWord (demoteWasmVersion (getWasmVersion @v)), + "source" AE..= ModuleSource (moduleSource ws) + ] + +-- Implement `FromJSON` instance for `WasmModuleV`. +instance (IsWasmVersion v) => AE.FromJSON (WasmModuleV v) where + parseJSON = AE.withObject "WasmModuleV" $ \obj -> do + version <- obj AE..: "version" + if wordToWasmVersion version == Just (demoteWasmVersion (getWasmVersion @v)) + then do + source <- obj AE..: "source" + return $ WasmModuleV (ModuleSource $ moduleSource source) + else fail $ "Expecting a " ++ show (demoteWasmVersion $ getWasmVersion @v) ++ " module." instance (IsWasmVersion v) => Serialize (WasmModuleV v) where put (WasmModuleV ws) = case getWasmVersion @v of @@ -336,18 +343,18 @@ data WasmModule -- Custom implementation of ToJSON for WasmModule instance AE.ToJSON WasmModule where - toJSON (WasmModuleV0 wasmV0) = AE.object ["version" AE..= (0 :: Int), "content" AE..= AE.toJSON wasmV0] - toJSON (WasmModuleV1 wasmV1) = AE.object ["version" AE..= (1 :: Int), "content" AE..= AE.toJSON wasmV1] + toJSON = \case + WasmModuleV0 wm -> AE.toJSON wm + WasmModuleV1 wm -> AE.toJSON wm -- Custom implementation of FromJSON for WasmModule instance AE.FromJSON WasmModule where parseJSON = AE.withObject "WasmModule" $ \obj -> do version <- obj AE..: "version" - content <- obj AE..: "content" - case version :: Int of - 0 -> WasmModuleV0 <$> AE.parseJSON content - 1 -> WasmModuleV1 <$> AE.parseJSON content - _ -> fail "Invalid version number" + case wordToWasmVersion version of + Just V0 -> WasmModuleV0 . WasmModuleV <$> obj AE..: "source" + Just V1 -> WasmModuleV1 . WasmModuleV <$> obj AE..: "source" + Nothing -> fail $ "Unsupported Wasm version " ++ show version getModuleRef :: forall v. (IsWasmVersion v) => WasmModuleV v -> ModuleRef getModuleRef wm = case getWasmVersion @v of