Moved functions using cryptonite from plutus-ledger to plutus-ledger-api

IntersectMBO · Jul 27, 2021 · 285deef · 285deef
1 parent 841d04b
commit 285deef
Show file tree

Hide file tree

Showing 8 changed files with 105 additions and 86 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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