diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs new file mode 100644 index 0000000000..bb984ee7c7 --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + +module Cardano.CLI.EraBased.Script.Certificate.Read + ( readCertificateScriptWitness + , readCertificateScriptWitnesses + ) +where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.CLI.EraBased.Script.Certificate.Types +import Cardano.CLI.EraBased.Script.Types +import Cardano.CLI.Read +import Cardano.CLI.Types.Common + +import Control.Monad + +readCertificateScriptWitnesses + :: MonadIOTransError (FileError CliScriptWitnessError) t m + => ShelleyBasedEra era + -> [(CertificateFile, Maybe CliCertificateScriptRequirements)] + -> t m [(CertificateFile, Maybe (CertificateScriptWitness era))] +readCertificateScriptWitnesses sbe = + mapM + ( \(certFile, mSWit) -> do + (certFile,) <$> forM mSWit (readCertificateScriptWitness sbe) + ) + +readCertificateScriptWitness + :: MonadIOTransError (FileError CliScriptWitnessError) t m + => ShelleyBasedEra era -> CliCertificateScriptRequirements -> t m (CertificateScriptWitness era) +readCertificateScriptWitness sbe certScriptReq = + case certScriptReq of + OnDiskSimpleScript scriptFp -> do + let sFp = unFile scriptFp + s <- + modifyError (fmap SimpleScriptWitnessDecodeError) $ + readFileSimpleScript sFp + case s of + SimpleScript ss -> do + return $ + CertificateScriptWitness $ + SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ + SScript ss + OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits) -> do + let plutusScriptFp = unFile scriptFp + plutusScript <- + modifyError (fmap PlutusScriptWitnessDecodeError) $ + readFilePlutusScript plutusScriptFp + redeemer <- + modifyError (FileError plutusScriptFp . PlutusScriptWitnessRedeemerError) $ + readScriptDataOrFile redeemerFile + case plutusScript of + AnyPlutusScript lang script -> do + let pScript = PScript script + sLangSupported <- + modifyError (FileError plutusScriptFp) + $ hoistMaybe + ( PlutusScriptWitnessLanguageNotSupportedInEra + (AnyPlutusScriptVersion lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ PlutusScriptLanguage lang + return $ + CertificateScriptWitness $ + PlutusScriptWitness + sLangSupported + lang + pScript + NoScriptDatumForStake + redeemer + execUnits + OnDiskPlutusRefScript (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion redeemerFile execUnits) -> do + case anyPlutusScriptVersion of + AnyPlutusScriptVersion lang -> do + let pScript = PReferenceScript refTxIn + redeemer <- + -- TODO: Implement a new error type to capture this. FileError is not representative of cases + -- where we do not have access to the script. + modifyError + ( FileError "Reference script filepath not available" + . PlutusScriptWitnessRedeemerError + ) + $ readScriptDataOrFile redeemerFile + sLangSupported <- + -- TODO: Implement a new error type to capture this. FileError is not representative of cases + -- where we do not have access to the script. + modifyError (FileError "Reference script filepath not available") + $ hoistMaybe + ( PlutusScriptWitnessLanguageNotSupportedInEra + (AnyPlutusScriptVersion lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ PlutusScriptLanguage lang + + return $ + CertificateScriptWitness $ + PlutusScriptWitness + sLangSupported + lang + pScript + NoScriptDatumForStake + redeemer + execUnits