Handle pipes

Fixes #4235

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

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

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)

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
 

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)