Merge branch 'develop' into rory/fix-overlay-again

CHANGELOG.md

@@ -46,11 +46,16 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)
 - `Contract.Chain.waitNSlots`,  `Contract.Chain.currentSlot` and `Contract.Chain.currentTime` a function to wait at least `N` number of slots and functions to get the current time in `Slot` or `POSIXTime`. ([#740](https://github.com/Plutonomicon/cardano-transaction-lib/issues/740))
 - `Contract.Transaction.getTxByHash` to retrieve contents of an on-chain transaction.
 - `project.launchSearchablePursDocs` to create an `apps` output for serving Pursuit documentation locally ([#816](https://github.com/Plutonomicon/cardano-transaction-lib/issues/816))
+- `KeyWallet.MintsAndSendsToken` example ([#802](https://github.com/Plutonomicon/cardano-transaction-lib/pull/802))
 - `Contract.PlutusData.IsData` type class (`ToData` + `FromData`) ([#809](https://github.com/Plutonomicon/cardano-transaction-lib/pull/809))
 - A check for port availability before Plutip runtime initialization attempt ([#837](https://github.com/Plutonomicon/cardano-transaction-lib/issues/837))
 - `Contract.Address.addressToBech32` and `Contract.Address.addressWithNetworkTagToBech32` ([#846](https://github.com/Plutonomicon/cardano-transaction-lib/issues/846))
 - `doc/e2e-testing.md` describes the process of E2E testing. ([#814](https://github.com/Plutonomicon/cardano-transaction-lib/pull/814))
 - Added unzip to the `devShell`. New `purescriptProject.shell` flag `withChromium` also optionally adds Chromium to the `devShell` ([#799](https://github.com/Plutonomicon/cardano-transaction-lib/pull/799))
+- Added paymentKey and stakeKey fields to the record in KeyWallet
+- Added `formatPaymentKey` and `formatStakeKey` to `Wallet.KeyFile` and `Contract.Wallet` for formatting private keys
+- Added `privatePaymentKeyToFile` and `privateStakeKeyToFile` to `Wallet.KeyFile` and `Contract.Wallet.KeyFile` for writing keys to files
+- Added `bytesFromPrivateKey` to `Serialization`
 
 ### Changed
 
@@ -79,6 +84,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)
 - Endless `awaitTxConfirmed` calls ([#804](https://github.com/Plutonomicon/cardano-transaction-lib/issues/804))
 - Bug with collateral selection: only the first UTxO provided by wallet was included as collateral [(#723)](https://github.com/Plutonomicon/cardano-transaction-lib/issues/723)
 - Bug with collateral selection for `KeyWallet` when signing multiple transactions ([#709](https://github.com/Plutonomicon/cardano-transaction-lib/pull/709))
+- Bug when zero-valued non-Ada assets were added to the non-Ada change output ([#802](https://github.com/Plutonomicon/cardano-transaction-lib/pull/802))
 - Properly implemented CIP-25 V2 metadata. Now there's no need to split arbitrary-length strings manually to fit them in 64 PlutusData bytes (CTL handles that). A new `Cip25String` type has been introduced (a smart constructor ensures that byte representation fits 64 bytes, as required by the spec). Additionally, a new `Metadata.Cip25.Common.Cip25TokenName` wrapper over `TokenName` is added to ensure proper encoding of `asset_name`s. There are still some minor differences from the spec:
 
 -- We do not split strings in pieces when encoding to JSON

examples/KeyWallet/MintsAndSendsToken.purs

@@ -0,0 +1,44 @@
+-- | This module demonstrates how the `Contract` interface can be used to build,
+-- | balance, and submit a smart-contract transaction. It creates a transaction
+-- | that mints a token using the `AlwaysMints` policy and sends it along with
+-- | the selected amount to the specified address.
+module Examples.KeyWallet.MintsAndSendsToken (main) where
+
+import Contract.Prelude
+
+import Contract.Log (logInfo')
+import Contract.Monad (liftContractAffM, liftContractM, liftedE, liftedM)
+import Contract.Prim.ByteArray (byteArrayFromAscii)
+import Contract.ScriptLookups as Lookups
+import Contract.Transaction (balanceAndSignTx, submit)
+import Contract.TxConstraints as Constraints
+import Contract.Value as Value
+import Examples.AlwaysMints (alwaysMintsPolicy)
+import Examples.KeyWallet.Internal.Pkh2PkhContract (runKeyWalletContract_)
+
+main :: Effect Unit
+main = runKeyWalletContract_ \pkh lovelace unlock -> do
+  logInfo' "Running Examples.KeyWallet.MintsAndSendsToken"
+
+  mp <- alwaysMintsPolicy
+  cs <- liftContractAffM "Cannot get cs" $ Value.scriptCurrencySymbol mp
+  tn <- liftContractM "Cannot make token name"
+    $ Value.mkTokenName
+    =<< byteArrayFromAscii "TheToken"
+
+  let
+    constraints :: Constraints.TxConstraints Void Void
+    constraints = mconcat
+      [ Constraints.mustMintValue (Value.singleton cs tn one)
+      , Constraints.mustPayToPubKey pkh
+          (Value.lovelaceValueOf lovelace <> Value.singleton cs tn one)
+      ]
+
+    lookups :: Lookups.ScriptLookups Void
+    lookups = Lookups.mintingPolicy mp
+
+  ubTx <- liftedE $ Lookups.mkUnbalancedTx lookups constraints
+  bsTx <- liftedM "Failed to balance/sign tx" $ balanceAndSignTx ubTx
+  txId <- submit bsTx
+  logInfo' $ "Tx ID: " <> show txId
+  liftEffect unlock

src/BalanceTx/BalanceTx.purs

@@ -986,10 +986,10 @@ balanceNonAdaOuts' changeAddr utxos txBody'@(TxBody txBody) = do
             TransactionOutput
               txOut { amount = v <> nonAdaChange } : txOuts <> txOuts'
 
+  if isZero nonAdaChange then pure $ wrap txBody
   -- Original code uses "isNat" because there is a guard against zero, see
   -- isPos for more detail.
-  if isPos nonAdaChange then pure $ wrap txBody { outputs = outputs }
-  else if isZero nonAdaChange then pure $ wrap txBody
+  else if isPos nonAdaChange then pure $ wrap txBody { outputs = outputs }
   else Left InputsCannotBalanceNonAdaTokens
 
 getAmount :: TransactionOutput -> Value

src/Cardano/Types/Value.purs

@@ -1,14 +1,15 @@
 module Cardano.Types.Value
   ( Coin(Coin)
   , CurrencySymbol
-  , NonAdaAsset(NonAdaAsset)
+  , NonAdaAsset
   , Value(Value)
   , class Negate
   , class Split
   , coinToValue
   , currencyMPSHash
   , eq
   , filterNonAda
+  , flattenNonAdaValue
   , geq
   , getCurrencySymbol
   , getLovelace
@@ -42,6 +43,7 @@ module Cardano.Types.Value
   , scriptHashAsCurrencySymbol
   , unionWith
   , unionWithNonAda
+  , unwrapNonAdaAsset
   , valueOf
   , valueToCoin
   , valueToCoin'
@@ -235,7 +237,6 @@ mkUnsafeAdaSymbol byteArr =
 
 newtype NonAdaAsset = NonAdaAsset (Map CurrencySymbol (Map TokenName BigInt))
 
-derive instance Newtype NonAdaAsset _
 derive newtype instance Eq NonAdaAsset
 
 instance Show NonAdaAsset where
@@ -254,7 +255,7 @@ instance MeetSemilattice NonAdaAsset where
   meet = unionWithNonAda min
 
 instance Negate NonAdaAsset where
-  negation = wrap <<< map (map negate) <<< unwrap
+  negation = NonAdaAsset <<< map (map negate) <<< unwrapNonAdaAsset
 
 instance Split NonAdaAsset where
   split (NonAdaAsset mp) = NonAdaAsset npos /\ NonAdaAsset pos
@@ -272,6 +273,9 @@ instance Split NonAdaAsset where
 instance EncodeAeson NonAdaAsset where
   encodeAeson' (NonAdaAsset m) = encodeAeson' $ encodeMap $ encodeMap <$> m
 
+unwrapNonAdaAsset :: NonAdaAsset -> Map CurrencySymbol (Map TokenName BigInt)
+unwrapNonAdaAsset (NonAdaAsset mp) = mp
+
 -- We shouldn't need this check if we don't export unsafeAdaSymbol etc.
 -- | Create a singleton `NonAdaAsset` which by definition should be safe since
 -- | `CurrencySymbol` and `TokenName` are safe
@@ -280,15 +284,16 @@ mkSingletonNonAdaAsset
   -> TokenName
   -> BigInt
   -> NonAdaAsset
-mkSingletonNonAdaAsset curSymbol tokenName amount =
-  NonAdaAsset $ Map.singleton curSymbol $ Map.singleton tokenName amount
+mkSingletonNonAdaAsset curSymbol tokenName amount
+  | amount == zero = mempty
+  | otherwise =
+      NonAdaAsset $ Map.singleton curSymbol $ Map.singleton tokenName amount
 
 -- Assume all CurrencySymbol are well-formed at this point, since they come from
 -- mkCurrencySymbol and mkTokenName.
--- | Given the relevant map, create a `NonAdaAsset`. The map should be constructed
--- | safely by definition
+-- | Given the relevant map, create a normalized `NonAdaAsset`.
 mkNonAdaAsset :: Map CurrencySymbol (Map TokenName BigInt) -> NonAdaAsset
-mkNonAdaAsset = NonAdaAsset
+mkNonAdaAsset = normalizeNonAdaAsset <<< NonAdaAsset
 
 mkNonAdaAssetsFromTokenMap'
   :: forall (t :: Type -> Type)
@@ -405,6 +410,12 @@ mkSingletonValue' curSymbol tokenName amount = do
 --------------------------------------------------------------------------------
 -- Helpers
 --------------------------------------------------------------------------------
+
+-- | Normalize `NonAdaAsset` so that it doesn't contain zero-valued tokens.
+normalizeNonAdaAsset :: NonAdaAsset -> NonAdaAsset
+normalizeNonAdaAsset (NonAdaAsset mp) =
+  NonAdaAsset $ Map.filter (not Map.isEmpty) $ Map.filter (notEq zero) <$> mp
+
 -- https://playground.plutus.iohkdev.io/doc/haddock/plutus-tx/html/src/PlutusTx.AssocMap.html#union
 -- | Combine two `Map`s.
 union :: ∀ k v r. Ord k => Map k v -> Map k r -> Map k (These v r)
@@ -455,7 +466,7 @@ unionNonAda (NonAdaAsset l) (NonAdaAsset r) =
   in
     unBoth <$> combined
 
--- Don't export to `Contract` due to https://github.com/Plutonomicon/cardano-transaction-lib/issues/193
+-- https://playground.plutus.iohkdev.io/doc/haddock/plutus-ledger-api/html/src/Plutus.V1.Ledger.Value.html#unionWith
 -- | Same as `unionWith` but specifically for `NonAdaAsset`
 unionWithNonAda
   :: (BigInt -> BigInt -> BigInt)
@@ -473,7 +484,8 @@ unionWithNonAda f ls rs =
       That b -> f zero b
       Both a b -> f a b
   in
-    NonAdaAsset $ map unBoth <$> combined
+    normalizeNonAdaAsset $
+      NonAdaAsset (map unBoth <$> combined)
 
 -- https://playground.plutus.iohkdev.io/doc/haddock/plutus-ledger-api/html/src/Plutus.V1.Ledger.Value.html#unionWith
 -- | Combines `Value` with a binary function on `BigInt`s.
@@ -521,7 +533,6 @@ isAdaOnly v =
         tn == adaToken
     _ -> false
 
--- From https://github.com/mlabs-haskell/bot-plutus-interface/blob/master/src/BotPlutusInterface/PreBalance.hs
 minus :: Value -> Value -> Maybe Value
 minus x y = do
   let

src/Contract/Wallet.purs

@@ -7,6 +7,7 @@ module Contract.Wallet
   , module Wallet.Spec
   , module Wallet.Key
   , module Wallet
+  , module Wallet.KeyFile
   ) where
 
 import Prelude
@@ -30,6 +31,7 @@ import Wallet.Spec
   )
 import Wallet.Key (KeyWallet, privateKeysToKeyWallet) as Wallet
 import Wallet.Key (PrivatePaymentKey, PrivateStakeKey)
+import Wallet.KeyFile (formatPaymentKey, formatStakeKey)
 
 withKeyWallet
   :: forall (r :: Row Type) (a :: Type)

src/Contract/Wallet/KeyFile.purs

@@ -1,6 +1,7 @@
 -- | Node-only module. Allows to work with Skeys stored in files.
 module Contract.Wallet.KeyFile
   ( mkKeyWalletFromFiles
+  , module Wallet.KeyFile
   ) where
 
 import Prelude
@@ -11,7 +12,12 @@ import Effect.Aff (Aff)
 import Node.Path (FilePath)
 import Wallet (Wallet) as Wallet
 import Wallet (mkKeyWallet)
-import Wallet.KeyFile (privatePaymentKeyFromFile, privateStakeKeyFromFile)
+import Wallet.KeyFile
+  ( privatePaymentKeyFromFile
+  , privateStakeKeyFromFile
+  , privatePaymentKeyToFile
+  , privateStakeKeyToFile
+  )
 
 -- | Load `PrivateKey`s from `skey` files (the files should be in JSON format as
 -- | accepted by cardano-cli).

src/Deserialization/Transaction.purs

@@ -107,7 +107,7 @@ import Cardano.Types.Transaction
   ) as T
 import Cardano.Types.Value
   ( Coin(Coin)
-  , NonAdaAsset(NonAdaAsset)
+  , mkNonAdaAsset
   , scriptHashAsCurrencySymbol
   )
 import Control.Lazy (fix)
@@ -432,7 +432,7 @@ convertPoolRetirement poolKeyhash epochInt = do
   pure $ T.PoolRetirement { poolKeyhash, epoch }
 
 convertMint :: Csl.Mint -> T.Mint
-convertMint mint = T.Mint $ NonAdaAsset
+convertMint mint = T.Mint $ mkNonAdaAsset
   $
     -- outer map
     M.fromFoldable <<< map (lmap scriptHashAsCurrencySymbol)

src/Plutus/Conversion/Value.purs

@@ -5,9 +5,10 @@ module Plutus.Conversion.Value
 
 import Prelude
 
-import Data.Array (concatMap, head, partition)
+import Data.Array (head, partition)
 import Data.Foldable (fold)
-import Data.Map (fromFoldable, toUnfoldable) as Map
+import Data.List (List)
+import Data.Map (fromFoldable) as Map
 import Data.Maybe (fromMaybe, fromJust)
 import Data.Newtype (wrap, unwrap)
 import Data.Tuple (snd)
@@ -16,7 +17,8 @@ import Partial.Unsafe (unsafePartial)
 
 import Cardano.Types.Value (Coin(Coin), Value(Value)) as Types
 import Cardano.Types.Value
-  ( NonAdaAsset(NonAdaAsset)
+  ( NonAdaAsset
+  , flattenNonAdaValue
   , getCurrencySymbol
   , mkValue
   , mkNonAdaAssetsFromTokenMap
@@ -67,19 +69,16 @@ fromPlutusValue plutusValue =
 --------------------------------------------------------------------------------
 
 toPlutusValue :: Types.Value -> Plutus.Value
-toPlutusValue (Types.Value (Types.Coin adaAmount) (NonAdaAsset nonAdaAssets)) =
+toPlutusValue (Types.Value (Types.Coin adaAmount) nonAdaAssets) =
   adaValue <> fold nonAdaValues
   where
   adaValue :: Plutus.Value
   adaValue
     | adaAmount == zero = mempty
     | otherwise = Plutus.Value.lovelaceValueOf adaAmount
 
-  nonAdaValues :: Array Plutus.Value
+  nonAdaValues :: List Plutus.Value
   nonAdaValues =
-    flip concatMap (Map.toUnfoldable nonAdaAssets) $ \(cs /\ tokens) ->
-      Map.toUnfoldable tokens <#> \(tn /\ val) ->
-        unsafePartial $ fromJust $
-          Plutus.Value.singleton' (getCurrencySymbol cs)
-            (getTokenName tn)
-            val
+    flattenNonAdaValue nonAdaAssets <#> \(cs /\ tn /\ val) ->
+      unsafePartial fromJust $
+        Plutus.Value.singleton' (getCurrencySymbol cs) (getTokenName tn) val

src/QueryM/Ogmios.purs

@@ -74,6 +74,7 @@ import Cardano.Types.Value
   , CurrencySymbol
   , Value
   , mkCurrencySymbol
+  , mkNonAdaAsset
   , mkValue
   )
 import Control.Alt ((<|>))
@@ -1133,7 +1134,7 @@ parseValue outer = do
     <|> Left (TypeMismatch "Expected 'coins' to be an Int or a BigInt")
   Assets assetsMap <- fromMaybe (Assets Map.empty)
     <$> getFieldOptional o "assets"
-  pure $ mkValue (wrap coins) (wrap assetsMap)
+  pure $ mkValue (wrap coins) (mkNonAdaAsset assetsMap)
 
 newtype Assets = Assets (Map CurrencySymbol (Map TokenName BigInt))
 

src/Serialization.js

@@ -102,6 +102,14 @@ exports._privateKeyFromBytes = maybe => bytes => {
   }
 };
 
+exports._bytesFromPrivateKey = maybe => key => {
+  try {
+    return maybe.just(key.as_bytes());
+  } catch (err) {
+    return maybe.nothing;
+  }
+};
+
 exports.publicKeyHash = pk => pk.hash();
 
 exports.newEd25519Signature = bech32 => () =>

src/Serialization.purs

@@ -1,5 +1,6 @@
 module Serialization
-  ( convertTransaction
+  ( bytesFromPrivateKey
+  , convertTransaction
   , convertTxBody
   , convertTxInput
   , convertTxOutput
@@ -217,6 +218,9 @@ foreign import publicKeyFromPrivateKey
 foreign import _privateKeyFromBytes
   :: MaybeFfiHelper -> RawBytes -> Maybe PrivateKey
 
+foreign import _bytesFromPrivateKey
+  :: MaybeFfiHelper -> PrivateKey -> Maybe RawBytes
+
 foreign import publicKeyHash :: PublicKey -> Ed25519KeyHash
 foreign import newEd25519Signature :: Bech32String -> Effect Ed25519Signature
 foreign import transactionWitnessSetSetVkeys
@@ -592,6 +596,9 @@ publicKeyFromBech32 = _publicKeyFromBech32 maybeFfiHelper
 privateKeyFromBytes :: RawBytes -> Maybe PrivateKey
 privateKeyFromBytes = _privateKeyFromBytes maybeFfiHelper
 
+bytesFromPrivateKey :: PrivateKey -> Maybe RawBytes
+bytesFromPrivateKey = _bytesFromPrivateKey maybeFfiHelper
+
 convertCerts :: Array T.Certificate -> Effect Certificates
 convertCerts certs = do
   certificates <- newCertificates
@@ -678,7 +685,8 @@ convertNetworkId = case _ of
   T.MainnetId -> networkIdMainnet
 
 convertMint :: T.Mint -> Effect Mint
-convertMint (T.Mint (Value.NonAdaAsset m)) = do
+convertMint (T.Mint nonAdaAssets) = do
+  let m = Value.unwrapNonAdaAsset nonAdaAssets
   mint <- newMint
   forWithIndex_ m \scriptHashBytes' values -> do
     let