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
57 -- ** Events of Interest
63 , setLastWriteTimeModified
77 -- ** Item CRUD events
85 -- ** Exception Conditions
93import Control.Monad.IO.Class (MonadIO(liftIO))
94import Data.Bits ((.|.), (.&.), complement)
96import Data.Functor.Identity (runIdentity)
97import Data.List.NonEmpty (NonEmpty)
98import Data.Word (Word8)
99import Foreign.C.String (peekCWStringLen)
100import Foreign.Marshal.Alloc (alloca, allocaBytes)
101import Foreign.Storable (peekByteOff)
102import Foreign.Ptr (Ptr, FunPtr, castPtr, nullPtr, nullFunPtr, plusPtr)
103import Streamly.Prelude (SerialT, parallel)
104import System.Win32.File
105 ( FileNotificationFlag
109 , fILE_FLAG_BACKUP_SEMANTICS
110 , fILE_LIST_DIRECTORY
111 , fILE_NOTIFY_CHANGE_FILE_NAME
112 , fILE_NOTIFY_CHANGE_DIR_NAME
113 , fILE_NOTIFY_CHANGE_ATTRIBUTES
114 , fILE_NOTIFY_CHANGE_SIZE
115 , fILE_NOTIFY_CHANGE_LAST_WRITE
116 , fILE_NOTIFY_CHANGE_SECURITY
121import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
122import qualified Data.List.NonEmpty as NonEmpty
123import qualified Streamly.Internal.Data.Stream.IsStream as S
124import qualified Streamly.Internal.Unicode.Stream as U
125import qualified Streamly.Internal.Unicode.Utf8 as UTF8
126import qualified Streamly.Internal.Data.Array.Unboxed as A
127import Streamly.Internal.Data.Array.Unboxed (Array)
129-- | Watch configuration, used to specify the events of interest and the
130-- behavior of the watch.
136 , createFlags :: DWORD
139-------------------------------------------------------------------------------
141-------------------------------------------------------------------------------
143-- | Whether a setting is 'On' or 'Off'.
147data Switch = On | Off deriving (Show, Eq)
149setFlag :: DWORD -> Switch -> Config -> Config
150setFlag mask status cfg@Config{..} =
153 On -> createFlags .|. mask
154 Off -> createFlags .&. complement mask
155 in cfg {createFlags = flags}
157-- | Set watch event on directory recursively.
163setRecursiveMode :: Switch -> Config -> Config
164setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}
166-- | Generate notify events on file create, rename or delete.
168-- From Windows API documentation: Any file name change in the watched
169-- directory or subtree causes a change notification wait operation to return.
170-- Changes include renaming, creating, or deleting a file.
176setFileNameEvents :: Switch -> Config -> Config
177setFileNameEvents = setFlag fILE_NOTIFY_CHANGE_FILE_NAME
179-- | Generate notify events on directory create, rename or delete.
181-- From Windows API documentaiton: Any directory-name change in the watched
182-- directory or subtree causes a change notification wait operation to return.
183-- Changes include creating or deleting a directory.
189setDirNameEvents :: Switch -> Config -> Config
190setDirNameEvents = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
192-- | Generate an 'isModified' event on any attribute change in the watched
193-- directory or subtree.
199setAttrsModified :: Switch -> Config -> Config
200setAttrsModified = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES
202-- | Generate an 'isModified' event when the file size is changed.
204-- From Windows API documentation: Any file-size change in the watched
205-- directory or subtree causes a change notification wait operation to return.
206-- The operating system detects a change in file size only when the file is
207-- written to the disk. For operating systems that use extensive caching,
208-- detection occurs only when the cache is sufficiently flushed.
214setSizeModified :: Switch -> Config -> Config
215setSizeModified = setFlag fILE_NOTIFY_CHANGE_SIZE
217-- | Generate an 'isModified' event when the last write timestamp of the file
220-- From Windows API documentation: Any change to the last write-time of files
221-- in the watched directory or subtree causes a change notification wait
222-- operation to return. The operating system detects a change to the last
223-- write-time only when the file is written to the disk. For operating systems
224-- that use extensive caching, detection occurs only when the cache is
225-- sufficiently flushed.
231setLastWriteTimeModified :: Switch -> Config -> Config
232setLastWriteTimeModified = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
234-- | Generate an 'isModified' event when any security-descriptor change occurs
235-- in the watched directory or subtree.
241setSecurityModified :: Switch -> Config -> Config
242setSecurityModified = setFlag fILE_NOTIFY_CHANGE_SECURITY
244-- | Set all tunable events 'On' or 'Off'. Equivalent to setting:
246-- * setFileNameEvents
250-- * setLastWriteTimeModified
251-- * setSecurityModified
255setAllEvents :: Switch -> Config -> Config
261 . setLastWriteTimeModified s
262 . setSecurityModified s
264-- | The tunable events that are enabled by default are:
266-- * setFileNameEvents On
267-- * setDirNameEvents On
268-- * setSizeModified On
269-- * setLastWriteTimeModified On
273defaultConfig :: Config
276 $ setDirNameEvents On
278 $ setLastWriteTimeModified On
279 $ Config {watchRec = False, createFlags = 0}
281getConfigFlag :: Config -> DWORD
282getConfigFlag Config{..} = createFlags
284getConfigRecMode :: Config -> BOOL
285getConfigRecMode Config{..} = watchRec
288 { eventFlags :: DWORD
289 , eventRelPath :: String
290 , eventRootPath :: String
291 , totalBytes :: DWORD
292 } deriving (Show, Ord, Eq)
294-- For reference documentation see:
296-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
297data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
298 { fniNextEntryOffset :: DWORD
300 , fniFileName :: String
303type LPOVERLAPPED_COMPLETION_ROUTINE =
304 FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
306-- | A handle for a watch.
307getWatchHandle :: FilePath -> IO (HANDLE, FilePath)
308getWatchHandle dir = do
313 (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
314 -- Security attributes
316 -- Create mode, we want to look at an existing directory
318 -- File attribute, NOT using OVERLAPPED since we work synchronously
319 fILE_FLAG_BACKUP_SEMANTICS
324-- For reference documentation see:
326-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
327-- Note that this API uses UTF-16 for file system paths:
328-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
329-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
330foreign import ccall safe
331 "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
339 -> LPOVERLAPPED_COMPLETION_ROUTINE
342readDirectoryChangesW ::
344 -> Ptr FILE_NOTIFY_INFORMATION
347 -> FileNotificationFlag
350readDirectoryChangesW h buf bufSize wst f br =
351 let res = c_ReadDirectoryChangesW
352 h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
353 in failIfFalse_ "ReadDirectoryChangesW" res
355peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
357 neof <- peekByteOff buf 0
358 acti <- peekByteOff buf 4
359 fnle <- peekByteOff buf 8
360 -- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts
361 -- UTF-16 to UTF-32 Char String
362 fnam <- peekCWStringLen
365 -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
366 fromEnum (fnle :: DWORD) `div` 2)
367 return $ FILE_NOTIFY_INFORMATION neof acti fnam
370 Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
371readChangeEvents pfni root bytesRet = do
374 { eventFlags = fniAction fni
375 , eventRelPath = fniFileName fni
376 , eventRootPath = root
377 , totalBytes = bytesRet
379 nioff = fromEnum $ fniNextEntryOffset fni
383 else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
384 return $ entry : entries
386readDirectoryChanges ::
387 String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
388readDirectoryChanges root h wst mask = do
389 let maxBuf = 63 * 1024
390 allocaBytes maxBuf $ \buffer -> do
392 readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
393 bytesRet <- peekByteOff bret 0
394 readChangeEvents buffer root bytesRet
396-- XXX Try to get these from windows header files
397type FileAction = DWORD
399fILE_ACTION_ADDED :: FileAction
402fILE_ACTION_REMOVED :: FileAction
403fILE_ACTION_REMOVED = 2
405fILE_ACTION_MODIFIED :: FileAction
406fILE_ACTION_MODIFIED = 3
408fILE_ACTION_RENAMED_OLD_NAME :: FileAction
409fILE_ACTION_RENAMED_OLD_NAME = 4
411fILE_ACTION_RENAMED_NEW_NAME :: FileAction
412fILE_ACTION_RENAMED_NEW_NAME = 5
414eventStreamAggr :: (HANDLE, FilePath, Config) -> SerialT IO Event
415eventStreamAggr (handle, rootPath, cfg) = do
416 let recMode = getConfigRecMode cfg
417 flagMasks = getConfigFlag cfg
418 S.concatMap S.fromList $ S.repeatM
419 $ readDirectoryChanges rootPath handle recMode flagMasks
422 NonEmpty FilePath -> Config -> SerialT IO (HANDLE, FilePath, Config)
423pathsToHandles paths cfg = do
424 let pathStream = S.fromList (NonEmpty.toList paths)
425 st2 = S.mapM getWatchHandle pathStream
426 S.map (\(h, f) -> (h, f, cfg)) st2
428-------------------------------------------------------------------------------
430-------------------------------------------------------------------------------
432utf8ToString :: Array Word8 -> FilePath
433utf8ToString = runIdentity . S.toList . U.decodeUtf8 . A.toStream
435utf8ToStringList :: NonEmpty (Array Word8) -> NonEmpty FilePath
436utf8ToStringList = NonEmpty.map utf8ToString
438-- | Close a Directory handle.
440closePathHandleStream :: SerialT IO (HANDLE, FilePath, Config) -> IO ()
441closePathHandleStream = S.mapM_ (\(h, _, _) -> closeHandle h)
444-- Document the path treatment for Linux/Windows/macOS modules.
445-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
446-- "\" separated bytes, the application can decide what encoding to use.
447-- Instead of always using widechar (-W) APIs can we call the underlying APIs
448-- based on the configured code page?
449-- https://docs.microsoft.com/en-us/windows/uwp/design/globalizing/use-utf8-code-page
451-- | Start monitoring a list of directory paths for file system events with the
452-- supplied configuration modifier operation over the' defaultConfig'. The
453-- paths could be directories or symbolic links to directories.
455-- When recursive mode is True, the whole directory tree under the path is
456-- watched recursively. When recursive mode is False, only the files and
457-- directories directly under the watched directory are monitored, contents of
458-- subdirectories are not monitored. Monitoring starts from the current time
459-- onwards. The paths are specified as UTF-8 encoded 'Array' of 'Word8'.
461-- /Symbolic Links:/ If the pathname to be watched is a symbolic link then
462-- watch the target of the symbolic link instead of the symbolic link itself.
463-- Note that the path location in the events is through the original symbolic
464-- link path rather than the resolved path.
468-- ('setAttrsModified' On . 'setLastWriteTimeModified' Off)
469-- [Array.fromList "dir"]
474watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> SerialT IO Event
476 S.bracket before after (S.concatMapWith parallel eventStreamAggr)
480 before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig
481 after = liftIO . closePathHandleStream
483-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
485-- >>> watchRecursive = watchWith (setRecursiveMode On)
489watchRecursive :: NonEmpty (Array Word8) -> SerialT IO Event
490watchRecursive = watchWith (setRecursiveMode On)
492-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
494-- >>> watch = watchWith id
498watch :: NonEmpty (Array Word8) -> SerialT IO Event
501getFlag :: DWORD -> Event -> Bool
502getFlag mask Event{..} = eventFlags == mask
504-- XXX Change the type to Array Word8 to make it compatible with other APIs.
506-- | Get the file system object path for which the event is generated, relative
507-- to the watched root. The path is a UTF-8 encoded array of bytes.
511getRelPath :: Event -> Array Word8
512getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath
514-- XXX Change the type to Array Word8 to make it compatible with other APIs.
516-- | Get the watch root directory to which this event belongs.
520getRoot :: Event -> Array Word8
521getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
523-- | Get the absolute file system object path for which the event is generated.
525-- When the watch root is a symlink, the absolute path returned is via the
526-- original symlink and not through the resolved path.
530getAbsPath :: Event -> Array Word8
531getAbsPath ev = getRoot ev <> backSlash <> getRelPath ev
532 where backSlash = A.fromList [ fromIntegral (ord '\\') ]
534-- XXX need to document the exact semantics of these.
536-- | This event is generated when a file or directory is created in a watched
537-- directory or directory tree when in recursive watch mode. Creating a hard
538-- link also generates this event.
540-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
544isCreated :: Event -> Bool
545isCreated = getFlag fILE_ACTION_ADDED
547-- | This event is generated when a file or directory is deleted from the
548-- watched directory or directory tree when in recursive mode. This event is
549-- generated even when a hard link is deleted.
551-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
555isDeleted :: Event -> Bool
556isDeleted = getFlag fILE_ACTION_REMOVED
558-- | Generated for the original path when an object is moved from under a
559-- monitored directory.
561-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
565isMovedFrom :: Event -> Bool
566isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
568-- | Generated for the new path when an object is moved under a monitored
571-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
575isMovedTo :: Event -> Bool
576isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
578-- | Generated for a path that is moved from or moved to the monitored
581-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
583-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
584-- /Occurs only for an object inside the watched directory/
588isMoved :: Event -> Bool
589isMoved ev = isMovedFrom ev || isMovedTo ev
591-- XXX This event is generated only for files and not directories?
593-- | This event occurs when a file or directory contents, timestamps or
594-- attributes are modified. Since it can occur on multiple changes, you may
595-- have to check the attributes to know what exactly changed when multiple type
596-- of modified events are enabled.
598-- In non-recursive mode this event does not occur for directories. In
599-- recursive mode this event occurs for the parent directory if a file or
600-- directory inside it is created or renamed.
602-- /Occurs when one of the @set*Modified@ events is enabled/
606isModified :: Event -> Bool
607isModified = getFlag fILE_ACTION_MODIFIED
609-- | If the kernel event buffer overflows, entire contents of the buffer are
610-- discarded, therefore, events are lost. The user application must scan
611-- everything under the watched paths to know the current state of the file
616isEventsLost :: Event -> Bool
617isEventsLost Event{..} = totalBytes == 0
619-------------------------------------------------------------------------------
621-------------------------------------------------------------------------------
623-- | Convert an 'Event' record to a String representation.
624showEvent :: Event -> String
625showEvent ev@Event{..} =
626 "--------------------------"
627 ++ "\nRoot = " ++ utf8ToString (getRoot ev)
628 ++ "\nPath = " ++ utf8ToString (getRelPath ev)
629 ++ "\ngetAbsPath = " ++ utf8ToString (getAbsPath ev)
630 ++ "\nFlags " ++ show eventFlags
631 ++ showev isEventsLost "Overflow"
632 ++ showev isCreated "Created"
633 ++ showev isDeleted "Deleted"
634 ++ showev isModified "Modified"
635 ++ showev isMovedFrom "MovedFrom"
636 ++ showev isMovedTo "MovedTo"
639 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