git.iko.soy/streamly
on d42276a help sign in
streamly/test/Streamly/Test/FileSystem/Event.hs
399 lines 13 kB history raw
1-- |
2-- Module : Streamly.Test.FileSystem.Event
3-- Copyright : (c) 2020 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
6-- Stability : experimental
7-- Portability : GHC
8--
9module Main (main) where
11import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar, threadDelay)
12import Control.Monad.IO.Class (MonadIO)
13#if !defined(CABAL_OS_WINDOWS)
14import Data.Char (ord)
15#endif
16import Data.Maybe (fromJust)
17import Data.Word (Word8)
18import System.Directory
19 ( createDirectoryIfMissing
20 , removeFile
21 , removeDirectory
22 , removePathForcibly
23 , renameDirectory
24 , renamePath
25 )
26import System.FilePath ((</>))
27import System.IO (BufferMode(..), hSetBuffering, stdout)
28import System.IO.Temp (withSystemTempDirectory)
29#if !defined(CABAL_OS_WINDOWS)
30import System.IO.Unsafe (unsafePerformIO)
31#endif
32import Streamly.Internal.Data.Array.Foreign (Array)
34import qualified Data.List.NonEmpty as NonEmpty
35import qualified Data.Set as Set
36import qualified Streamly.Unicode.Stream as Unicode
37import qualified Streamly.Internal.Data.Array.Foreign as Array
38import qualified Streamly.Internal.Data.Fold as FL
39import qualified Streamly.Internal.Data.Parser as PR
40import qualified Streamly.Internal.Data.Stream.IsStream as S
41#if defined(CABAL_OS_DARWIN)
42import qualified Streamly.Internal.FileSystem.Event.Darwin as Event
43#elif defined(CABAL_OS_LINUX)
44import qualified Streamly.Internal.FileSystem.Event.Linux as Event
45#elif defined(CABAL_OS_WINDOWS)
46import qualified Streamly.Internal.FileSystem.Event.Windows as Event
47#else
48#error "FS Events not supported on this platform
49#endif
51#if !defined(CABAL_OS_WINDOWS)
52import Data.Functor.Identity (runIdentity)
53import qualified Streamly.Internal.Unicode.Stream as U
54#endif
56import Test.Hspec
58-------------------------------------------------------------------------------
59-- Utilities
60-------------------------------------------------------------------------------
62toUtf8 :: MonadIO m => String -> m (Array Word8)
63toUtf8 = Array.fromStream . Unicode.encodeUtf8' . S.fromList
65#if !defined(CABAL_OS_WINDOWS)
66utf8ToString :: Array Word8 -> String
67utf8ToString = runIdentity . S.toList . U.decodeUtf8' . Array.toStream
68#endif
70timeout :: IO String
71timeout = threadDelay 5000000 >> return "Timeout"
73fseventDir :: String
74fseventDir = "fsevent_dir"
76-- XXX Make the getRelPath type same on windows and other platforms
77eventPredicate :: Event.Event -> Bool
78eventPredicate ev =
79#if defined(CABAL_OS_WINDOWS)
80 if (Event.getRelPath ev) == "EOTask"
81#else
82 if (utf8ToString $ Event.getRelPath ev) == "EOTask"
83#endif
84 then False
85 else True
87-------------------------------------------------------------------------------
88-- Event matching utilities
89-------------------------------------------------------------------------------
90#if defined(CABAL_OS_LINUX)
91removeTrailingSlash :: Array Word8 -> Array Word8
92removeTrailingSlash path =
93 if Array.length path == 0
94 then path
95 else
96 let mx = Array.readIndex path (Array.length path - 1)
97 in case mx of
98 Nothing -> error "removeTrailingSlash: Bug: Invalid index"
99 Just x ->
100 if x == fromIntegral (ord '/')
101 -- XXX need array slicing
102 then unsafePerformIO
103 $ Array.fromStreamN (Array.length path - 1)
104 $ Array.toStream path
105 else path
106#endif
108-- XXX Return a tuple (path, flags) instead of appending flags to path. And
109-- then check the flags using an event mask.
111showEventShort :: Event.Event -> String
112#if defined(CABAL_OS_WINDOWS)
113-- | Convert an 'Event' record to a short representation for unit test.
114showEventShort ev@Event.Event{..} =
115 Event.getRelPath ev ++ "_" ++ show eventFlags
116#elif defined(CABAL_OS_LINUX)
117showEventShort ev@Event.Event{..} =
118 (utf8ToString $ removeTrailingSlash $ Event.getRelPath ev)
119 ++ "_" ++ show eventFlags
120 ++ showev Event.isDir "Dir"
122 where showev f str = if f ev then "_" ++ str else ""
123#else
124#error "Unsupported OS
125#endif
127-------------------------------------------------------------------------------
128-- Event Watcher
129-------------------------------------------------------------------------------
131checkEvents :: FilePath -> MVar () -> [String] -> IO String
132checkEvents rootPath m matchList = do
133 let args = [rootPath]
134 paths <- mapM toUtf8 args
135 putStrLn ("Watch started !!!! on Path " ++ rootPath)
136 events <- S.parse (PR.takeWhile eventPredicate FL.toList)
137 $ S.before (putMVar m ())
138 $ Event.watchTrees (NonEmpty.fromList paths)
139 let eventStr = map showEventShort events
140 let baseSet = Set.fromList matchList
141 resultSet = Set.fromList eventStr
142 if (baseSet `Set.isSubsetOf` resultSet)
143 then
144 return "PASS"
145 else do
146 putStrLn $ "baseSet " ++ show matchList
147 putStrLn $ "resultSet " ++ show eventStr
148 return "Mismatch"
150-------------------------------------------------------------------------------
151-- FS Event Generators
152-------------------------------------------------------------------------------
154checker :: S.IsStream t =>
155 FilePath -> MVar () -> [String] -> t IO String
156checker rootPath synch matchList =
157 S.yieldM (checkEvents rootPath synch matchList)
158 `S.parallelFst`
159 S.yieldM timeout
161-------------------------------------------------------------------------------
162-- Test Drivers
163-------------------------------------------------------------------------------
165driver ::
166 ( String
167 , FilePath -> IO ()
168 , FilePath -> IO ()
169 , [String]
170 )
171 -> SpecWith ()
172driver (desc, pre, ops, events) = it desc $ runTest `shouldReturn` "PASS"
174 where
176 runTest = do
177 sync <- newEmptyMVar
178 withSystemTempDirectory fseventDir $ \fp -> do
179 pre fp
180 let eventStream = checker fp sync events
181 fsOps = S.yieldM $ runFSOps fp sync
182 fmap fromJust $ S.head $ eventStream `S.parallelFst` fsOps
184 runFSOps fp sync = do
185 _ <- takeMVar sync
186 threadDelay 200000
187 ops fp
188 threadDelay 200000 -- Why this delay?
189 createDirectoryIfMissing True (fp </> "EOTask")
190 threadDelay 10000000
191 error "fs ops timed out"
193-------------------------------------------------------------------------------
194-- Main
195-------------------------------------------------------------------------------
197testDesc ::
198 [ ( String -- test description
199 , FilePath -> IO () -- pre test operation
200 , FilePath -> IO () -- file system actions
201 , [String]) -- expected events
202 ]
203testDesc =
204 [
205 ( "Create a single directory"
206 , const (return ())
207 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
208#if defined(CABAL_OS_WINDOWS)
209 , [ "dir1Single_1" ]
210#elif defined(CABAL_OS_LINUX)
211 , [ "dir1Single_1073742080_Dir"
212 , "dir1Single_1073741856_Dir"
213 , "dir1Single_1073741825_Dir"
214 , "dir1Single_1073741840_Dir"
215 ]
216#endif
217 )
218 , ( "Remove a single directory"
219 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
220 , \fp -> removeDirectory (fp </> "dir1Single")
221#if defined(CABAL_OS_WINDOWS)
222 , [ "dir1Single_2" ]
223#elif defined(CABAL_OS_LINUX)
224 , [ "dir1Single_1024"
225 , "dir1Single_32768"
226 ]
227#endif
228 )
229 , ( "Rename a single directory"
230 , \fp -> createDirectoryIfMissing True (fp </> "dir1Single")
231 , \fp ->
232 let spath = fp </> "dir1Single"
233 tpath = fp </> "dir1SingleRenamed"
234 in renameDirectory spath tpath
235#if defined(CABAL_OS_WINDOWS)
236 , [ "dir1Single_4"
237 , "dir1SingleRenamed_5"
238 ]
239#elif defined(CABAL_OS_LINUX)
240 , [ "dir1Single_1073741888_Dir"
241 , "dir1SingleRenamed_1073741952_Dir"
242 ]
243#endif
244 )
245 , ( "Create a nested directory"
246 , const (return ())
247 , \fp ->
248 createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
249#if defined(CABAL_OS_WINDOWS)
250 , [ "dir1_1"
251 , "dir1\\dir2_1"
252 , "dir1\\dir2\\dir3_1"
253 ]
254#elif defined(CABAL_OS_LINUX)
255 , [ "dir1_1073742080_Dir"
256 , "dir1_1073741856_Dir"
257 , "dir1_1073741825_Dir"
258 , "dir1_1073741840_Dir"
259 ]
260#endif
261 )
262 , ( "Remove a nested directory"
263 , \fp ->
264 createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
265 , \fp -> removePathForcibly (fp </> "dir1")
266#if defined(CABAL_OS_WINDOWS)
267 , [ "dir1_3"
268 , "dir1\\dir2_3"
269 , "dir1\\dir2\\dir3_2"
270 , "dir1\\dir2_2","dir1_2"
271 ]
272#elif defined(CABAL_OS_LINUX)
273 , [ "dir1/dir2/dir3_1073742336_Dir"
274 , "dir1/dir2_1073742336_Dir"
275 , "dir1_1073742336_Dir"
276 ]
277#endif
278 )
279 , ( "Rename a nested directory"
280 , \fp -> createDirectoryIfMissing True
281 (fp </> "dir1" </> "dir2" </> "dir3")
282 , \fp ->
283 let spath = fp </> "dir1" </> "dir2" </> "dir3"
284 tpath = fp </> "dir1" </> "dir2" </> "dir3Renamed"
285 in renameDirectory spath tpath
286#if defined(CABAL_OS_WINDOWS)
287 , [ "dir1\\dir2_3"
288 , "dir1\\dir2\\dir3_4"
289 , "dir1\\dir2\\dir3Renamed_5"
290 , "dir1\\dir2_3"
291 ]
292#elif defined(CABAL_OS_LINUX)
293 , [ "dir1/dir2/dir3_1073741888_Dir"
294 , "dir1/dir2/dir3Renamed_1073741952_Dir"
295 ]
296#endif
297 )
298 , ( "Create a file in root Dir"
299 , const (return ())
300 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
301#if defined(CABAL_OS_WINDOWS)
302 , [ "FileCreated.txt_1"
303 , "FileCreated.txt_3"
304 , "FileCreated.txt_3"
305 ]
306#elif defined(CABAL_OS_LINUX)
307 , [ "FileCreated.txt_256"
308 , "FileCreated.txt_32"
309 , "FileCreated.txt_2"
310 ]
311#endif
312 )
313 , ( "Remove a file in root Dir"
314 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
315 , \fp -> removeFile (fp </> "FileCreated.txt")
316#if defined(CABAL_OS_WINDOWS)
317 , [ "FileCreated.txt_2" ]
318#elif defined(CABAL_OS_LINUX)
319 , [ "FileCreated.txt_512" ]
320#endif
321 )
322 , ( "Rename a file in root Dir"
323 , \fp -> writeFile (fp </> "FileCreated.txt") "Test Data"
324 , \fp ->
325 let spath = (fp </> "FileCreated.txt")
326 tpath = (fp </> "FileRenamed.txt")
327 in renamePath spath tpath
328#if defined(CABAL_OS_WINDOWS)
329 , [ "FileCreated.txt_4"
330 , "FileRenamed.txt_5"
331 ]
332#elif defined(CABAL_OS_LINUX)
333 , [ "FileCreated.txt_64"
334 , "FileRenamed.txt_128"
335 ]
336#endif
337 )
338 , ( "Create a file in a nested Dir"
339 , \fp ->
340 createDirectoryIfMissing True (fp </> "dir1" </> "dir2" </> "dir3")
341 , \fp ->
342 let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
343 in writeFile p "Test Data"
344#if defined(CABAL_OS_WINDOWS)
345 , [ "dir1\\dir2\\dir3\\FileCreated.txt_1"
346 , "dir1\\dir2\\dir3\\FileCreated.txt_3"
347 ]
348#elif defined(CABAL_OS_LINUX)
349 , [ "dir1/dir2/dir3/FileCreated.txt_256"
350 , "dir1/dir2/dir3/FileCreated.txt_32"
351 , "dir1/dir2/dir3/FileCreated.txt_2"
352 , "dir1/dir2/dir3/FileCreated.txt_8"
353 ]
354#endif
355 )
356 , ( "Remove a file in a nested Dir"
357 , \fp ->
358 let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
359 fpath = nestedDir </> "FileCreated.txt"
360 in do
361 createDirectoryIfMissing True nestedDir
362 writeFile fpath "Test Data"
363 , \fp ->
364 let p = fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt"
365 in removeFile p
366#if defined(CABAL_OS_WINDOWS)
367 , ["dir1\\dir2\\dir3\\FileCreated.txt_2"]
368#elif defined(CABAL_OS_LINUX)
369 , ["dir1/dir2/dir3/FileCreated.txt_512"]
370#endif
371 )
372 , ( "Rename a file in a nested Dir"
373 , \fp ->
374 let nestedDir = fp </> "dir1" </> "dir2" </> "dir3"
375 fpath = nestedDir </> "FileCreated.txt"
376 in do
377 createDirectoryIfMissing True nestedDir
378 writeFile fpath "Test Data"
379 , \fp ->
380 let s = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileCreated.txt")
381 t = (fp </> "dir1" </> "dir2" </> "dir3" </> "FileRenamed.txt")
382 in renamePath s t
383#if defined(CABAL_OS_WINDOWS)
384 , [ "dir1\\dir2\\dir3_3"
385 , "dir1\\dir2\\dir3\\FileCreated.txt_4"
386 , "dir1\\dir2\\dir3\\FileRenamed.txt_5"
387 ]
388#elif defined(CABAL_OS_LINUX)
389 , [ "dir1/dir2/dir3/FileCreated.txt_64"
390 , "dir1/dir2/dir3/FileRenamed.txt_128"
391 ]
392#endif
393 )
394 ]
396main :: IO ()
397main = do
398 hSetBuffering stdout NoBuffering
399 hspec $ sequence_ $ map driver testDesc