From 285deefcb07608cd490469e7237942e4887de1ff Mon Sep 17 00:00:00 2001 From: Konstantinos Lambrou-Latreille Date: Mon, 26 Jul 2021 15:27:19 -0400 Subject: [PATCH] Moved functions using cryptonite from plutus-ledger to plutus-ledger-api --- plutus-ledger-api/plutus-ledger-api.cabal | 1 - .../src/Plutus/V1/Ledger/Orphans.hs | 37 ++-------- plutus-ledger-api/src/Plutus/V1/Ledger/Tx.hs | 46 ------------- plutus-ledger/src/Ledger/AddressMap.hs | 3 +- plutus-ledger/src/Ledger/Blockchain.hs | 4 +- plutus-ledger/src/Ledger/Index.hs | 1 + plutus-ledger/src/Ledger/Orphans.hs | 31 +++++++++ plutus-ledger/src/Ledger/Tx.hs | 68 +++++++++++++++++-- 8 files changed, 105 insertions(+), 86 deletions(-) diff --git a/plutus-ledger-api/plutus-ledger-api.cabal b/plutus-ledger-api/plutus-ledger-api.cabal index 919b6a86d99..10c4f3b73fe 100644 --- a/plutus-ledger-api/plutus-ledger-api.cabal +++ b/plutus-ledger-api/plutus-ledger-api.cabal @@ -60,7 +60,6 @@ library bytestring -any, cborg -any, containers -any, - cryptonite >=0.25, flat -any, hashable -any, plutus-core -any, diff --git a/plutus-ledger-api/src/Plutus/V1/Ledger/Orphans.hs b/plutus-ledger-api/src/Plutus/V1/Ledger/Orphans.hs index 3f18f5195fc..28342e30848 100644 --- a/plutus-ledger-api/src/Plutus/V1/Ledger/Orphans.hs +++ b/plutus-ledger-api/src/Plutus/V1/Ledger/Orphans.hs @@ -1,43 +1,14 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Plutus.V1.Ledger.Orphans where -import Codec.Serialise.Class (Serialise, decode, encode) -import Crypto.Hash (Digest, SHA256, digestFromByteString) -import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON)) -import qualified Data.Aeson as JSON -import qualified Data.Aeson.Extras as JSON -import qualified Data.ByteArray as BA -import qualified Data.ByteString as BSS +import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON)) +import qualified Data.Aeson as JSON +import qualified Data.Aeson.Extras as JSON +import qualified Data.ByteString as BSS -{- Note [Serialising Digests from Crypto.Hash] -This is more complicated than you might expect. If you say -`encode = encode . BA.unpack` then the contents of the digest are -unpacked into a `Word8` list with 32 entries. However, when cborg -serialises a list, every element in the output is preceded by a type -tag (in this case, 24), and this means that the serialised version is -about 64 bytes long, twice the length of the original data. Packing -the `Word8` list into a `ByteString` first fixes this because cborg -just serialises it as a sequence of contiguous bytes. -} - -instance Serialise (Digest SHA256) where - encode = encode . BSS.pack . BA.unpack - decode = do - d :: BSS.ByteString <- decode - let bs :: BA.Bytes = BA.pack . BSS.unpack $ d - case digestFromByteString bs of - Nothing -> fail $ "Couldn't decode SHA256 Digest: " ++ show d - Just v -> pure v - -instance ToJSON (Digest SHA256) where - toJSON = JSON.String . JSON.encodeSerialise - -instance FromJSON (Digest SHA256) where - parseJSON = JSON.decodeSerialise - instance ToJSON BSS.ByteString where toJSON = JSON.String . JSON.encodeByteString diff --git a/plutus-ledger-api/src/Plutus/V1/Ledger/Tx.hs b/plutus-ledger-api/src/Plutus/V1/Ledger/Tx.hs index 341c5333bf0..250e4447da8 100644 --- a/plutus-ledger-api/src/Plutus/V1/Ledger/Tx.hs +++ b/plutus-ledger-api/src/Plutus/V1/Ledger/Tx.hs @@ -19,10 +19,7 @@ module Plutus.V1.Ledger.Tx( inputs, collateralInputs, outputs, - txOutRefs, - unspentOutputsTx, spentOutputs, - updateUtxo, updateUtxoCollateral, validValuesTx, mintScripts, @@ -37,8 +34,6 @@ module Plutus.V1.Ledger.Tx( ScriptTag (..), RedeemerPtr (..), Redeemers, - -- ** Hashing transactions - txId, -- ** Stripped transactions TxStripped(..), strip, @@ -73,7 +68,6 @@ import qualified Codec.CBOR.Write as Write import Codec.Serialise.Class (Serialise, encode) import Control.DeepSeq (NFData) import Control.Lens -import Crypto.Hash (Digest, SHA256, hash) import Data.Aeson (FromJSON, FromJSONKey (..), ToJSON, ToJSONKey (..)) import qualified Data.ByteArray as BA import Data.Map (Map) @@ -145,22 +139,6 @@ data Tx = Tx { } deriving stock (Show, Eq, Generic) deriving anyclass (ToJSON, FromJSON, Serialise, NFData) -instance Pretty Tx where - pretty t@Tx{txInputs, txCollateral, txOutputs, txMint, txFee, txValidRange, txSignatures, txMintScripts, txData} = - let lines' = - [ hang 2 (vsep ("inputs:" : fmap pretty (Set.toList txInputs))) - , hang 2 (vsep ("collateral inputs:" : fmap pretty (Set.toList txCollateral))) - , hang 2 (vsep ("outputs:" : fmap pretty txOutputs)) - , "mint:" <+> pretty txMint - , "fee:" <+> pretty txFee - , hang 2 (vsep ("mps:": fmap pretty (Set.toList txMintScripts))) - , hang 2 (vsep ("signatures:": fmap (pretty . fst) (Map.toList txSignatures))) - , "validity range:" <+> viaShow txValidRange - , hang 2 (vsep ("data:": fmap (pretty . snd) (Map.toList txData) )) - ] - txid = txId t - in nest 2 $ vsep ["Tx" <+> pretty txid <> colon, braces (vsep lines')] - instance Semigroup Tx where tx1 <> tx2 = Tx { txInputs = txInputs tx1 <> txInputs tx2, @@ -268,15 +246,6 @@ strip :: Tx -> TxStripped strip Tx{..} = TxStripped i txOutputs txMint txFee where i = Set.map txInRef txInputs --- | Compute the id of a transaction. -txId :: Tx -> TxId --- Double hash of a transaction, excluding its witnesses. -txId tx = TxId $ BA.convert h' where - h :: Digest SHA256 - h = hash $ Write.toStrictByteString $ encode $ strip tx - h' :: Digest SHA256 - h' = hash h - -- | A tag indicating the type of script that we are pointing to. -- NOTE: Cert/Reward are not supported right now. data ScriptTag = Spend | Mint | Cert | Reward @@ -310,11 +279,6 @@ instance PlutusTx.Eq TxOutRef where txOutRefId l PlutusTx.== txOutRefId r PlutusTx.&& txOutRefIdx l PlutusTx.== txOutRefIdx r --- | A list of a transaction's outputs paired with a 'TxOutRef's referring to them. -txOutRefs :: Tx -> [(TxOut, TxOutRef)] -txOutRefs t = mkOut <$> zip [0..] (txOutputs t) where - mkOut (i, o) = (o, TxOutRef (txId t) i) - -- | The type of a transaction input. data TxInType = -- TODO: these should all be hashes, with the validators and data segregated to the side @@ -435,20 +399,10 @@ txOutTxDatum (TxOutTx tx out) = txOutDatum out >>= lookupDatum tx pubKeyHashTxOut :: Value -> PubKeyHash -> TxOut pubKeyHashTxOut v pkh = TxOut (pubKeyHashAddress pkh) v Nothing --- | The unspent outputs of a transaction. -unspentOutputsTx :: Tx -> Map TxOutRef TxOut -unspentOutputsTx t = Map.fromList $ fmap f $ zip [0..] $ txOutputs t where - f (idx, o) = (TxOutRef (txId t) idx, o) - -- | The transaction output references consumed by a transaction. spentOutputs :: Tx -> Set.Set TxOutRef spentOutputs = Set.map txInRef . txInputs --- | Update a map of unspent transaction outputs and signatures based on the inputs --- and outputs of a transaction. -updateUtxo :: Tx -> Map TxOutRef TxOut -> Map TxOutRef TxOut -updateUtxo tx unspent = (unspent `Map.withoutKeys` spentOutputs tx) `Map.union` unspentOutputsTx tx - -- | Update a map of unspent transaction outputs and signatures -- for a failed transaction using its collateral inputs. updateUtxoCollateral :: Tx -> Map TxOutRef TxOut -> Map TxOutRef TxOut diff --git a/plutus-ledger/src/Ledger/AddressMap.hs b/plutus-ledger/src/Ledger/AddressMap.hs index 279809818b6..0a721b3afbc 100644 --- a/plutus-ledger/src/Ledger/AddressMap.hs +++ b/plutus-ledger/src/Ledger/AddressMap.hs @@ -42,8 +42,9 @@ import qualified Data.Set as Set import GHC.Generics (Generic) import Ledger.Blockchain +import Ledger.Tx (txId) import Plutus.V1.Ledger.Address (Address (..)) -import Plutus.V1.Ledger.Tx (Tx (..), TxIn (..), TxOut (..), TxOutRef (..), TxOutTx (..), txId) +import Plutus.V1.Ledger.Tx (Tx (..), TxIn (..), TxOut (..), TxOutRef (..), TxOutTx (..)) import Plutus.V1.Ledger.Value (Value) type UtxoMap = Map TxOutRef TxOutTx diff --git a/plutus-ledger/src/Ledger/Blockchain.hs b/plutus-ledger/src/Ledger/Blockchain.hs index de98f2f7d43..1664c11823d 100644 --- a/plutus-ledger/src/Ledger/Blockchain.hs +++ b/plutus-ledger/src/Ledger/Blockchain.hs @@ -35,10 +35,12 @@ import qualified Data.Map as Map import Data.Monoid (First (..)) import qualified Data.Set as Set import GHC.Generics (Generic) +import Ledger.Tx (spentOutputs, txId, unspentOutputsTx, updateUtxo, validValuesTx) import Plutus.V1.Ledger.Crypto import Plutus.V1.Ledger.Scripts -import Plutus.V1.Ledger.Tx +import Plutus.V1.Ledger.Tx (Tx, TxIn, TxOut, TxOutRef, collateralInputs, inputs, txOutDatum, txOutPubKey, + txOutRefId, txOutRefIdx, txOutValue, txOutputs, updateUtxoCollateral) import Plutus.V1.Ledger.TxId import Plutus.V1.Ledger.Value (Value) diff --git a/plutus-ledger/src/Ledger/Index.hs b/plutus-ledger/src/Ledger/Index.hs index 5998712d9de..1a8dd156327 100644 --- a/plutus-ledger/src/Ledger/Index.hs +++ b/plutus-ledger/src/Ledger/Index.hs @@ -62,6 +62,7 @@ import Ledger.Blockchain import Ledger.Crypto import Ledger.Scripts import qualified Ledger.TimeSlot as TimeSlot +import Ledger.Tx (txId) import qualified Plutus.V1.Ledger.Ada as Ada import Plutus.V1.Ledger.Address import qualified Plutus.V1.Ledger.Api as Api diff --git a/plutus-ledger/src/Ledger/Orphans.hs b/plutus-ledger/src/Ledger/Orphans.hs index 15dd38e2360..a94b9602381 100644 --- a/plutus-ledger/src/Ledger/Orphans.hs +++ b/plutus-ledger/src/Ledger/Orphans.hs @@ -3,13 +3,44 @@ {-# OPTIONS_GHC -Wno-orphans #-} module Ledger.Orphans where +import Codec.Serialise.Class (Serialise, decode, encode) +import Crypto.Hash (Digest, SHA256, digestFromByteString) +import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON)) +import qualified Data.Aeson as JSON import qualified Data.Aeson.Extras as JSON import Data.Bifunctor (bimap) +import qualified Data.ByteArray as BA +import qualified Data.ByteString as BSS import qualified Data.Text as Text import Plutus.V1.Ledger.Bytes import Plutus.V1.Ledger.Crypto import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..)) +{- Note [Serialising Digests from Crypto.Hash] +This is more complicated than you might expect. If you say +`encode = encode . BA.unpack` then the contents of the digest are +unpacked into a `Word8` list with 32 entries. However, when cborg +serialises a list, every element in the output is preceded by a type +tag (in this case, 24), and this means that the serialised version is +about 64 bytes long, twice the length of the original data. Packing +the `Word8` list into a `ByteString` first fixes this because cborg +just serialises it as a sequence of contiguous bytes. -} + +instance Serialise (Digest SHA256) where + encode = encode . BSS.pack . BA.unpack + decode = do + d :: BSS.ByteString <- decode + let bs :: BA.Bytes = BA.pack . BSS.unpack $ d + case digestFromByteString bs of + Nothing -> fail $ "Couldn't decode SHA256 Digest: " ++ show d + Just v -> pure v + +instance ToJSON (Digest SHA256) where + toJSON = JSON.String . JSON.encodeSerialise + +instance FromJSON (Digest SHA256) where + parseJSON = JSON.decodeSerialise + instance ToHttpApiData PrivateKey where toUrlPiece = toUrlPiece . getPrivateKey diff --git a/plutus-ledger/src/Ledger/Tx.hs b/plutus-ledger/src/Ledger/Tx.hs index 30b7e450699..4a9d7f05663 100644 --- a/plutus-ledger/src/Ledger/Tx.hs +++ b/plutus-ledger/src/Ledger/Tx.hs @@ -1,18 +1,78 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Ledger.Tx ( module Export + -- * Transactions , addSignature , pubKeyTxOut , scriptTxOut , scriptTxOut' + , updateUtxo + , txOutRefs + , unspentOutputsTx + -- ** Hashing transactions + , txId ) where +import qualified Codec.CBOR.Write as Write +import Codec.Serialise.Class (encode) import Control.Lens -import Ledger.Address (pubKeyAddress, scriptAddress) -import Ledger.Crypto (PrivateKey, PubKey, signTx, toPublicKey) -import Ledger.Scripts (Datum, Validator, datumHash) -import Plutus.V1.Ledger.Tx as Export +import Crypto.Hash (Digest, SHA256, hash) +import qualified Data.ByteArray as BA +import Data.Map (Map) +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Text.Prettyprint.Doc (Pretty (pretty), braces, colon, hang, nest, viaShow, vsep, (<+>)) +import Ledger.Address (pubKeyAddress, scriptAddress) +import Ledger.Crypto (PrivateKey, PubKey, signTx, toPublicKey) +import Ledger.Scripts (Datum, Validator, datumHash) +import Plutus.V1.Ledger.Tx as Export +import Plutus.V1.Ledger.TxId (TxId (..)) import Plutus.V1.Ledger.Value +instance Pretty Tx where + pretty t@Tx{txInputs, txCollateral, txOutputs, txMint, txFee, txValidRange, txSignatures, txMintScripts, txData} = + let lines' = + [ hang 2 (vsep ("inputs:" : fmap pretty (Set.toList txInputs))) + , hang 2 (vsep ("collateral inputs:" : fmap pretty (Set.toList txCollateral))) + , hang 2 (vsep ("outputs:" : fmap pretty txOutputs)) + , "mint:" <+> pretty txMint + , "fee:" <+> pretty txFee + , hang 2 (vsep ("mps:": fmap pretty (Set.toList txMintScripts))) + , hang 2 (vsep ("signatures:": fmap (pretty . fst) (Map.toList txSignatures))) + , "validity range:" <+> viaShow txValidRange + , hang 2 (vsep ("data:": fmap (pretty . snd) (Map.toList txData) )) + ] + txid = txId t + in nest 2 $ vsep ["Tx" <+> pretty txid <> colon, braces (vsep lines')] + +-- | Compute the id of a transaction. +txId :: Tx -> TxId +-- Double hash of a transaction, excluding its witnesses. +txId tx = TxId $ BA.convert h' where + h :: Digest SHA256 + h = hash $ Write.toStrictByteString $ encode $ strip tx + h' :: Digest SHA256 + h' = hash h + +-- | Update a map of unspent transaction outputs and signatures based on the inputs +-- and outputs of a transaction. +updateUtxo :: Tx -> Map TxOutRef TxOut -> Map TxOutRef TxOut +updateUtxo tx unspent = (unspent `Map.withoutKeys` spentOutputs tx) `Map.union` unspentOutputsTx tx + +-- | A list of a transaction's outputs paired with a 'TxOutRef's referring to them. +txOutRefs :: Tx -> [(TxOut, TxOutRef)] +txOutRefs t = mkOut <$> zip [0..] (txOutputs t) where + mkOut (i, o) = (o, TxOutRef (txId t) i) + +-- | The unspent outputs of a transaction. +unspentOutputsTx :: Tx -> Map TxOutRef TxOut +unspentOutputsTx t = Map.fromList $ fmap f $ zip [0..] $ txOutputs t where + f (idx, o) = (TxOutRef (txId t) idx, o) + -- | Create a transaction output locked by a validator script hash -- with the given data script attached. scriptTxOut' :: Value -> Address -> Datum -> TxOut