1-- Some code snippets are adapted from the fsnotify package.
2-- http://hackage.haskell.org/package/fsnotify-0.3.0.1/
5-- Module : Streamly.Internal.FileSystem.Event.Windows
6-- Copyright : (c) 2020 Composewell Technologies
7-- (c) 2012, Mark Dittmer
8-- License : BSD-3-Clause
9-- Maintainer : streamly@composewell.com
10-- Stability : pre-release
15-- Use 'watchRecursive'or 'watch' with a list of file system dir paths you
16-- want to watch as argument. It returns a stream of 'Event' representing the
17-- file system events occurring under the watched paths.
20-- {-\# LANGUAGE MagicHash #-}
21-- Stream.mapM_ (putStrLn . 'showEvent') $ 'watchRecursive' [Array.fromList "path"]
24-- 'Event' is an opaque type. Accessor functions (e.g. 'showEvent' above)
25-- provided in this module are used to determine the attributes of the event.
29-- For Windows reference documentation see:
31-- * <https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information file notify information>
32-- * <https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw read directory changes>
34-- We try to keep the macOS\/Linux/Windows event handling APIs and defaults
35-- semantically and syntactically as close as possible.
39-- As per the Windows reference docs, the fs event notification API is
42-- * Minimum supported client: Windows XP [desktop apps | UWP apps]
43-- * Minimum supported server: Windows Server 2003 [desktop apps | UWP apps
45module Streamly.Internal.FileSystem.Event.Windows
47 -- * Subscribing to events
49 -- ** Default configuration
56 -- ** Events of Interest
62 , setLastWriteTimeModified
76 -- ** Item CRUD events
84 -- ** Exception Conditions
92import Data.Bits ((.|.), (.&.), complement)
94import Data.Functor.Identity (runIdentity)
95import Data.List.NonEmpty (NonEmpty)
96import Data.Word (Word8)
97import Foreign.C.String (peekCWStringLen)
98import Foreign.Marshal.Alloc (alloca, allocaBytes)
99import Foreign.Storable (peekByteOff)
100import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)
101import Streamly.Internal.Data.Stream (Stream)
102import Streamly.Internal.Data.Stream.Concurrent (eager)
103import System.Win32.File
104 ( FileNotificationFlag
108 , fILE_FLAG_BACKUP_SEMANTICS
109 , fILE_LIST_DIRECTORY
110 , fILE_NOTIFY_CHANGE_FILE_NAME
111 , fILE_NOTIFY_CHANGE_DIR_NAME
112 , fILE_NOTIFY_CHANGE_ATTRIBUTES
113 , fILE_NOTIFY_CHANGE_SIZE
114 , fILE_NOTIFY_CHANGE_LAST_WRITE
115 , fILE_NOTIFY_CHANGE_SECURITY
120import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
121import qualified Data.List.NonEmpty as NonEmpty
122import qualified Streamly.Data.Fold as Fold
123import qualified Streamly.Internal.Data.Stream as S
124import qualified Streamly.Internal.Data.Stream.Concurrent as S (parConcatMap)
125import qualified Streamly.Internal.Unicode.Stream as U
126import qualified Streamly.Internal.Unicode.Utf8 as UTF8
127import qualified Streamly.Internal.Data.Array as A
128import Streamly.Internal.Data.Array (Array)
130-- | Watch configuration, used to specify the events of interest and the
131-- behavior of the watch.
137 , createFlags :: DWORD
140-------------------------------------------------------------------------------
142-------------------------------------------------------------------------------
144setFlag :: DWORD -> Bool -> Config -> Config
145setFlag mask status cfg@Config{..} =
148 then createFlags .|. mask
149 else createFlags .&. complement mask
150 in cfg {createFlags = flags}
152-- | Set watch event on directory recursively.
158setRecursiveMode :: Bool -> Config -> Config
159setRecursiveMode recursive cfg@Config{} = cfg {watchRec = recursive}
161-- | Generate notify events on file create, rename or delete.
163-- From Windows API documentation: Any file name change in the watched
164-- directory or subtree causes a change notification wait operation to return.
165-- Changes include renaming, creating, or deleting a file.
171setFileNameEvents :: Bool -> Config -> Config
172setFileNameEvents = setFlag fILE_NOTIFY_CHANGE_FILE_NAME
174-- | Generate notify events on directory create, rename or delete.
176-- From Windows API documentaiton: Any directory-name change in the watched
177-- directory or subtree causes a change notification wait operation to return.
178-- Changes include creating or deleting a directory.
184setDirNameEvents :: Bool -> Config -> Config
185setDirNameEvents = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
187-- | Generate an 'isModified' event on any attribute change in the watched
188-- directory or subtree.
194setAttrsModified :: Bool -> Config -> Config
195setAttrsModified = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES
197-- | Generate an 'isModified' event when the file size is changed.
199-- From Windows API documentation: Any file-size change in the watched
200-- directory or subtree causes a change notification wait operation to return.
201-- The operating system detects a change in file size only when the file is
202-- written to the disk. For operating systems that use extensive caching,
203-- detection occurs only when the cache is sufficiently flushed.
209setSizeModified :: Bool -> Config -> Config
210setSizeModified = setFlag fILE_NOTIFY_CHANGE_SIZE
212-- | Generate an 'isModified' event when the last write timestamp of the file
215-- From Windows API documentation: Any change to the last write-time of files
216-- in the watched directory or subtree causes a change notification wait
217-- operation to return. The operating system detects a change to the last
218-- write-time only when the file is written to the disk. For operating systems
219-- that use extensive caching, detection occurs only when the cache is
220-- sufficiently flushed.
226setLastWriteTimeModified :: Bool -> Config -> Config
227setLastWriteTimeModified = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
229-- | Generate an 'isModified' event when any security-descriptor change occurs
230-- in the watched directory or subtree.
236setSecurityModified :: Bool -> Config -> Config
237setSecurityModified = setFlag fILE_NOTIFY_CHANGE_SECURITY
239-- | Set all tunable events 'True' or 'False'. Equivalent to setting:
241-- * setFileNameEvents
245-- * setLastWriteTimeModified
246-- * setSecurityModified
250setAllEvents :: Bool -> Config -> Config
256 . setLastWriteTimeModified s
257 . setSecurityModified s
259-- | The tunable events that are enabled by default are:
261-- * setFileNameEvents True
262-- * setDirNameEvents True
263-- * setSizeModified True
264-- * setLastWriteTimeModified True
268defaultConfig :: Config
270 setFileNameEvents True
271 $ setDirNameEvents True
272 $ setSizeModified True
273 $ setLastWriteTimeModified True
274 $ Config {watchRec = False, createFlags = 0}
276getConfigFlag :: Config -> DWORD
277getConfigFlag Config{..} = createFlags
279getConfigRecMode :: Config -> BOOL
280getConfigRecMode Config{..} = watchRec
283 { eventFlags :: DWORD
284 , eventRelPath :: String
285 , eventRootPath :: String
286 , totalBytes :: DWORD
287 } deriving (Show, Ord, Eq)
289-- For reference documentation see:
291-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
292data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
293 { fniNextEntryOffset :: DWORD
295 , fniFileName :: String
298type LPOVERLAPPED_COMPLETION_ROUTINE =
299 FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
301-- | A handle for a watch.
302getWatchHandle :: FilePath -> IO (HANDLE, FilePath)
303getWatchHandle dir = do
308 (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
309 -- Security attributes
311 -- Create mode, we want to look at an existing directory
313 -- File attribute, NOT using OVERLAPPED since we work synchronously
314 fILE_FLAG_BACKUP_SEMANTICS
319-- For reference documentation see:
321-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
322-- Note that this API uses UTF-16 for file system paths:
323-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
324-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
325foreign import ccall safe
326 "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
334 -> LPOVERLAPPED_COMPLETION_ROUTINE
337readDirectoryChangesW ::
339 -> Ptr FILE_NOTIFY_INFORMATION
342 -> FileNotificationFlag
345readDirectoryChangesW h buf bufSize wst f br =
346 let res = c_ReadDirectoryChangesW
347 h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
348 in failIfFalse_ "ReadDirectoryChangesW" res
350peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
352 neof <- peekByteOff buf 0
353 acti <- peekByteOff buf 4
354 fnle <- peekByteOff buf 8
355 -- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts
356 -- UTF-16 to UTF-32 Char String
357 fnam <- peekCWStringLen
360 -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
361 fromEnum (fnle :: DWORD) `div` 2)
362 return $ FILE_NOTIFY_INFORMATION neof acti fnam
365 Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
366readChangeEvents pfni root bytesRet = do
369 { eventFlags = fniAction fni
370 , eventRelPath = fniFileName fni
371 , eventRootPath = root
372 , totalBytes = bytesRet
374 nioff = fromEnum $ fniNextEntryOffset fni
378 else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
379 return $ entry : entries
381readDirectoryChanges ::
382 String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
383readDirectoryChanges root h wst mask = do
384 let maxBuf = 63 * 1024
385 allocaBytes maxBuf $ \buffer -> do
387 readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
388 bytesRet <- peekByteOff bret 0
389 readChangeEvents buffer root bytesRet
391-- XXX Try to get these from windows header files
392type FileAction = DWORD
394fILE_ACTION_ADDED :: FileAction
397fILE_ACTION_REMOVED :: FileAction
398fILE_ACTION_REMOVED = 2
400fILE_ACTION_MODIFIED :: FileAction
401fILE_ACTION_MODIFIED = 3
403fILE_ACTION_RENAMED_OLD_NAME :: FileAction
404fILE_ACTION_RENAMED_OLD_NAME = 4
406fILE_ACTION_RENAMED_NEW_NAME :: FileAction
407fILE_ACTION_RENAMED_NEW_NAME = 5
409eventStreamAggr :: (HANDLE, FilePath, Config) -> Stream IO Event
410eventStreamAggr (handle, rootPath, cfg) = do
411 let recMode = getConfigRecMode cfg
412 flagMasks = getConfigFlag cfg
413 repeatM = S.sequence . S.repeat
414 S.concatMap S.fromList $ repeatM
415 $ readDirectoryChanges rootPath handle recMode flagMasks
418 NonEmpty FilePath -> Config -> Stream IO (HANDLE, FilePath, Config)
419pathsToHandles paths cfg = do
420 let pathStream = S.fromList (NonEmpty.toList paths)
421 st2 = S.mapM getWatchHandle pathStream
422 fmap (\(h, f) -> (h, f, cfg)) st2
424-------------------------------------------------------------------------------
426-------------------------------------------------------------------------------
428utf8ToString :: Array Word8 -> FilePath
429utf8ToString = runIdentity . S.fold Fold.toList . U.decodeUtf8 . A.read
431utf8ToStringList :: NonEmpty (Array Word8) -> NonEmpty FilePath
432utf8ToStringList = NonEmpty.map utf8ToString
434-- | Close a Directory handle.
436closePathHandleStream :: Stream IO (HANDLE, FilePath, Config) -> IO ()
437closePathHandleStream =
438 let f (h, _, _) = closeHandle h
439 in S.fold (Fold.drainMapM f)
442-- Document the path treatment for Linux/Windows/macOS modules.
443-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
444-- "\" separated bytes, the application can decide what encoding to use.
445-- Instead of always using widechar (-W) APIs can we call the underlying APIs
446-- based on the configured code page?
447-- https://docs.microsoft.com/en-us/windows/uwp/design/globalizing/use-utf8-code-page
449-- | Start monitoring a list of directory paths for file system events with the
450-- supplied configuration modifier operation over the' defaultConfig'. The
451-- paths could be directories or symbolic links to directories.
453-- When recursive mode is True, the whole directory tree under the path is
454-- watched recursively. When recursive mode is False, only the files and
455-- directories directly under the watched directory are monitored, contents of
456-- subdirectories are not monitored. Monitoring starts from the current time
457-- onwards. The paths are specified as UTF-8 encoded 'Array' of 'Word8'.
459-- /Symbolic Links:/ If the pathname to be watched is a symbolic link then
460-- watch the target of the symbolic link instead of the symbolic link itself.
461-- Note that the path location in the events is through the original symbolic
462-- link path rather than the resolved path.
466-- ('setAttrsModified' True . 'setLastWriteTimeModified' False)
467-- [Array.fromList "dir"]
472watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event
474 S.bracketIO before after (S.parConcatMap (eager True) eventStreamAggr)
478 before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig
479 after = closePathHandleStream
481-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
483-- >>> watchRecursive = watchWith (setRecursiveMode True)
487watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event
488watchRecursive = watchWith (setRecursiveMode True)
490-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
492-- >>> watch = watchWith id
496watch :: NonEmpty (Array Word8) -> Stream IO Event
499getFlag :: DWORD -> Event -> Bool
500getFlag mask Event{..} = eventFlags == mask
502-- XXX Change the type to Array Word8 to make it compatible with other APIs.
504-- | Get the file system object path for which the event is generated, relative
505-- to the watched root. The path is a UTF-8 encoded array of bytes.
509getRelPath :: Event -> Array Word8
510getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath
512-- XXX Change the type to Array Word8 to make it compatible with other APIs.
514-- | Get the watch root directory to which this event belongs.
518getRoot :: Event -> Array Word8
519getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
521-- | Get the absolute file system object path for which the event is generated.
523-- When the watch root is a symlink, the absolute path returned is via the
524-- original symlink and not through the resolved path.
528getAbsPath :: Event -> Array Word8
529getAbsPath ev = getRoot ev <> backSlash <> getRelPath ev
530 where backSlash = A.fromList [ fromIntegral (ord '\\') ]
532-- XXX need to document the exact semantics of these.
534-- | This event is generated when a file or directory is created in a watched
535-- directory or directory tree when in recursive watch mode. Creating a hard
536-- link also generates this event.
538-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
542isCreated :: Event -> Bool
543isCreated = getFlag fILE_ACTION_ADDED
545-- | This event is generated when a file or directory is deleted from the
546-- watched directory or directory tree when in recursive mode. This event is
547-- generated even when a hard link is deleted.
549-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
553isDeleted :: Event -> Bool
554isDeleted = getFlag fILE_ACTION_REMOVED
556-- | Generated for the original path when an object is moved from under a
557-- monitored directory.
559-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
563isMovedFrom :: Event -> Bool
564isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
566-- | Generated for the new path when an object is moved under a monitored
569-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
573isMovedTo :: Event -> Bool
574isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
576-- | Generated for a path that is moved from or moved to the monitored
579-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
581-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
582-- /Occurs only for an object inside the watched directory/
586isMoved :: Event -> Bool
587isMoved ev = isMovedFrom ev || isMovedTo ev
589-- XXX This event is generated only for files and not directories?
591-- | This event occurs when a file or directory contents, timestamps or
592-- attributes are modified. Since it can occur on multiple changes, you may
593-- have to check the attributes to know what exactly changed when multiple type
594-- of modified events are enabled.
596-- In non-recursive mode this event does not occur for directories. In
597-- recursive mode this event occurs for the parent directory if a file or
598-- directory inside it is created or renamed.
600-- /Occurs when one of the @set*Modified@ events is enabled/
604isModified :: Event -> Bool
605isModified = getFlag fILE_ACTION_MODIFIED
607-- | If the kernel event buffer overflows, entire contents of the buffer are
608-- discarded, therefore, events are lost. The user application must scan
609-- everything under the watched paths to know the current state of the file
614isEventsLost :: Event -> Bool
615isEventsLost Event{..} = totalBytes == 0
617-------------------------------------------------------------------------------
619-------------------------------------------------------------------------------
621-- | Convert an 'Event' record to a String representation.
622showEvent :: Event -> String
623showEvent ev@Event{..} =
624 "--------------------------"
625 ++ "\nRoot = " ++ utf8ToString (getRoot ev)
626 ++ "\nPath = " ++ utf8ToString (getRelPath ev)
627 ++ "\ngetAbsPath = " ++ utf8ToString (getAbsPath ev)
628 ++ "\nFlags " ++ show eventFlags
629 ++ showev isEventsLost "Overflow"
630 ++ showev isCreated "Created"
631 ++ showev isDeleted "Deleted"
632 ++ showev isModified "Modified"
633 ++ showev isMovedFrom "MovedFrom"
634 ++ showev isMovedTo "MovedTo"
637 where showev f str = if f ev then "\n" ++ str else ""
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list