Refactor

Author: gege251

src/BotPlutusInterface/CardanoCLI.hs

@@ -207,14 +207,17 @@ buildTx pabConf privKeys ownPkh buildMode tx =
   callCommand @w $ ShellArgs "cardano-cli" opts (const ())
   where
     ownAddr = Ledger.pubKeyHashAddress (Ledger.PaymentPubKeyHash ownPkh) Nothing
-    skeys = Map.filter (\case FromSKey _ -> True; FromVKey _ -> False) privKeys
     requiredSigners =
       concatMap
         ( \pubKey ->
             let pkh = Ledger.pubKeyHash pubKey
-             in if Map.member pkh skeys
-                  then ["--required-signer", signingKeyFilePath pabConf pkh]
-                  else ["--required-signer-hash", encodeByteString $ fromBuiltin $ getPubKeyHash pkh]
+             in case Map.lookup pkh privKeys of
+                  Just (FromSKey _) ->
+                    ["--required-signer", signingKeyFilePath pabConf pkh]
+                  Just (FromVKey _) ->
+                    ["--required-signer-hash", encodeByteString $ fromBuiltin $ getPubKeyHash pkh]
+                  Nothing ->
+                    []
         )
         (Map.keys (Ledger.txSignatures tx))
     opts =

src/BotPlutusInterface/Files.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE MultiWayIf #-}
 
 module BotPlutusInterface.Files (
   policyScriptFilePath,
@@ -55,9 +56,10 @@ import Data.ByteString.Lazy qualified as LazyByteString
 import Data.ByteString.Short qualified as ShortByteString
 import Data.Either.Combinators (mapLeft)
 import Data.Kind (Type)
+import Data.List (sortOn)
 import Data.Map (Map)
 import Data.Map qualified as Map
-import Data.Maybe (mapMaybe)
+import Data.Maybe (catMaybes, mapMaybe)
 import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Text qualified as Text
@@ -82,7 +84,7 @@ import Plutus.V1.Ledger.Api (
  )
 import PlutusTx (ToData, toData)
 import PlutusTx.Builtins (fromBuiltin)
-import System.FilePath (isExtensionOf)
+import System.FilePath (isExtensionOf, (</>))
 import Prelude
 
 -- | Filename of a minting policy script
@@ -176,15 +178,21 @@ readPrivateKeys ::
   Eff effs (Either Text (Map PubKeyHash DummyPrivKey))
 readPrivateKeys pabConf = do
   files <- listDirectory @w $ Text.unpack pabConf.pcSigningKeyFileDir
-  let vKeyFiles =
-        map (\filename -> Text.unpack pabConf.pcSigningKeyFileDir ++ "/" ++ filename) $
-          filter ("vkey" `isExtensionOf`) files
-  let sKeyFiles =
-        map (\filename -> Text.unpack pabConf.pcSigningKeyFileDir ++ "/" ++ filename) $
-          filter ("skey" `isExtensionOf`) files
-  privKeys <- mapM (readVerificationKey @w) vKeyFiles
-  privKeys' <- mapM (readSigningKey @w) sKeyFiles
-  pure $ toPrivKeyMap <$> sequence (privKeys <> privKeys')
+
+  privKeys <-
+    catMaybes
+      <$> mapM
+        ( \filename ->
+            let fullPath = Text.unpack pabConf.pcSigningKeyFileDir </> filename
+             in case filename of
+                  _
+                    | "vkey" `isExtensionOf` filename -> Just <$> readVerificationKey @w fullPath
+                    | "skey" `isExtensionOf` filename -> Just <$> readSigningKey @w fullPath
+                    | otherwise -> pure Nothing
+        )
+        files
+
+  pure $ toPrivKeyMap <$> sequence privKeys
   where
     toPrivKeyMap :: [DummyPrivKey] -> Map PubKeyHash DummyPrivKey
     toPrivKeyMap =
@@ -194,6 +202,11 @@ readPrivateKeys pabConf = do
              in Map.insert pkh pKey pKeyMap
         )
         Map.empty
+        . sortOn keyPriority
+
+    keyPriority :: DummyPrivKey -> Int
+    keyPriority (FromSKey _) = 1
+    keyPriority (FromVKey _) = 0
 
 data DummyPrivKey
   = FromSKey PrivateKey

src/BotPlutusInterface/PreBalance.hs

@@ -7,7 +7,7 @@ module BotPlutusInterface.PreBalance (
 
 import BotPlutusInterface.CardanoCLI qualified as CardanoCLI
 import BotPlutusInterface.Effects (PABEffect, createDirectoryIfMissing, printLog)
-import BotPlutusInterface.Files (DummyPrivKey (FromSKey, FromVKey))
+import BotPlutusInterface.Files (DummyPrivKey, unDummyPrivateKey)
 import BotPlutusInterface.Files qualified as Files
 import BotPlutusInterface.Types (LogLevel (Debug), PABConfig)
 import Cardano.Api.Shelley (Lovelace (Lovelace), ProtocolParameters (protocolParamUTxOCostPerWord))
@@ -267,8 +267,7 @@ addSignatories ownPkh privKeys pkhs tx =
   foldM
     ( \tx' pkh ->
         case Map.lookup pkh privKeys of
-          Just (FromSKey privKey) -> Right $ Tx.addSignature' privKey tx'
-          Just (FromVKey privKey) -> Right $ Tx.addSignature' privKey tx'
+          Just privKey -> Right $ Tx.addSignature' (unDummyPrivateKey privKey) tx'
           Nothing -> Left "Signing key not found."
     )
     tx

test/Spec/BotPlutusInterface/Contract.hs

@@ -56,10 +56,13 @@ import Spec.MockContract (
   pkh3',
   pkhAddr1,
   runContractPure,
+  signingKey1,
   tip,
+  toSigningKeyFile,
   toVerificationKeyFile,
   utxos,
   verificationKey1,
+  verificationKey3,
  )
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))
@@ -312,12 +315,18 @@ withoutSigning = do
         def
           & utxos .~ [(txOutRef, txOut)]
           & files
-            .~ Map.fromList [toVerificationKeyFile "./signing-keys" verificationKey1]
+            .~ Map.fromList
+              [ toSigningKeyFile "./signing-keys" signingKey1
+              , toVerificationKeyFile "./signing-keys" verificationKey1
+              , toVerificationKeyFile "./signing-keys" verificationKey3
+              ]
       inTxId = encodeByteString $ fromBuiltin $ TxId.getTxId $ Tx.txOutRefId txOutRef
 
       contract :: Contract Text (Endpoint "SendAda" ()) Text CardanoTx
       contract = do
-        let constraints = Constraints.mustPayToPubKey paymentPkh2 (Ada.lovelaceValueOf 1000)
+        let constraints =
+              Constraints.mustPayToPubKey paymentPkh2 (Ada.lovelaceValueOf 1000)
+                <> Constraints.mustBeSignedBy paymentPkh3
         submitTx constraints
 
   -- Building and siging the tx should include both signing keys
@@ -331,7 +340,8 @@ withoutSigning = do
           --tx-in ${inTxId}#0
           --tx-in-collateral ${inTxId}#0
           --tx-out ${addr2}+1000
-          --required-signer-hash ${pkh1'}
+          --required-signer ./signing-keys/signing-key-${pkh1'}.skey
+          --required-signer-hash ${pkh3'}
           --change-address ${addr1}
           --mainnet --protocol-params-file ./protocol.json --out-file ./txs/tx-${outTxId}.raw
           |]

test/Spec/MockContract.hs

@@ -85,7 +85,7 @@ import Data.Aeson qualified as JSON
 import Data.Aeson.Extras (encodeByteString)
 import Data.ByteString qualified as ByteString
 import Data.Default (Default (def))
-import Data.Either.Combinators (fromRight, mapLeft)
+import Data.Either.Combinators (mapLeft)
 import Data.Hex (hex)
 import Data.Kind (Type)
 import Data.List (isPrefixOf)
@@ -164,14 +164,14 @@ skeyToPubKey :: SigningKey PaymentKey -> PubKey
 skeyToPubKey =
   Ledger.toPublicKey
     . Files.unDummyPrivateKey
-    . fromRight (error "Impossible happened")
+    . either (error . Text.unpack) id
     . Files.skeyToDummyPrivKey
 
 vkeyToPubKey :: VerificationKey PaymentKey -> PubKey
 vkeyToPubKey =
   Ledger.toPublicKey
     . Files.unDummyPrivateKey
-    . fromRight (error "Impossible happened")
+    . either (error . Text.unpack) id
     . Files.vkeyToDummyPrivKey
 
 toSigningKeyFile :: FilePath -> SigningKey PaymentKey -> (FilePath, MockFile)