From 92a34776f0b0d148defc170356ff32e200f1ff2c Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Wed, 21 Jun 2023 15:52:26 +0100 Subject: [PATCH] Added FileDoesNotExistError constructor Improves the error situation when dealing with file paths. Before all IO related errors where wrapped around the constructor FileIOError. Now the existence of the file is checked and if it does not exist a FileDoesNotExistError is thrown. Added `fileIOExceptT` function that abstracts away this existence check, so we can get read of all the FileIOError wraps. --- cardano-api/internal/Cardano/Api/Error.hs | 19 +++++++++++++++++ cardano-api/internal/Cardano/Api/IO.hs | 21 +++++++++---------- .../internal/Cardano/Api/IO/Compat/Posix.hs | 6 +++--- cardano-api/internal/Cardano/Api/Keys/Read.hs | 14 +++---------- .../internal/Cardano/Api/SerialiseJSON.hs | 7 +++---- .../Cardano/Api/SerialiseLedgerCddl.hs | 9 ++++---- .../Cardano/Api/SerialiseTextEnvelope.hs | 9 ++++---- 7 files changed, 46 insertions(+), 39 deletions(-) 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