Don't catch async exceptions (1.4)

System/FilePath/Internal.hs

@@ -129,8 +129,9 @@ import Data.List(stripPrefix, isSuffixOf, uncons, dropWhileEnd)
 #define STRING String
 #define FILEPATH FilePath
 #else
+import System.OsPath.Encoding.Internal.Hidden ( trySafe )
 import Prelude (fromIntegral)
-import Control.Exception ( SomeException, evaluate, try, displayException )
+import Control.Exception ( SomeException, evaluate, displayException )
 import Control.DeepSeq (force)
 import GHC.IO (unsafePerformIO)
 import qualified Data.Char as C
@@ -1273,12 +1274,12 @@ snoc str = \c -> str <> [c]
 #ifdef WINDOWS
 fromString :: P.String -> STRING
 fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF16le ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
   evaluate $ force $ first displayException r
 #else
 fromString :: P.String -> STRING
 fromString str = P.either (P.error . P.show) P.id $ unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen (mkUTF8 ErrorOnCodingFailure) str $ \cstr -> packCStringLen cstr
   evaluate $ force $ first displayException r
 #endif
 

System/OsPath/Encoding/Internal/Hidden.hs

@@ -19,7 +19,7 @@ import GHC.IO.Buffer
 import GHC.IO.Encoding.Failure
 import GHC.IO.Encoding.Types
 import Data.Bits
-import Control.Exception (SomeException, try, Exception (displayException), evaluate)
+import Control.Exception (SomeException, try, Exception (displayException), evaluate, SomeAsyncException(..), catch, fromException, toException, throwIO)
 import qualified GHC.Foreign as GHC
 import Data.Either (Either)
 import GHC.IO (unsafePerformIO)
@@ -31,7 +31,7 @@ import Numeric (showHex)
 import Foreign.C (CStringLen)
 import Data.Char (chr)
 import Foreign
-import Prelude (FilePath)
+import Prelude (FilePath, Either(..))
 import GHC.IO.Encoding (getFileSystemEncoding)
 
 -- -----------------------------------------------------------------------------
@@ -277,13 +277,13 @@ peekFilePathPosix fp = getFileSystemEncoding >>= \enc -> GHC.peekCStringLen enc
 -- | Decode with the given 'TextEncoding'.
 decodeWithTE :: TextEncoding -> BS8.ShortByteString -> Either EncodingException String
 decodeWithTE enc ba = unsafePerformIO $ do
-  r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen enc fp
+  r <- trySafe @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen enc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 
 -- | Encode with the given 'TextEncoding'.
 encodeWithTE :: TextEncoding -> String -> Either EncodingException BS8.ShortByteString
 encodeWithTE enc str = unsafePerformIO $ do
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> BS8.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 
 -- -----------------------------------------------------------------------------
@@ -347,3 +347,24 @@ instance NFData EncodingException where
 
 wNUL :: Word16
 wNUL = 0x00
+
+-- -----------------------------------------------------------------------------
+-- Exceptions
+--
+
+-- | Like 'try', but rethrows async exceptions.
+trySafe :: Exception e => IO a -> IO (Either e a)
+trySafe ioA = catch action eHandler
+ where
+  action = do
+    v <- ioA
+    return (Right v)
+  eHandler e
+    | isAsyncException e = throwIO e
+    | otherwise = return (Left e)
+
+isAsyncException :: Exception e => e -> Bool
+isAsyncException e =
+    case fromException (toException e) of
+        Just (SomeAsyncException _) -> True
+        Nothing -> False

System/OsString/Common.hs

@@ -60,7 +60,7 @@ import Control.Monad.Catch
 import Data.ByteString.Internal
     ( ByteString )
 import Control.Exception
-    ( SomeException, try, displayException )
+    ( SomeException, displayException )
 import Control.DeepSeq ( force )
 import Data.Bifunctor ( first )
 import GHC.IO
@@ -70,7 +70,7 @@ import Language.Haskell.TH.Quote
     ( QuasiQuoter (..) )
 import Language.Haskell.TH.Syntax
     ( Lift (..), lift )
-
+import System.OsPath.Encoding.Internal.Hidden ( trySafe )
 
 import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )
 #ifdef WINDOWS
@@ -116,10 +116,10 @@ encodeWith :: TextEncoding
            -> Either EncodingException PLATFORM_STRING
 encodeWith enc str = unsafePerformIO $ do
 #ifdef WINDOWS
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> WindowsString <$> BS8.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> WindowsString <$> BS8.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #else
-  r <- try @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BS.packCStringLen cstr
+  r <- trySafe @SomeException $ GHC.withCStringLen enc str $ \cstr -> PosixString <$> BS.packCStringLen cstr
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #endif
 
@@ -176,7 +176,7 @@ decodeWith :: TextEncoding
            -> PLATFORM_STRING
            -> Either EncodingException String
 decodeWith winEnc (WindowsString ba) = unsafePerformIO $ do
-  r <- try @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen winEnc fp
+  r <- trySafe @SomeException $ BS8.useAsCStringLen ba $ \fp -> GHC.peekCStringLen winEnc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #else
 -- | Decode a 'PosixString' with the specified encoding.
@@ -186,7 +186,7 @@ decodeWith :: TextEncoding
        -> PLATFORM_STRING
        -> Either EncodingException String
 decodeWith unixEnc (PosixString ba) = unsafePerformIO $ do
-  r <- try @SomeException $ BS.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp
+  r <- trySafe @SomeException $ BS.useAsCStringLen ba $ \fp -> GHC.peekCStringLen unixEnc fp
   evaluate $ force $ first (flip EncodingError Nothing . displayException) r
 #endif
 

changelog.md

@@ -2,11 +2,19 @@
 
 _Note: below all `FilePath` values are unquoted, so `\\` really means two backslashes._
 
-## 1.4.300.1. *Jan 2024*
+## 1.4.301.0 *Nov 2024*
+
+* Don't catch async exceptions in internal functions wrt https://github.com/haskell/os-string/issues/22
+
+## 1.4.300.2 *Apr 2024*
+
+* Fix compabitiliby with GHC 9.10
+
+## 1.4.300.1 *Jan 2024*
 
 * Backport bugfix for [`splitFileName`](https://github.com/haskell/filepath/issues/219) on windows
 
-## 1.4.200.1. *Dec 2023*
+## 1.4.200.1 *Dec 2023*
 
 * Improve deprecation warnings wrt [#209](https://github.com/haskell/filepath/issues/209)
 

filepath.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               filepath
-version:            1.4.300.1
+version:            1.4.301.0
 
 -- NOTE: Don't forget to update ./changelog.md
 license:            BSD-3-Clause
@@ -113,7 +113,7 @@ library
 
   default-language: Haskell2010
   build-depends:
-    , base              >=4.9      && <4.20
+    , base              >=4.9      && <4.21
     , bytestring        >=0.11.3.0
     , deepseq
     , exceptions

tests/abstract-filepath/EncodingSpec.hs

@@ -39,7 +39,9 @@ tests =
       let str = [toEnum 55296, toEnum 55297]
           encoded = encodeWithTE utf16le str
           decoded = decodeWithTE utf16le =<< encoded
-#if __GLASGOW_HASKELL__ >= 904
+#if __GLASGOW_HASKELL__ >= 910
+      in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")\n") Nothing))
+#elif __GLASGOW_HASKELL__ >= 904
       in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing))
 #else
       in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing))
@@ -69,7 +71,9 @@ tests =
       let str = [toEnum 0xDFF0, toEnum 0xDFF2]
           encoded = encodeWithTE (mkUTF8 RoundtripFailure) str
           decoded = decodeWithTE (mkUTF8 RoundtripFailure) =<< encoded
-#if __GLASGOW_HASKELL__ >= 904
+#if __GLASGOW_HASKELL__ >= 910
+      in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")\n") Nothing))
+#elif __GLASGOW_HASKELL__ >= 904
       in decoded === Left (EncodingError ("recoverEncode: invalid argument (cannot encode character " <> show (head str) <> ")") Nothing))
 #else
       in decoded === Left (EncodingError "recoverEncode: invalid argument (invalid character)" Nothing))

tests/bytestring-tests/Properties/Common.hs

@@ -33,7 +33,7 @@ import Data.Word
 
 import Control.Arrow
 import Data.Foldable
-import Data.List as L
+import Data.List as L hiding (unsnoc)
 import Data.Semigroup
 import Data.Tuple
 import Test.QuickCheck