diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index e6c5566bfa0..de6e6dd6bad 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -488,6 +488,7 @@ module Cardano.Api ( -- single API. FromSomeTypeCDDL(..), readFileTextEnvelopeCddlAnyOf, + readFileOrPipeTextEnvelopeCddlAnyOf, writeTxFileTextEnvelopeCddl, writeTxWitnessFileTextEnvelopeCddl, serialiseTxLedgerCddl, @@ -500,6 +501,7 @@ module Cardano.Api ( FromSomeType(..), deserialiseFromTextEnvelopeAnyOf, readFileTextEnvelopeAnyOf, + readFileOrPipeTextEnvelopeAnyOf, -- * Errors Error(..), @@ -715,7 +717,12 @@ module Cardano.Api ( txInsExistInUTxO, notScriptLockedTxIns, textShow, - ) where + + FileOrPipe, + fileOrPipe, + fileOrPipePath, + readFileOrPipe, + ) where import Cardano.Api.Address import Cardano.Api.Block diff --git a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs index c25a26cd089..d9df8598358 100644 --- a/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/src/Cardano/Api/SerialiseLedgerCddl.hs @@ -15,6 +15,7 @@ module Cardano.Api.SerialiseLedgerCddl -- * Reading one of several transaction or -- key witness types , readFileTextEnvelopeCddlAnyOf + , readFileOrPipeTextEnvelopeCddlAnyOf , writeTxFileTextEnvelopeCddl , writeTxWitnessFileTextEnvelopeCddl @@ -24,6 +25,7 @@ module Cardano.Api.SerialiseLedgerCddl , deserialiseTxLedgerCddl , serialiseWitnessLedgerCddl , deserialiseWitnessLedgerCddl + ) where @@ -36,7 +38,6 @@ import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) import Data.Bifunctor (first) import Data.ByteString (ByteString) -import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Lazy as LBS import qualified Data.List as List @@ -52,6 +53,7 @@ import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.SerialiseCBOR import Cardano.Api.Tx +import Cardano.Api.Utils -- Why have we gone this route? The serialization format of `TxBody era` @@ -313,12 +315,34 @@ readFileTextEnvelopeCddlAnyOf types path = firstExceptT (FileError path) $ hoistEither $ do deserialiseFromTextEnvelopeCddlAnyOf types te +readFileOrPipeTextEnvelopeCddlAnyOf + :: [FromSomeTypeCDDL TextEnvelopeCddl b] + -> FileOrPipe + -> IO (Either (FileError TextEnvelopeCddlError) b) +readFileOrPipeTextEnvelopeCddlAnyOf types file = do + let path = fileOrPipePath file + runExceptT $ do + te <- newExceptT $ readTextEnvelopeCddlFromFileOrPipe file + firstExceptT (FileError path) $ hoistEither $ do + deserialiseFromTextEnvelopeCddlAnyOf types te + readTextEnvelopeCddlFromFile :: FilePath -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) readTextEnvelopeCddlFromFile path = runExceptT $ do bs <- handleIOExceptT (FileIOError path) $ - BS.readFile path + readFileBlocking path firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) . hoistEither $ Aeson.eitherDecodeStrict' bs + +readTextEnvelopeCddlFromFileOrPipe + :: FileOrPipe + -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) +readTextEnvelopeCddlFromFileOrPipe file = do + let path = fileOrPipePath file + runExceptT $ do + bs <- handleIOExceptT (FileIOError path) $ + readFileOrPipe file + firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) + . hoistEither $ Aeson.eitherDecode' bs diff --git a/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs b/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs index 696873f9609..7df13758a39 100644 --- a/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs +++ b/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs @@ -32,6 +32,7 @@ module Cardano.Api.SerialiseTextEnvelope , FromSomeType(..) , deserialiseFromTextEnvelopeAnyOf , readFileTextEnvelopeAnyOf + , readFileOrPipeTextEnvelopeAnyOf -- * Data family instances , AsType(..) @@ -63,7 +64,7 @@ import Cardano.Binary (DecoderError) import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.SerialiseCBOR -import Cardano.Api.Utils (readFileBlocking) +import Cardano.Api.Utils (FileOrPipe, fileOrPipePath, readFileOrPipe, readFileBlocking) #ifdef UNIX import Control.Exception (IOException, bracket, bracketOnError, try) @@ -323,6 +324,16 @@ readFileTextEnvelopeAnyOf types path = te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecodeStrict' content deserialiseFromTextEnvelopeAnyOf types te +readFileOrPipeTextEnvelopeAnyOf :: [FromSomeType HasTextEnvelope b] + -> FileOrPipe + -> IO (Either (FileError TextEnvelopeError) b) +readFileOrPipeTextEnvelopeAnyOf types file = do + let path = fileOrPipePath file + runExceptT $ do + content <- handleIOExceptT (FileIOError path) $ readFileOrPipe file + firstExceptT (FileError path) $ hoistEither $ do + te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecode' content + deserialiseFromTextEnvelopeAnyOf types te readTextEnvelopeFromFile :: FilePath -> IO (Either (FileError TextEnvelopeError) TextEnvelope) diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index ef4b0a77990..aa531b0a457 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -22,23 +22,29 @@ module Cardano.Api.Utils , runParsecParser , textShow , writeSecrets + + , FileOrPipe + , fileOrPipe + , fileOrPipePath + , readFileOrPipe ) where import Prelude import Control.Exception (bracket) -import Control.Monad (forM_) +import Control.Monad (forM_, unless) import qualified Data.Aeson.Types as Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LBS +import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Maybe.Strict import Data.Text (Text) import qualified Data.Text as Text import GHC.IO.Handle.FD (openFileBlocking) import qualified Options.Applicative as Opt import System.FilePath (()) -import System.IO (IOMode (ReadMode), hClose) +import System.IO (IOMode (ReadMode), hClose, hIsSeekable) import qualified Text.Parsec as Parsec import qualified Text.Parsec.String as Parsec import qualified Text.ParserCombinators.Parsec.Error as Parsec @@ -123,6 +129,42 @@ readFileBlocking path = bracket contents <- go mempty pure $ LBS.toStrict $ Builder.toLazyByteString contents) +-- | We need a type for handling files that may be actually be things like pipes +data FileOrPipe = FileOrPipe FilePath (IORef (Maybe LBS.ByteString)) + +instance Show FileOrPipe where + show (FileOrPipe fp _) = show fp + +fileOrPipe :: FilePath -> IO FileOrPipe +fileOrPipe fp = FileOrPipe fp <$> newIORef Nothing + +fileOrPipePath :: FileOrPipe -> FilePath +fileOrPipePath (FileOrPipe fp _) = fp + +readFileOrPipe :: FileOrPipe -> IO LBS.ByteString +readFileOrPipe (FileOrPipe fp cacheRef) = do + cached <- readIORef cacheRef + case cached of + Just dat -> pure dat + Nothing -> bracket + (openFileBlocking fp ReadMode) + hClose + (\handle -> do + -- An arbitrary block size. + let blockSize = 4096 + let go acc = do + next <- BS.hGet handle blockSize + if BS.null next + then pure acc + else go (acc <> Builder.byteString next) + contents <- go mempty + let dat = Builder.toLazyByteString contents + -- If our file is not seekable, it's likely a pipe, so we need to + -- save the result for subsequent calls + seekable <- hIsSeekable handle + unless seekable (writeIORef cacheRef (Just dat)) + pure dat) + textShow :: Show a => a -> Text textShow = Text.pack . show diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs index 87006408658..523141e7a52 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Read.hs @@ -447,11 +447,11 @@ deserialiseScriptInAnyLang bs = newtype CddlTx = CddlTx {unCddlTx :: InAnyCardanoEra Tx} deriving (Show, Eq) -readFileTx :: FilePath -> IO (Either CddlError (InAnyCardanoEra Tx)) -readFileTx fp = do - eAnyTx <- readFileInAnyCardanoEra AsTx fp +readFileTx :: FileOrPipe -> IO (Either CddlError (InAnyCardanoEra Tx)) +readFileTx file = do + eAnyTx <- readFileInAnyCardanoEra AsTx file case eAnyTx of - Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation e + Left e -> fmap unCddlTx <$> acceptTxCDDLSerialisation file e Right tx -> return $ Right tx -- IncompleteCddlFormattedTx is an CDDL formatted tx or partial tx @@ -463,11 +463,11 @@ data IncompleteTx = UnwitnessedCliFormattedTxBody (InAnyCardanoEra TxBody) | IncompleteCddlFormattedTx (InAnyCardanoEra Tx) -readFileTxBody :: FilePath -> IO (Either CddlError IncompleteTx) -readFileTxBody fp = do - eTxBody <- readFileInAnyCardanoEra AsTxBody fp +readFileTxBody :: FileOrPipe -> IO (Either CddlError IncompleteTx) +readFileTxBody file = do + eTxBody <- readFileInAnyCardanoEra AsTxBody file case eTxBody of - Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation e + Left e -> fmap (IncompleteCddlFormattedTx . unCddlTx) <$> acceptTxCDDLSerialisation file e Right txBody -> return $ Right $ UnwitnessedCliFormattedTxBody txBody data CddlError = CddlErrorTextEnv @@ -483,21 +483,22 @@ renderCddlError (CddlErrorTextEnv textEnvErr cddlErr) = renderCddlError (CddlIOError e) = Text.pack $ displayError e acceptTxCDDLSerialisation - :: FileError TextEnvelopeError + :: FileOrPipe + -> FileError TextEnvelopeError -> IO (Either CddlError CddlTx) -acceptTxCDDLSerialisation err = +acceptTxCDDLSerialisation file err = case err of - e@(FileError fp (TextEnvelopeDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx fp - e@(FileError fp (TextEnvelopeAesonDecodeError _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx fp - e@(FileError fp (TextEnvelopeTypeError _ _)) -> - first (CddlErrorTextEnv e) <$> readCddlTx fp + e@(FileError _ (TextEnvelopeDecodeError _)) -> + first (CddlErrorTextEnv e) <$> readCddlTx file + e@(FileError _ (TextEnvelopeAesonDecodeError _)) -> + first (CddlErrorTextEnv e) <$> readCddlTx file + e@(FileError _ (TextEnvelopeTypeError _ _)) -> + first (CddlErrorTextEnv e) <$> readCddlTx file e@FileErrorTempFile{} -> return . Left $ CddlIOError e e@FileIOError{} -> return . Left $ CddlIOError e -readCddlTx :: FilePath -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) -readCddlTx = readFileTextEnvelopeCddlAnyOf teTypes +readCddlTx :: FileOrPipe -> IO (Either (FileError TextEnvelopeCddlError) CddlTx) +readCddlTx = readFileOrPipeTextEnvelopeCddlAnyOf teTypes where teTypes = [ FromCDDLTx "Witnessed Tx ByronEra" CddlTx , FromCDDLTx "Witnessed Tx ShelleyEra" CddlTx @@ -520,7 +521,8 @@ newtype CddlWitness = CddlWitness { unCddlWitness :: InAnyCardanoEra KeyWitness} readFileTxKeyWitness :: FilePath -> IO (Either CddlWitnessError (InAnyCardanoEra KeyWitness)) readFileTxKeyWitness fp = do - eWitness <- readFileInAnyCardanoEra AsKeyWitness fp + file <- fileOrPipe fp + eWitness <- readFileInAnyCardanoEra AsKeyWitness file case eWitness of Left e -> fmap unCddlWitness <$> acceptKeyWitnessCDDLSerialisation e Right keyWit -> return $ Right keyWit @@ -726,10 +728,10 @@ readFileInAnyCardanoEra , HasTextEnvelope (thing BabbageEra) ) => (forall era. AsType era -> AsType (thing era)) - -> FilePath + -> FileOrPipe -> IO (Either (FileError TextEnvelopeError) (InAnyCardanoEra thing)) readFileInAnyCardanoEra asThing = - readFileTextEnvelopeAnyOf + readFileOrPipeTextEnvelopeAnyOf [ FromSomeType (asThing AsByronEra) (InAnyCardanoEra ByronEra) , FromSomeType (asThing AsShelleyEra) (InAnyCardanoEra ShelleyEra) , FromSomeType (asThing AsAllegraEra) (InAnyCardanoEra AllegraEra) diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs index 477406a2257..aebe6f1cc53 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs @@ -209,7 +209,7 @@ renderShelleyTxCmdError err = ShelleyTxCmdScriptWitnessError e -> renderScriptWitnessError e ShelleyTxCmdScriptDataError e -> renderScriptDataError e ShelleyTxCmdProtocolParamsError e -> renderProtocolParamsError e - ShelleyTxCmdCddlError _ -> error "TODO" + ShelleyTxCmdCddlError e -> error $ show $ renderCddlError e ShelleyTxCmdCddlWitnessError _ -> error "TODO" ShelleyTxCmdRequiredSignerError _ -> error "" -- Validation errors @@ -983,7 +983,8 @@ runTxSign txOrTxBody witSigningData mnw (TxFile outTxFile) = do let (sksByron, sksShelley) = partitionSomeWitnesses $ map categoriseSomeWitness sks case txOrTxBody of - (InputTxFile (TxFile inputTxFile)) -> do + (InputTxFile (TxFile inputTxFilePath)) -> do + inputTxFile <- liftIO $ fileOrPipe inputTxFilePath anyTx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx inputTxFile InAnyShelleyBasedEra _era tx <- @@ -1002,7 +1003,8 @@ runTxSign txOrTxBody witSigningData mnw (TxFile outTxFile) = do firstExceptT ShelleyTxCmdWriteFileError . newExceptT $ writeTxFileTextEnvelopeCddl outTxFile signedTx - (InputTxBodyFile (TxBodyFile txbodyFile)) -> do + (InputTxBodyFile (TxBodyFile txbodyFilePath)) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile @@ -1050,15 +1052,17 @@ runTxSubmit -> NetworkId -> FilePath -> ExceptT ShelleyTxCmdError IO () -runTxSubmit (AnyConsensusModeParams cModeParams) network txFile = do +runTxSubmit (AnyConsensusModeParams cModeParams) network txFilePath = do + SocketPath sockPath <- firstExceptT ShelleyTxCmdSocketEnvError $ newExceptT readEnvSocketPath + txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx txFile let cMode = AnyConsensusMode $ consensusModeOnly cModeParams eraInMode <- hoistMaybe - (ShelleyTxCmdEraConsensusModeMismatch (Just txFile) cMode (AnyCardanoEra era)) + (ShelleyTxCmdEraConsensusModeMismatch (Just txFilePath) cMode (AnyCardanoEra era)) (toEraInMode era $ consensusModeOnly cModeParams) let txInMode = TxInMode tx eraInMode localNodeConnInfo = LocalNodeConnectInfo @@ -1088,11 +1092,12 @@ runTxCalculateMinFee -> TxShelleyWitnessCount -> TxByronWitnessCount -> ExceptT ShelleyTxCmdError IO () -runTxCalculateMinFee (TxBodyFile txbodyFile) nw protocolParamsSourceSpec +runTxCalculateMinFee (TxBodyFile txbodyFilePath) nw protocolParamsSourceSpec (TxInCount nInputs) (TxOutCount nOutputs) (TxShelleyWitnessCount nShelleyKeyWitnesses) (TxByronWitnessCount nByronKeyWitnesses) = do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile pparams <- firstExceptT ShelleyTxCmdProtocolParamsError @@ -1235,7 +1240,8 @@ runTxGetTxId :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () runTxGetTxId txfile = do InAnyCardanoEra _era txbody <- case txfile of - InputTxBodyFile (TxBodyFile txbodyFile) -> do + InputTxBodyFile (TxBodyFile txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of @@ -1243,7 +1249,8 @@ runTxGetTxId txfile = do IncompleteCddlFormattedTx (InAnyCardanoEra era tx) -> return (InAnyCardanoEra era (getTxBody tx)) - InputTxFile (TxFile txFile) -> do + InputTxFile (TxFile txFilePath) -> do + txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx txFile return . InAnyCardanoEra era $ getTxBody tx @@ -1252,7 +1259,8 @@ runTxGetTxId txfile = do runTxView :: InputTxBodyOrTxFile -> ExceptT ShelleyTxCmdError IO () runTxView = \case - InputTxBodyFile (TxBodyFile txbodyFile) -> do + InputTxBodyFile (TxBodyFile txbodyFilePath) -> do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile InAnyCardanoEra era txbody <- @@ -1264,7 +1272,8 @@ runTxView = \case -- In the case of a transaction body, we can simply call makeSignedTransaction [] -- to get a transaction which allows us to reuse friendlyTxBS! liftIO $ BS.putStr $ friendlyTxBodyBS era txbody - InputTxFile (TxFile txFile) -> do + InputTxFile (TxFile txFilePath) -> do + txFile <- liftIO $ fileOrPipe txFilePath InAnyCardanoEra era tx <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTx txFile liftIO $ BS.putStr $ friendlyTxBS era tx @@ -1280,7 +1289,8 @@ runTxCreateWitness -> Maybe NetworkId -> OutputFile -> ExceptT ShelleyTxCmdError IO () -runTxCreateWitness (TxBodyFile txbodyFile) witSignData mbNw (OutputFile oFile) = do +runTxCreateWitness (TxBodyFile txbodyFilePath) witSignData mbNw (OutputFile oFile) = do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of @@ -1331,7 +1341,8 @@ runTxSignWitness -> [WitnessFile] -> OutputFile -> ExceptT ShelleyTxCmdError IO () -runTxSignWitness (TxBodyFile txbodyFile) witnessFiles (OutputFile oFp) = do +runTxSignWitness (TxBodyFile txbodyFilePath) witnessFiles (OutputFile oFp) = do + txbodyFile <- liftIO $ fileOrPipe txbodyFilePath unwitnessed <- firstExceptT ShelleyTxCmdCddlError . newExceptT $ readFileTxBody txbodyFile case unwitnessed of diff --git a/cardano-cli/test/Test/OptParse.hs b/cardano-cli/test/Test/OptParse.hs index 4a875e1e59b..9e18d8e7ae7 100644 --- a/cardano-cli/test/Test/OptParse.hs +++ b/cardano-cli/test/Test/OptParse.hs @@ -72,7 +72,9 @@ checkTxCddlFormat => FilePath -- ^ Reference/golden file -> FilePath -- ^ Newly created file -> m () -checkTxCddlFormat reference created = do +checkTxCddlFormat referencePath createdPath = do + reference <- liftIO $ fileOrPipe referencePath + created <- liftIO $ fileOrPipe createdPath r <- liftIO $ readCddlTx reference c <- liftIO $ readCddlTx created r H.=== c