more wip

IntersectMBO · Nov 6, 2024 · 6e49c78 · 6e49c78
1 parent c461679
commit 6e49c78
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 16 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -1516,7 +1516,7 @@ pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUni
             AutoBalance -> pure (ExecutionUnits 0 0)
             ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
         )
-    <*> pure Nothing
+    <*> pure NoPolicyIdSource
 
 pPlutusStakeReferenceScriptWitnessFiles
   :: String
@@ -1533,7 +1533,7 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits =
             AutoBalance -> pure (ExecutionUnits 0 0)
             ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in"
         )
-    <*> pure Nothing
+    <*> pure NoPolicyIdSource
 
 pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage
 pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3"
@@ -1922,7 +1922,7 @@ pTxIn sbe balance =
       -> ScriptWitnessFiles WitCtxTxIn
     createSimpleReferenceScriptWitnessFiles refTxIn =
       let simpleLang = AnyScriptLanguage SimpleScriptLanguage
-       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing
+       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang NoPolicyIdSource
 
   pPlutusReferenceScriptWitness
     :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn)
@@ -1960,7 +1960,7 @@ pTxIn sbe balance =
       -> ExecutionUnits
       -> ScriptWitnessFiles WitCtxTxIn
     createPlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits =
-      PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits Nothing
+      PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits NoPolicyIdSource
 
   pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn)
   pEmbeddedPlutusScriptWitness =
@@ -2170,7 +2170,7 @@ pMintMultiAsset sbe balanceExecUnits =
       -> ScriptWitnessFiles WitCtxMint
     createSimpleMintingReferenceScriptWitnessFiles refTxIn pid =
       let simpleLang = AnyScriptLanguage SimpleScriptLanguage
-       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (Just pid)
+       in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (ConcretePolicyId pid)
 
   pPlutusMintReferenceScriptWitnessFiles
     :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint)
@@ -2184,7 +2184,7 @@ pMintMultiAsset sbe balanceExecUnits =
               AutoBalance -> pure (ExecutionUnits 0 0)
               ManualBalance -> pExecutionUnits "mint-reference-tx-in"
           )
-      <*> (Just <$> pPolicyId)
+      <*> (ConcretePolicyId <$> pPolicyId)
 
   helpText =
     mconcat

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -73,6 +73,7 @@ import qualified Data.List as List
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
+import           Data.Proxy
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import qualified Data.Text as Text
@@ -1396,12 +1397,21 @@ scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) =
 
 readValueScriptWitnesses
   :: ShelleyBasedEra era
-  -> (Value, [ScriptWitnessFiles WitCtxMint])
-  -> ExceptT TxCmdError IO (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)])
+  -> (a, [ScriptWitnessFiles WitCtxMint])
+  -> ExceptT
+      TxCmdError
+      IO
+      (a, [(Maybe (MintingPolicyIdSource OnlineCommand WitCtxMint), ScriptWitness WitCtxMint era)])
 readValueScriptWitnesses era (v, sWitFiles) = do
   sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles
   return (v, sWits)
 
+getpid = undefined :: ScriptWitness WitCtxMint era -> PolicyId
+
+setpid = undefined :: PolicyId -> ScriptWitness WitCtxMint era -> ScriptWitness WitCtxMint era
+
+foo = Proxy @SimpleScriptWitness
+
 -- ----------------------------------------------------------------------------
 -- Transaction signing
 --

diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs
@@ -290,7 +290,10 @@ readScriptWitnessFilesTuple era = mapM readSwitFile
 readScriptWitness
   :: ShelleyBasedEra era
   -> ScriptWitnessFiles witctx
-  -> ExceptT ScriptWitnessError IO (Maybe PolicyId, ScriptWitness witctx era)
+  -> ExceptT
+      ScriptWitnessError
+      IO
+      (Maybe (MintingPolicyIdSource OnlineCommand witctx), ScriptWitness witctx era)
 readScriptWitness era (SimpleScriptWitnessFile (File scriptFile)) = do
   script@(ScriptInAnyLang lang _) <-
     firstExceptT ScriptWitnessErrorFile $
@@ -352,7 +355,7 @@ readScriptWitness
       datumOrFile
       redeemerOrFile
       execUnits
-      mPid
+      pid
     ) = do
     caseShelleyToAlonzoOrBabbageEraOnwards
       ( const $
@@ -375,7 +378,7 @@ readScriptWitness
                   redeemer <-
                     firstExceptT ScriptWitnessErrorScriptData $
                       readScriptRedeemerOrFile redeemerOrFile
-                  return . (mPid,) $
+                  return . (Just pid,) $
                     PlutusScriptWitness
                       sLangInEra
                       version
@@ -406,7 +409,7 @@ readScriptWitness
             Just sLangInEra ->
               case languageOfScriptLanguageInEra sLangInEra of
                 SimpleScriptLanguage ->
-                  return . (mPid,) . SimpleScriptWitness sLangInEra $
+                  return . (Just mPid,) . SimpleScriptWitness sLangInEra $
                     SReferenceScript refTxIn
                 PlutusScriptLanguage{} ->
                   error "readScriptWitness: Should not be possible to specify a plutus script"

diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs
@@ -2,8 +2,10 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeOperators #-}
 
 module Cardano.CLI.Types.Common
   ( AllOrOnly (..)
@@ -58,6 +60,8 @@ module Cardano.CLI.Types.Common
   , ScriptFile
   , ScriptRedeemerOrFile
   , ScriptWitnessFiles (..)
+  , MintingPolicyIdSource (..)
+  , IsOnlineCommand (..)
   , SigningKeyFile
   , SlotsTillKesKeyExpiry (..)
   , SomeKeyFile (..)
@@ -101,6 +105,7 @@ import qualified Data.Aeson as Aeson
 import           Data.String (IsString)
 import           Data.Text (Text)
 import qualified Data.Text as Text
+import           Data.Type.Equality (type (==))
 import           Data.Word (Word64)
 
 -- | Determines the direction in which the MIR certificate will transfer ADA.
@@ -417,18 +422,28 @@ data ScriptWitnessFiles witctx where
     -> ScriptDatumOrFile witctx
     -> ScriptRedeemerOrFile
     -> ExecutionUnits
-    -> Maybe PolicyId
-    -- ^ For minting reference scripts
+    -> MintingPolicyIdSource OnlineCommand witctx
     -> ScriptWitnessFiles witctx
   SimpleReferenceScriptWitnessFiles
     :: TxIn
     -> AnyScriptLanguage
-    -> Maybe PolicyId
-    -- ^ For minting reference scripts
+    -> MintingPolicyIdSource OnlineCommand witctx
     -> ScriptWitnessFiles witctx
 
 deriving instance Show (ScriptWitnessFiles witctx)
 
+data IsOnlineCommand = OnlineCommand | OfflineCommand
+
+data MintingPolicyIdSource (o :: IsOnlineCommand) witctx where
+  -- | A concrete policy Id
+  ConcretePolicyId :: PolicyId -> MintingPolicyIdSource o WitCtxMint
+  -- | Query policy Id from the UTxO set, only for an online command
+  QueryUtxoPolicyId :: TxIn -> MintingPolicyIdSource OnlineCommand WitCtxMint
+  -- | No policy Id is provided for nonminting contexts
+  NoPolicyIdSource :: (witctx == WitCtxMint) ~ False => MintingPolicyIdSource o witctx
+
+deriving instance Show (MintingPolicyIdSource o witctx)
+
 data ScriptDatumOrFile witctx where
   ScriptDatumOrFileForTxIn
     :: Maybe ScriptDataOrFile -- CIP-0069 - Spending datums optional in Conway era onwards