@@ -101,6 +101,7 @@ import Database.LSMTree.Extras.Generators (KeyForIndexCompact)
101
101
import Database.LSMTree.Extras.NoThunks (propNoThunks )
102
102
import Database.LSMTree.Internal (LSMTreeError (.. ))
103
103
import qualified Database.LSMTree.Internal as R.Internal
104
+ import Database.LSMTree.Internal.CRC32C (FileFormatError (.. ))
104
105
import Database.LSMTree.Internal.Serialise (SerialisedBlob ,
105
106
SerialisedValue )
106
107
import qualified Database.LSMTree.Model.IO as ModelIO
@@ -188,7 +189,7 @@ propLockstep_ModelIOImpl =
188
189
env :: RealEnv ModelIO. Table IO
189
190
env = RealEnv {
190
191
envSession = session
191
- , envHandlers = [handler, diskFaultErrorHandler]
192
+ , envHandlers = [handler, diskFaultErrorHandler, fileFormatErrorHandler ]
192
193
, envErrors = errsVar
193
194
, envInjectFaultResults = faultsVar
194
195
}
@@ -292,6 +293,7 @@ propLockstep_RealImpl_RealFS_IO tr =
292
293
, envHandlers = [
293
294
realHandler @ IO
294
295
, diskFaultErrorHandler
296
+ , fileFormatErrorHandler
295
297
]
296
298
, envErrors = errsVar
297
299
, envInjectFaultResults = faultsVar
@@ -334,6 +336,7 @@ propLockstep_RealImpl_MockFS_IO tr =
334
336
, envHandlers = [
335
337
realHandler @ IO
336
338
, diskFaultErrorHandler
339
+ , fileFormatErrorHandler
337
340
]
338
341
, envErrors = errsVar
339
342
, envInjectFaultResults = faultsVar
@@ -362,6 +365,7 @@ propLockstep_RealImpl_MockFS_IOSim tr actions =
362
365
, envHandlers = [
363
366
realHandler @ (IOSim s )
364
367
, diskFaultErrorHandler
368
+ , fileFormatErrorHandler
365
369
]
366
370
, envErrors = errsVar
367
371
, envInjectFaultResults = faultsVar
@@ -458,6 +462,19 @@ isDiskFault e
458
462
isDiskFault' :: forall e . Exception e => e -> Bool
459
463
isDiskFault' = isDiskFault . toException
460
464
465
+ fileFormatErrorHandler :: Monad m => Handler m (Maybe Model. Err )
466
+ fileFormatErrorHandler = Handler $ \ e -> pure $
467
+ if isFileFormatError e
468
+ then Just (Model. ErrFsError (displayException e))
469
+ else Nothing
470
+
471
+ isFileFormatError :: SomeException -> Bool
472
+ isFileFormatError e
473
+ | Just (FileFormatError _file _msg) <- fromException e
474
+ = True
475
+ | otherwise
476
+ = False
477
+
461
478
createSystemTempDirectory :: [Char ] -> IO (FilePath , HasFS IO HandleIO , HasBlockIO IO HandleIO )
462
479
createSystemTempDirectory prefix = do
463
480
systemTempDir <- getCanonicalTemporaryDirectory
0 commit comments