diff --git a/cardano-api/ChangeLog.md b/cardano-api/ChangeLog.md index eb253c43daa..15f54116d54 100644 --- a/cardano-api/ChangeLog.md +++ b/cardano-api/ChangeLog.md @@ -6,6 +6,10 @@ - Append, not prepend change output when balancing a transaction ([PR 4343](https://github.com/input-output-hk/cardano-node/pull/4343)) +### Bugs + +- Allow reading text envelopes from pipes ([PR 4384](https://github.com/input-output-hk/cardano-node/pull/4384)) + ## 1.33.0 -- December 2021 ## 1.32.1 -- November 2021 diff --git a/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs b/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs index 1f78b3e2982..696873f9609 100644 --- a/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs +++ b/cardano-api/src/Cardano/Api/SerialiseTextEnvelope.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -5,6 +6,10 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} +#if !defined(mingw32_HOST_OS) +#define UNIX +#endif + -- | TextEnvelope Serialisation -- module Cardano.Api.SerialiseTextEnvelope @@ -36,7 +41,6 @@ import Prelude 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 @@ -49,20 +53,31 @@ import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.: import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) -import Control.Exception (bracketOnError) import Control.Monad (unless) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither) -import System.Directory (removeFile, renameFile) -import System.FilePath (splitFileName, (<.>)) -import System.IO (hClose, openTempFile) import Cardano.Binary (DecoderError) import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Cardano.Api.SerialiseCBOR +import Cardano.Api.Utils (readFileBlocking) + +#ifdef UNIX +import Control.Exception (IOException, bracket, bracketOnError, try) +import System.Directory () +import System.Posix.Files (ownerModes, setFdOwnerAndGroup) +import System.Posix.IO (OpenMode (..), closeFd, openFd, fdToHandle, defaultFileFlags) +import System.Posix.User (getRealUserID) +import System.IO (hClose) +#else +import Control.Exception (bracketOnError) +import System.Directory (removeFile, renameFile) +import System.FilePath (splitFileName, (<.>)) +import System.IO (hClose, openTempFile) +#endif -- ---------------------------------------------------------------------------- @@ -213,11 +228,36 @@ deserialiseFromTextEnvelopeAnyOf types te = matching (FromSomeType ttoken _f) = actualType == textEnvelopeType ttoken - writeFileWithOwnerPermissions :: FilePath -> LBS.ByteString -> IO (Either (FileError ()) ()) +#ifdef UNIX +-- On a unix based system, we grab a file descriptor and set ourselves as owner. +-- Since we're holding the file descriptor at this point, we can be sure that +-- what we're about to write to is owned by us if an error didn't occur. +writeFileWithOwnerPermissions path a = do + user <- getRealUserID + ownedFile <- try $ + -- We only close the FD on error here, otherwise we let it leak out, since + -- it will be immediately turned into a Handle (which will be closed when + -- the Handle is closed) + bracketOnError + (openFd path WriteOnly (Just ownerModes) defaultFileFlags) + closeFd + (\fd -> setFdOwnerAndGroup fd user (-1) >> pure fd) + case ownedFile of + Left (err :: IOException) -> do + pure $ Left $ FileIOError path err + Right fd -> do + bracket + (fdToHandle fd) + hClose + (\handle -> runExceptT $ handleIOExceptT (FileIOError path) $ LBS.hPut handle a) +#else +-- On something other than unix, we make a _new_ file, and since we created it, +-- we must own it. We then place it at the target location. Unfortunately this +-- won't work correctly with pseudo-files. writeFileWithOwnerPermissions targetPath a = bracketOnError (openTempFile targetDir $ targetFile <.> "tmp") @@ -231,6 +271,7 @@ writeFileWithOwnerPermissions targetPath a = return $ Right ()) where (targetDir, targetFile) = splitFileName targetPath +#endif writeFileTextEnvelope :: HasTextEnvelope a => FilePath @@ -260,14 +301,13 @@ textEnvelopeToJSON :: HasTextEnvelope a => Maybe TextEnvelopeDescr -> a -> LBS. textEnvelopeToJSON mbDescr a = encodePretty' textEnvelopeJSONConfig (serialiseToTextEnvelope mbDescr a) <> "\n" - readFileTextEnvelope :: HasTextEnvelope a => AsType a -> FilePath -> IO (Either (FileError TextEnvelopeError) a) readFileTextEnvelope ttoken path = runExceptT $ do - content <- handleIOExceptT (FileIOError path) $ BS.readFile path + content <- handleIOExceptT (FileIOError path) $ readFileBlocking path firstExceptT (FileError path) $ hoistEither $ do te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecodeStrict' content deserialiseFromTextEnvelope ttoken te @@ -278,7 +318,7 @@ readFileTextEnvelopeAnyOf :: [FromSomeType HasTextEnvelope b] -> IO (Either (FileError TextEnvelopeError) b) readFileTextEnvelopeAnyOf types path = runExceptT $ do - content <- handleIOExceptT (FileIOError path) $ BS.readFile path + content <- handleIOExceptT (FileIOError path) $ readFileBlocking path firstExceptT (FileError path) $ hoistEither $ do te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecodeStrict' content deserialiseFromTextEnvelopeAnyOf types te @@ -289,7 +329,7 @@ readTextEnvelopeFromFile :: FilePath readTextEnvelopeFromFile path = runExceptT $ do bs <- handleIOExceptT (FileIOError path) $ - BS.readFile path + readFileBlocking path firstExceptT (FileError path . TextEnvelopeAesonDecodeError) . hoistEither $ Aeson.eitherDecodeStrict' bs diff --git a/cardano-api/src/Cardano/Api/Utils.hs b/cardano-api/src/Cardano/Api/Utils.hs index 9c3c4e8cd23..77bd916482b 100644 --- a/cardano-api/src/Cardano/Api/Utils.hs +++ b/cardano-api/src/Cardano/Api/Utils.hs @@ -16,24 +16,30 @@ module Cardano.Api.Utils , noInlineMaybeToStrictMaybe , note , parseFilePath + , readFileBlocking , runParsecParser , writeSecrets ) where import Prelude +import Control.Exception (bracket) import Control.Monad (forM_) 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.Maybe.Strict import Data.Text (Text) import qualified Data.Text as Text +import GHC.IO.Handle.FD (openFileBlocking) import qualified Text.Parsec as Parsec import qualified Text.Parsec.String as Parsec import qualified Text.ParserCombinators.Parsec.Error as Parsec import Text.Printf (printf) import qualified Options.Applicative as Opt import System.FilePath (()) +import System.IO (IOMode (ReadMode), hClose) #ifdef UNIX import System.Posix.Files (ownerReadMode, setFileMode) #else @@ -96,3 +102,18 @@ writeSecrets outDir prefix suffix secretOp xs = #else setPermissions filename (emptyPermissions {readable = True}) #endif + +readFileBlocking :: FilePath -> IO BS.ByteString +readFileBlocking path = bracket + (openFileBlocking path ReadMode) + hClose + (\fp -> do + -- An arbitrary block size. + let blockSize = 4096 + let go acc = do + next <- BS.hGet fp blockSize + if BS.null next + then pure acc + else go (acc <> Builder.byteString next) + contents <- go mempty + pure $ LBS.toStrict $ Builder.toLazyByteString contents)