IOV2SyncTests.hs (6304B)
1 {-# LANGUAGE ScopedTypeVariables #-} 2 module IOV2SyncTests (ioV2SyncTests) where 3 4 import qualified IOV2.Resources as R 5 import qualified IOV2.Filesystem as F 6 import qualified IOV2.Descriptor as D 7 import Control.Concurrent 8 import Control.Exception 9 import Control.Monad (forM_) 10 import Data.IORef 11 import qualified Data.ByteString as BS 12 import Data.List (isInfixOf) 13 import System.Directory (renameFile) 14 import System.Posix.Files (createNamedPipe) 15 import System.FilePath ((</>)) 16 import System.IO.Temp (withSystemTempDirectory) 17 import System.Timeout (timeout) 18 import Test.Tasty 19 import Test.Tasty.HUnit 20 21 fake = R.FileOps Nothing Nothing Nothing Nothing (pure 0) Nothing Nothing (pure ()) 22 category wanted value = case value of Left p -> R.category p @?= wanted; Right _ -> assertFailure wanted 23 24 ioV2SyncTests = localOption (mkTimeout 30000000) $ testGroup "IO v2 synchronization" 25 [ testCase "reader/update/append sync preserves bytes and logical cursor" $ withSystemTempDirectory "tricu-sync" $ \directory -> do 26 let path = directory </> "file" 27 BS.writeFile path "abcdef" 28 runtime <- R.newRuntime 29 Right reader <- R.openReader runtime R.rootScope path 30 R.readSome runtime R.rootScope reader 2 >>= (@?= Right "ab") 31 forM_ [1..10::Int] $ \_ -> R.syncFile runtime R.rootScope reader >>= (@?= Right ()) 32 R.filePosition runtime R.rootScope reader >>= (@?= Right 2) 33 R.readSome runtime R.rootScope reader 2 >>= (@?= Right "cd") 34 R.closeResource runtime R.rootScope reader >>= (@?= Right ()) 35 Right update <- R.openUpdate runtime R.rootScope path 36 R.seekFile runtime R.rootScope update 3 >>= (@?= Right ()) 37 R.writeSome runtime R.rootScope update "X" >>= (@?= Right 1) 38 R.syncFile runtime R.rootScope update >>= (@?= Right ()) 39 R.filePosition runtime R.rootScope update >>= (@?= Right 4) 40 R.closeResource runtime R.rootScope update >>= (@?= Right ()) 41 Right append <- R.openAppender runtime R.rootScope path 42 R.writeSome runtime R.rootScope append "Z" >>= (@?= Right 1) 43 R.syncFile runtime R.rootScope append >>= (@?= Right ()) 44 R.closeScope runtime R.rootScope >>= (@?= []) 45 BS.readFile path >>= (@?= "abcXefZ") 46 , testCase "sync uses the opened inode, not a fresh lookup of its old path" $ withSystemTempDirectory "tricu-sync" $ \directory -> do 47 let path = directory </> "old" 48 BS.writeFile path "bytes" 49 runtime <- R.newRuntime 50 Right reader <- R.openReader runtime R.rootScope path 51 renameFile path (directory </> "moved") 52 R.syncFile runtime R.rootScope reader >>= (@?= Right ()) 53 F.syncDirectory runtime R.rootScope directory >>= (@?= Right ()) 54 R.closeScope runtime R.rootScope >>= (@?= []) 55 , testCase "directory sync rejects non-directories and missing paths ordinarily" $ withSystemTempDirectory "tricu-sync" $ \directory -> do 56 let path = directory </> "file" 57 BS.writeFile path "bytes" 58 runtime <- R.newRuntime 59 counts <- R.liveCounts runtime 60 F.syncDirectory runtime R.rootScope path >>= category "not-directory" 61 createNamedPipe (directory </> "fifo") 0o600 62 F.syncDirectory runtime R.rootScope (directory </> "fifo") >>= category "not-directory" 63 F.syncDirectory runtime R.rootScope (directory </> "missing") >>= category "not-found" 64 F.syncDirectory runtime R.rootScope "" >>= category "invalid-argument" 65 R.liveCounts runtime >>= (@?= counts) 66 R.closeScope runtime R.rootScope >>= (@?= []) 67 , testCase "sync and release failures preserve primary diagnostics without history" $ do 68 runtime <- R.newRuntime 69 calls <- newIORef (0::Int) 70 let actions = pure (ioError (userError "primary sync failure"), 71 modifyIORef' calls (+1) >> ioError (userError "secondary release failure")) 72 Right file <- R.acquire runtime R.rootScope (pure (R.File fake {R.fileSyncActions=Just actions})) 73 R.syncFile runtime R.rootScope file >>= \reply -> case reply of 74 Left p -> do 75 R.progress p @?= "unknown" 76 assertBool "lost primary" ("primary sync failure" `isInfixOf` R.detail p) 77 assertBool "lost cleanup" ("secondary release failure" `isInfixOf` R.detail p) 78 _ -> assertFailure "sync failure swallowed" 79 R.liveCounts runtime >>= (@?= (1,4)) 80 readIORef calls >>= (@?= 1) 81 R.closeScope runtime R.rootScope >>= (@?= []) 82 , testCase "cancelled sync releases both leases and settles cleanup lexically" $ do 83 runtime <- R.newRuntime 84 entered <- newEmptyMVar; gate <- newEmptyMVar; done <- newEmptyMVar 85 released <- newIORef (0::Int) 86 let actions = pure (putMVar entered () >> takeMVar gate,modifyIORef' released (+1)) 87 Right file <- R.acquire runtime R.rootScope (pure (R.File fake {R.fileSyncActions=Just actions})) 88 worker <- forkFinally (R.syncFile runtime R.rootScope file) (putMVar done) 89 takeMVar entered 90 R.syncFile runtime R.rootScope file >>= category "busy" 91 killThread worker 92 timeout 3000000 (takeMVar done) >>= \reply -> case reply of 93 Just (Left err) -> case fromException err of Just ThreadKilled -> pure (); _ -> assertFailure (show err) 94 _ -> assertFailure "cancellation lost" 95 readIORef released >>= (@?= 0) 96 R.closeScope runtime R.rootScope >>= (@?= []) 97 readIORef released >>= (@?= 1) 98 , testCase "once-only raw release is not retried after close error or interruption" $ do 99 forM_ [toException (userError "uncertain close"),toException ThreadKilled] $ \exception -> do 100 calls <- newIORef (0::Int) 101 release <- D.releaseOnce (modifyIORef' calls (+1) >> throwIO exception) 102 first <- try release 103 case first of Left (_ :: SomeException) -> pure (); Right _ -> assertFailure "injection missing" 104 release 105 readIORef calls >>= (@?= 1) 106 , testCase "unsupported methods and borrowed streams cannot become file sync" $ do 107 runtime <- R.newRuntime 108 Right file <- R.acquire runtime R.rootScope (pure (R.File fake)) 109 R.syncFile runtime R.rootScope file >>= category "unsupported" 110 Right standard <- R.standardStream runtime R.rootScope R.StandardOutput 111 R.syncFile runtime R.rootScope standard >>= category "wrong-kind" 112 R.closeScope runtime R.rootScope >>= (@?= []) 113 ]