diff --git a/cardano-api/internal/Cardano/Api/Error.hs b/cardano-api/internal/Cardano/Api/Error.hs index 437ad14c4e..1b4c77238c 100644 --- a/cardano-api/internal/Cardano/Api/Error.hs +++ b/cardano-api/internal/Cardano/Api/Error.hs @@ -9,10 +9,16 @@ module Cardano.Api.Error , throwErrorAsException , ErrorAsException(..) , FileError(..) + , fileIOExceptT ) where import Control.Exception (Exception (..), IOException, throwIO) import System.IO (Handle) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Except.Extra (handleIOExceptT) +import Control.Monad.IO.Class (MonadIO) +import System.Directory (doesFileExist) +import Control.Monad.Except (throwError) class Show e => Error e where @@ -46,6 +52,7 @@ data FileError e = FileError FilePath e FilePath -- ^ Temporary path Handle + | FileDoesNotExistError FilePath | FileIOError FilePath IOException deriving (Show, Eq, Functor) @@ -54,6 +61,8 @@ instance Error e => Error (FileError e) where "Error creating temporary file at: " ++ tempPath ++ "/n" ++ "Target path: " ++ targetPath ++ "/n" ++ "Handle: " ++ show h + displayError (FileDoesNotExistError path) = + "Error file not found at: " ++ path displayError (FileIOError path ioe) = path ++ ": " ++ displayException ioe displayError (FileError path e) = @@ -62,3 +71,13 @@ instance Error e => Error (FileError e) where instance Error IOException where displayError = show +fileIOExceptT :: MonadIO m + => FilePath + -> (FilePath -> IO s) + -> ExceptT (FileError e) m s +fileIOExceptT fp readFile' = do + fileExists <- handleIOExceptT (FileIOError fp) $ doesFileExist fp + if fileExists then do + handleIOExceptT (FileIOError fp) $ readFile' fp + else throwError (FileDoesNotExistError fp) + diff --git a/cardano-api/internal/Cardano/Api/IO.hs b/cardano-api/internal/Cardano/Api/IO.hs index f466527fd1..d1b695a869 100644 --- a/cardano-api/internal/Cardano/Api/IO.hs +++ b/cardano-api/internal/Cardano/Api/IO.hs @@ -34,13 +34,12 @@ module Cardano.Api.IO , writeSecrets ) where -import Cardano.Api.Error (FileError (..)) +import Cardano.Api.Error (FileError (..), fileIOExceptT) import Cardano.Api.IO.Base import Cardano.Api.IO.Compat import Control.Monad.Except (runExceptT) import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except.Extra (handleIOExceptT) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BSC @@ -54,21 +53,21 @@ readByteStringFile :: () => File content In -> m (Either (FileError e) ByteString) readByteStringFile fp = runExceptT $ - handleIOExceptT (FileIOError (unFile fp)) $ BS.readFile (unFile fp) + fileIOExceptT (unFile fp) BS.readFile readLazyByteStringFile :: () => MonadIO m => File content In -> m (Either (FileError e) LBS.ByteString) readLazyByteStringFile fp = runExceptT $ - handleIOExceptT (FileIOError (unFile fp)) $ LBS.readFile (unFile fp) + fileIOExceptT (unFile fp) LBS.readFile readTextFile :: () => MonadIO m => File content In -> m (Either (FileError e) Text) readTextFile fp = runExceptT $ - handleIOExceptT (FileIOError (unFile fp)) $ Text.readFile (unFile fp) + fileIOExceptT (unFile fp) Text.readFile writeByteStringFile :: () => MonadIO m @@ -76,7 +75,7 @@ writeByteStringFile :: () -> ByteString -> m (Either (FileError e) ()) writeByteStringFile fp bs = runExceptT $ - handleIOExceptT (FileIOError (unFile fp)) $ BS.writeFile (unFile fp) bs + fileIOExceptT (unFile fp) (`BS.writeFile` bs) writeByteStringFileWithOwnerPermissions :: FilePath @@ -93,7 +92,7 @@ writeByteStringOutput :: () -> m (Either (FileError e) ()) writeByteStringOutput mOutput bs = runExceptT $ case mOutput of - Just fp -> handleIOExceptT (FileIOError (unFile fp)) $ BS.writeFile (unFile fp) bs + Just fp -> fileIOExceptT (unFile fp) (`BS.writeFile` bs) Nothing -> liftIO $ BSC.putStr bs writeLazyByteStringFile :: () @@ -102,7 +101,7 @@ writeLazyByteStringFile :: () -> LBS.ByteString -> m (Either (FileError e) ()) writeLazyByteStringFile fp bs = runExceptT $ - handleIOExceptT (FileIOError (unFile fp)) $ LBS.writeFile (unFile fp) bs + fileIOExceptT (unFile fp) (`LBS.writeFile` bs) writeLazyByteStringFileWithOwnerPermissions :: File content Out @@ -119,7 +118,7 @@ writeLazyByteStringOutput :: () -> m (Either (FileError e) ()) writeLazyByteStringOutput mOutput bs = runExceptT $ case mOutput of - Just fp -> handleIOExceptT (FileIOError (unFile fp)) $ LBS.writeFile (unFile fp) bs + Just fp -> fileIOExceptT (unFile fp) (`LBS.writeFile` bs) Nothing -> liftIO $ LBSC.putStr bs writeTextFile :: () @@ -128,7 +127,7 @@ writeTextFile :: () -> Text -> m (Either (FileError e) ()) writeTextFile fp t = runExceptT $ - handleIOExceptT (FileIOError (unFile fp)) $ Text.writeFile (unFile fp) t + fileIOExceptT (unFile fp) (`Text.writeFile` t) writeTextFileWithOwnerPermissions :: File content Out @@ -145,7 +144,7 @@ writeTextOutput :: () -> m (Either (FileError e) ()) writeTextOutput mOutput t = runExceptT $ case mOutput of - Just fp -> handleIOExceptT (FileIOError (unFile fp)) $ Text.writeFile (unFile fp) t + Just fp -> fileIOExceptT (unFile fp) (`Text.writeFile` t) Nothing -> liftIO $ Text.putStr t mapFile :: (FilePath -> FilePath) -> File content direction -> File content direction diff --git a/cardano-api/internal/Cardano/Api/IO/Compat/Posix.hs b/cardano-api/internal/Cardano/Api/IO/Compat/Posix.hs index f845c530bb..3387eb5d34 100644 --- a/cardano-api/internal/Cardano/Api/IO/Compat/Posix.hs +++ b/cardano-api/internal/Cardano/Api/IO/Compat/Posix.hs @@ -17,14 +17,14 @@ module Cardano.Api.IO.Compat.Posix #ifdef UNIX -import Cardano.Api.Error (FileError (..)) +import Cardano.Api.Error (FileError (..), fileIOExceptT) import Cardano.Api.IO.Base import Control.Exception (IOException, bracket, bracketOnError, try) import Control.Monad (forM_, when) import Control.Monad.Except (ExceptT, runExceptT) import Control.Monad.IO.Class -import Control.Monad.Trans.Except.Extra (handleIOExceptT, left) +import Control.Monad.Trans.Except.Extra (left) import qualified Data.ByteString as BS import System.Directory () import System.FilePath (()) @@ -62,7 +62,7 @@ handleFileForWritingWithOwnerPermissionImpl path f = do bracket (fdToHandle fd) IO.hClose - (runExceptT . handleIOExceptT (FileIOError path) . f) + (runExceptT . fileIOExceptT path . const . f) writeSecretsImpl :: FilePath -> [Char] -> [Char] -> (a -> BS.ByteString) -> [a] -> IO () writeSecretsImpl outDir prefix suffix secretOp xs = diff --git a/cardano-api/internal/Cardano/Api/Keys/Read.hs b/cardano-api/internal/Cardano/Api/Keys/Read.hs index 8eac1a8221..7dc0bc245c 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Read.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Read.hs @@ -18,10 +18,9 @@ import Cardano.Api.SerialiseBech32 import Cardano.Api.SerialiseTextEnvelope import Cardano.Api.Utils -import Control.Exception import Data.Bifunctor -import Data.ByteString as BS import Data.List.NonEmpty (NonEmpty) +import Control.Monad.Except (runExceptT) -- | Read a cryptographic key from a file. -- @@ -33,14 +32,11 @@ readKeyFile -> FilePath -> IO (Either (FileError InputDecodeError) a) readKeyFile asType acceptedFormats path = do - eContent <- fmap Right (readFileBlocking path) `catches` [Handler handler] + eContent <- runExceptT $ fileIOExceptT path readFileBlocking case eContent of Left e -> return $ Left e Right content -> return . first (FileError path) $ deserialiseInput asType acceptedFormats content - where - handler :: IOException -> IO (Either (FileError InputDecodeError) BS.ByteString) - handler e = return . Left $ FileIOError path e -- | Read a cryptographic key from a file. -- @@ -65,12 +61,8 @@ readKeyFileAnyOf -> File content In -> IO (Either (FileError InputDecodeError) b) readKeyFileAnyOf bech32Types textEnvTypes path = do - eContent <- fmap Right (readFileBlocking (unFile path)) `catches` [Handler handler] + eContent <- runExceptT $ fileIOExceptT (unFile path) readFileBlocking case eContent of Left e -> return $ Left e Right content -> return . first (FileError (unFile path)) $ deserialiseInputAnyOf bech32Types textEnvTypes content - where - handler :: IOException -> IO (Either (FileError InputDecodeError) BS.ByteString) - handler e = return . Left $ FileIOError (unFile path) e - diff --git a/cardano-api/internal/Cardano/Api/SerialiseJSON.hs b/cardano-api/internal/Cardano/Api/SerialiseJSON.hs index ec30dff6fa..3cf68518b0 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseJSON.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseJSON.hs @@ -19,7 +19,7 @@ import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Control.Monad.Trans.Except (runExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither) +import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither) import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) @@ -56,7 +56,7 @@ readFileJSON :: FromJSON a -> IO (Either (FileError JsonDecodeError) a) readFileJSON ttoken path = runExceptT $ do - content <- handleIOExceptT (FileIOError path) $ BS.readFile path + content <- fileIOExceptT path BS.readFile firstExceptT (FileError path) $ hoistEither $ deserialiseFromJSON ttoken content @@ -66,6 +66,5 @@ writeFileJSON :: ToJSON a -> IO (Either (FileError ()) ()) writeFileJSON path x = runExceptT $ - handleIOExceptT (FileIOError path) $ - BS.writeFile path (serialiseToJSON x) + fileIOExceptT path (`BS.writeFile` serialiseToJSON x) diff --git a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs index 017eac3bdb..9ba23101db 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs @@ -41,7 +41,7 @@ import Cardano.Api.Utils import Cardano.Ledger.Binary (DecoderError) import qualified Cardano.Ledger.Binary as CBOR -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, +import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither, newExceptT, runExceptT) import Data.Aeson import qualified Data.Aeson as Aeson @@ -222,7 +222,7 @@ writeTxFileTextEnvelopeCddl -> IO (Either (FileError ()) ()) writeTxFileTextEnvelopeCddl path tx = runExceptT $ do - handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson + fileIOExceptT (unFile path) (`LBS.writeFile` txJson) where txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseTxLedgerCddl tx) <> "\n" @@ -233,7 +233,7 @@ writeTxWitnessFileTextEnvelopeCddl -> IO (Either (FileError ()) ()) writeTxWitnessFileTextEnvelopeCddl sbe path w = runExceptT $ do - handleIOExceptT (FileIOError (unFile path)) $ LBS.writeFile (unFile path) txJson + fileIOExceptT (unFile path) (`LBS.writeFile` txJson) where txJson = encodePretty' textEnvelopeCddlJSONConfig (serialiseWitnessLedgerCddl sbe w) <> "\n" @@ -325,7 +325,6 @@ readTextEnvelopeCddlFromFile -> IO (Either (FileError TextEnvelopeCddlError) TextEnvelopeCddl) readTextEnvelopeCddlFromFile path = runExceptT $ do - bs <- handleIOExceptT (FileIOError path) $ - readFileBlocking path + bs <- fileIOExceptT path readFileBlocking firstExceptT (FileError path . TextEnvelopeCddlAesonDecodeError path) . hoistEither $ Aeson.eitherDecodeStrict' bs diff --git a/cardano-api/internal/Cardano/Api/SerialiseTextEnvelope.hs b/cardano-api/internal/Cardano/Api/SerialiseTextEnvelope.hs index 23a89d8840..96005c428d 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseTextEnvelope.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseTextEnvelope.hs @@ -44,7 +44,7 @@ import Cardano.Binary (DecoderError) import Control.Monad (unless) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither) +import Control.Monad.Trans.Except.Extra (firstExceptT, hoistEither) import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=)) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (Config (..), defConfig, encodePretty', keyOrder) @@ -225,7 +225,7 @@ readFileTextEnvelope :: HasTextEnvelope a -> IO (Either (FileError TextEnvelopeError) a) readFileTextEnvelope ttoken path = runExceptT $ do - content <- handleIOExceptT (FileIOError (unFile path)) $ readFileBlocking (unFile path) + content <- fileIOExceptT (unFile path) readFileBlocking firstExceptT (FileError (unFile path)) $ hoistEither $ do te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecodeStrict' content deserialiseFromTextEnvelope ttoken te @@ -236,7 +236,7 @@ readFileTextEnvelopeAnyOf :: [FromSomeType HasTextEnvelope b] -> IO (Either (FileError TextEnvelopeError) b) readFileTextEnvelopeAnyOf types path = runExceptT $ do - content <- handleIOExceptT (FileIOError (unFile path)) $ readFileBlocking (unFile path) + content <- fileIOExceptT (unFile path) readFileBlocking firstExceptT (FileError (unFile path)) $ hoistEither $ do te <- first TextEnvelopeAesonDecodeError $ Aeson.eitherDecodeStrict' content deserialiseFromTextEnvelopeAnyOf types te @@ -246,8 +246,7 @@ readTextEnvelopeFromFile :: FilePath -> IO (Either (FileError TextEnvelopeError) TextEnvelope) readTextEnvelopeFromFile path = runExceptT $ do - bs <- handleIOExceptT (FileIOError path) $ - readFileBlocking path + bs <- fileIOExceptT path readFileBlocking firstExceptT (FileError path . TextEnvelopeAesonDecodeError) . hoistEither $ Aeson.eitherDecodeStrict' bs