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 System.Win32.File
102 ( FileNotificationFlag
106 , fILE_FLAG_BACKUP_SEMANTICS
107 , fILE_LIST_DIRECTORY
108 , fILE_NOTIFY_CHANGE_FILE_NAME
109 , fILE_NOTIFY_CHANGE_DIR_NAME
110 , fILE_NOTIFY_CHANGE_ATTRIBUTES
111 , fILE_NOTIFY_CHANGE_SIZE
112 , fILE_NOTIFY_CHANGE_LAST_WRITE
113 , fILE_NOTIFY_CHANGE_SECURITY
118import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
120import Streamly.Data.Array (Array)
121import Streamly.Data.Stream (Stream)
122import Streamly.Data.Stream.Concurrent (eager)
124import qualified Data.List.NonEmpty as NonEmpty
125import qualified Streamly.Data.Array as A (fromList)
126import qualified Streamly.Data.Fold as Fold
127import qualified Streamly.Data.Stream as S
128import qualified Streamly.Data.Stream.Concurrent as S
129import qualified Streamly.Unicode.Stream as U
130import qualified Streamly.Internal.Unicode.Utf8 as UTF8 (pack, toArray)
131import qualified Streamly.Internal.Data.Array as A (read)
133-- | Watch configuration, used to specify the events of interest and the
134-- behavior of the watch.
140 , createFlags :: DWORD
143-------------------------------------------------------------------------------
145-------------------------------------------------------------------------------
147setFlag :: DWORD -> Bool -> Config -> Config
148setFlag mask status cfg@Config{..} =
151 then createFlags .|. mask
152 else createFlags .&. complement mask
153 in cfg {createFlags = flags}
155-- | Set watch event on directory recursively.
161setRecursiveMode :: Bool -> Config -> Config
162setRecursiveMode recursive cfg@Config{} = cfg {watchRec = recursive}
164-- | Generate notify events on file create, rename or delete.
166-- From Windows API documentation: Any file name change in the watched
167-- directory or subtree causes a change notification wait operation to return.
168-- Changes include renaming, creating, or deleting a file.
174setFileNameEvents :: Bool -> Config -> Config
175setFileNameEvents = setFlag fILE_NOTIFY_CHANGE_FILE_NAME
177-- | Generate notify events on directory create, rename or delete.
179-- From Windows API documentaiton: Any directory-name change in the watched
180-- directory or subtree causes a change notification wait operation to return.
181-- Changes include creating or deleting a directory.
187setDirNameEvents :: Bool -> Config -> Config
188setDirNameEvents = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
190-- | Generate an 'isModified' event on any attribute change in the watched
191-- directory or subtree.
197setAttrsModified :: Bool -> Config -> Config
198setAttrsModified = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES
200-- | Generate an 'isModified' event when the file size is changed.
202-- From Windows API documentation: Any file-size change in the watched
203-- directory or subtree causes a change notification wait operation to return.
204-- The operating system detects a change in file size only when the file is
205-- written to the disk. For operating systems that use extensive caching,
206-- detection occurs only when the cache is sufficiently flushed.
212setSizeModified :: Bool -> Config -> Config
213setSizeModified = setFlag fILE_NOTIFY_CHANGE_SIZE
215-- | Generate an 'isModified' event when the last write timestamp of the file
218-- From Windows API documentation: Any change to the last write-time of files
219-- in the watched directory or subtree causes a change notification wait
220-- operation to return. The operating system detects a change to the last
221-- write-time only when the file is written to the disk. For operating systems
222-- that use extensive caching, detection occurs only when the cache is
223-- sufficiently flushed.
229setLastWriteTimeModified :: Bool -> Config -> Config
230setLastWriteTimeModified = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
232-- | Generate an 'isModified' event when any security-descriptor change occurs
233-- in the watched directory or subtree.
239setSecurityModified :: Bool -> Config -> Config
240setSecurityModified = setFlag fILE_NOTIFY_CHANGE_SECURITY
242-- | Set all tunable events 'True' or 'False'. Equivalent to setting:
244-- * setFileNameEvents
248-- * setLastWriteTimeModified
249-- * setSecurityModified
253setAllEvents :: Bool -> Config -> Config
259 . setLastWriteTimeModified s
260 . setSecurityModified s
262-- | The tunable events that are enabled by default are:
264-- * setFileNameEvents True
265-- * setDirNameEvents True
266-- * setSizeModified True
267-- * setLastWriteTimeModified True
271defaultConfig :: Config
273 setFileNameEvents True
274 $ setDirNameEvents True
275 $ setSizeModified True
276 $ setLastWriteTimeModified True
277 $ Config {watchRec = False, createFlags = 0}
279getConfigFlag :: Config -> DWORD
280getConfigFlag Config{..} = createFlags
282getConfigRecMode :: Config -> BOOL
283getConfigRecMode Config{..} = watchRec
286 { eventFlags :: DWORD
287 , eventRelPath :: String
288 , eventRootPath :: String
289 , totalBytes :: DWORD
290 } deriving (Show, Ord, Eq)
292-- For reference documentation see:
294-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
295data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
296 { fniNextEntryOffset :: DWORD
298 , fniFileName :: String
301type LPOVERLAPPED_COMPLETION_ROUTINE =
302 FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
304-- | A handle for a watch.
305getWatchHandle :: FilePath -> IO (HANDLE, FilePath)
306getWatchHandle dir = do
311 (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
312 -- Security attributes
314 -- Create mode, we want to look at an existing directory
316 -- File attribute, NOT using OVERLAPPED since we work synchronously
317 fILE_FLAG_BACKUP_SEMANTICS
322-- For reference documentation see:
324-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
325-- Note that this API uses UTF-16 for file system paths:
326-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
327-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
328foreign import ccall safe
329 "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
337 -> LPOVERLAPPED_COMPLETION_ROUTINE
340readDirectoryChangesW ::
342 -> Ptr FILE_NOTIFY_INFORMATION
345 -> FileNotificationFlag
348readDirectoryChangesW h buf bufSize wst f br =
349 let res = c_ReadDirectoryChangesW
350 h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
351 in failIfFalse_ "ReadDirectoryChangesW" res
353peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
355 neof <- peekByteOff buf 0
356 acti <- peekByteOff buf 4
357 fnle <- peekByteOff buf 8
358 -- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts
359 -- UTF-16 to UTF-32 Char String
360 fnam <- peekCWStringLen
363 -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
364 fromEnum (fnle :: DWORD) `div` 2)
365 return $ FILE_NOTIFY_INFORMATION neof acti fnam
368 Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
369readChangeEvents pfni root bytesRet = do
372 { eventFlags = fniAction fni
373 , eventRelPath = fniFileName fni
374 , eventRootPath = root
375 , totalBytes = bytesRet
377 nioff = fromEnum $ fniNextEntryOffset fni
381 else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
382 return $ entry : entries
384readDirectoryChanges ::
385 String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
386readDirectoryChanges root h wst mask = do
387 let maxBuf = 63 * 1024
388 allocaBytes maxBuf $ \buffer -> do
390 readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
391 bytesRet <- peekByteOff bret 0
392 readChangeEvents buffer root bytesRet
394-- XXX Try to get these from windows header files
395type FileAction = DWORD
397fILE_ACTION_ADDED :: FileAction
400fILE_ACTION_REMOVED :: FileAction
401fILE_ACTION_REMOVED = 2
403fILE_ACTION_MODIFIED :: FileAction
404fILE_ACTION_MODIFIED = 3
406fILE_ACTION_RENAMED_OLD_NAME :: FileAction
407fILE_ACTION_RENAMED_OLD_NAME = 4
409fILE_ACTION_RENAMED_NEW_NAME :: FileAction
410fILE_ACTION_RENAMED_NEW_NAME = 5
412eventStreamAggr :: (HANDLE, FilePath, Config) -> Stream IO Event
413eventStreamAggr (handle, rootPath, cfg) = do
414 let recMode = getConfigRecMode cfg
415 flagMasks = getConfigFlag cfg
416 repeatM = S.sequence . S.repeat
417 S.concatMap S.fromList $ repeatM
418 $ readDirectoryChanges rootPath handle recMode flagMasks
421 NonEmpty FilePath -> Config -> Stream IO (HANDLE, FilePath, Config)
422pathsToHandles paths cfg = do
423 let pathStream = S.fromList (NonEmpty.toList paths)
424 st2 = S.mapM getWatchHandle pathStream
425 fmap (\(h, f) -> (h, f, cfg)) st2
427-------------------------------------------------------------------------------
429-------------------------------------------------------------------------------
431utf8ToString :: Array Word8 -> FilePath
432utf8ToString = runIdentity . S.fold Fold.toList . U.decodeUtf8 . A.read
434utf8ToStringList :: NonEmpty (Array Word8) -> NonEmpty FilePath
435utf8ToStringList = NonEmpty.map utf8ToString
437-- | Close a Directory handle.
439closePathHandleStream :: Stream IO (HANDLE, FilePath, Config) -> IO ()
440closePathHandleStream =
441 let f (h, _, _) = closeHandle h
442 in S.fold (Fold.drainMapM f)
445-- Document the path treatment for Linux/Windows/macOS modules.
446-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
447-- "\" separated bytes, the application can decide what encoding to use.
448-- Instead of always using widechar (-W) APIs can we call the underlying APIs
449-- based on the configured code page?
450-- https://docs.microsoft.com/en-us/windows/uwp/design/globalizing/use-utf8-code-page
452-- | Start monitoring a list of directory paths for file system events with the
453-- supplied configuration modifier operation over the' defaultConfig'. The
454-- paths could be directories or symbolic links to directories.
456-- When recursive mode is True, the whole directory tree under the path is
457-- watched recursively. When recursive mode is False, only the files and
458-- directories directly under the watched directory are monitored, contents of
459-- subdirectories are not monitored. Monitoring starts from the current time
460-- onwards. The paths are specified as UTF-8 encoded 'Array' of 'Word8'.
462-- /Symbolic Links:/ If the pathname to be watched is a symbolic link then
463-- watch the target of the symbolic link instead of the symbolic link itself.
464-- Note that the path location in the events is through the original symbolic
465-- link path rather than the resolved path.
469-- ('setAttrsModified' True . 'setLastWriteTimeModified' False)
470-- [Array.fromList "dir"]
475watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event
477 S.bracketIO before after (S.parConcatMap (eager True) eventStreamAggr)
481 before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig
482 after = closePathHandleStream
484-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
486-- >>> watchRecursive = watchWith (setRecursiveMode True)
490watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event
491watchRecursive = watchWith (setRecursiveMode True)
493-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
495-- >>> watch = watchWith id
499watch :: NonEmpty (Array Word8) -> Stream IO Event
502getFlag :: DWORD -> Event -> Bool
503getFlag mask Event{..} = eventFlags == mask
505-- XXX Change the type to Array Word8 to make it compatible with other APIs.
507-- | Get the file system object path for which the event is generated, relative
508-- to the watched root. The path is a UTF-8 encoded array of bytes.
512getRelPath :: Event -> Array Word8
513getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath
515-- XXX Change the type to Array Word8 to make it compatible with other APIs.
517-- | Get the watch root directory to which this event belongs.
521getRoot :: Event -> Array Word8
522getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
524-- | Get the absolute file system object path for which the event is generated.
526-- When the watch root is a symlink, the absolute path returned is via the
527-- original symlink and not through the resolved path.
531getAbsPath :: Event -> Array Word8
532getAbsPath ev = getRoot ev <> backSlash <> getRelPath ev
533 where backSlash = A.fromList [ fromIntegral (ord '\\') ]
535-- XXX need to document the exact semantics of these.
537-- | This event is generated when a file or directory is created in a watched
538-- directory or directory tree when in recursive watch mode. Creating a hard
539-- link also generates this event.
541-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
545isCreated :: Event -> Bool
546isCreated = getFlag fILE_ACTION_ADDED
548-- | This event is generated when a file or directory is deleted from the
549-- watched directory or directory tree when in recursive mode. This event is
550-- generated even when a hard link is deleted.
552-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
556isDeleted :: Event -> Bool
557isDeleted = getFlag fILE_ACTION_REMOVED
559-- | Generated for the original path when an object is moved from under a
560-- monitored directory.
562-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
566isMovedFrom :: Event -> Bool
567isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
569-- | Generated for the new path when an object is moved under a monitored
572-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
576isMovedTo :: Event -> Bool
577isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
579-- | Generated for a path that is moved from or moved to the monitored
582-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
584-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
585-- /Occurs only for an object inside the watched directory/
589isMoved :: Event -> Bool
590isMoved ev = isMovedFrom ev || isMovedTo ev
592-- XXX This event is generated only for files and not directories?
594-- | This event occurs when a file or directory contents, timestamps or
595-- attributes are modified. Since it can occur on multiple changes, you may
596-- have to check the attributes to know what exactly changed when multiple type
597-- of modified events are enabled.
599-- In non-recursive mode this event does not occur for directories. In
600-- recursive mode this event occurs for the parent directory if a file or
601-- directory inside it is created or renamed.
603-- /Occurs when one of the @set*Modified@ events is enabled/
607isModified :: Event -> Bool
608isModified = getFlag fILE_ACTION_MODIFIED
610-- | If the kernel event buffer overflows, entire contents of the buffer are
611-- discarded, therefore, events are lost. The user application must scan
612-- everything under the watched paths to know the current state of the file
617isEventsLost :: Event -> Bool
618isEventsLost Event{..} = totalBytes == 0
620-------------------------------------------------------------------------------
622-------------------------------------------------------------------------------
624-- | Convert an 'Event' record to a String representation.
625showEvent :: Event -> String
626showEvent ev@Event{..} =
627 "--------------------------"
628 ++ "\nRoot = " ++ utf8ToString (getRoot ev)
629 ++ "\nPath = " ++ utf8ToString (getRelPath ev)
630 ++ "\ngetAbsPath = " ++ utf8ToString (getAbsPath ev)
631 ++ "\nFlags " ++ show eventFlags
632 ++ showev isEventsLost "Overflow"
633 ++ showev isCreated "Created"
634 ++ showev isDeleted "Deleted"
635 ++ showev isModified "Modified"
636 ++ showev isMovedFrom "MovedFrom"
637 ++ showev isMovedTo "MovedTo"
640 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