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.Internal.Data.Stream (Stream)
104import Streamly.Prelude (parallel)
105import System.Win32.File
106 ( FileNotificationFlag
110 , fILE_FLAG_BACKUP_SEMANTICS
111 , fILE_LIST_DIRECTORY
112 , fILE_NOTIFY_CHANGE_FILE_NAME
113 , fILE_NOTIFY_CHANGE_DIR_NAME
114 , fILE_NOTIFY_CHANGE_ATTRIBUTES
115 , fILE_NOTIFY_CHANGE_SIZE
116 , fILE_NOTIFY_CHANGE_LAST_WRITE
117 , fILE_NOTIFY_CHANGE_SECURITY
122import System.Win32.Types (BOOL, DWORD, HANDLE, LPVOID, LPDWORD, failIfFalse_)
123import qualified Data.List.NonEmpty as NonEmpty
124import qualified Streamly.Data.Fold as Fold
125import qualified Streamly.Internal.Data.Stream as S
126import qualified Streamly.Internal.Unicode.Stream as U
127import qualified Streamly.Internal.Unicode.Utf8 as UTF8
128import qualified Streamly.Internal.Data.Array.Unboxed as A
129import Streamly.Internal.Data.Array.Unboxed (Array)
131-- | Watch configuration, used to specify the events of interest and the
132-- behavior of the watch.
138 , createFlags :: DWORD
141-------------------------------------------------------------------------------
143-------------------------------------------------------------------------------
145-- | Whether a setting is 'On' or 'Off'.
149data Switch = On | Off deriving (Show, Eq)
151setFlag :: DWORD -> Switch -> Config -> Config
152setFlag mask status cfg@Config{..} =
155 On -> createFlags .|. mask
156 Off -> createFlags .&. complement mask
157 in cfg {createFlags = flags}
159-- | Set watch event on directory recursively.
165setRecursiveMode :: Switch -> Config -> Config
166setRecursiveMode rec cfg@Config{} = cfg {watchRec = rec == On}
168-- | Generate notify events on file create, rename or delete.
170-- From Windows API documentation: Any file name change in the watched
171-- directory or subtree causes a change notification wait operation to return.
172-- Changes include renaming, creating, or deleting a file.
178setFileNameEvents :: Switch -> Config -> Config
179setFileNameEvents = setFlag fILE_NOTIFY_CHANGE_FILE_NAME
181-- | Generate notify events on directory create, rename or delete.
183-- From Windows API documentaiton: Any directory-name change in the watched
184-- directory or subtree causes a change notification wait operation to return.
185-- Changes include creating or deleting a directory.
191setDirNameEvents :: Switch -> Config -> Config
192setDirNameEvents = setFlag fILE_NOTIFY_CHANGE_DIR_NAME
194-- | Generate an 'isModified' event on any attribute change in the watched
195-- directory or subtree.
201setAttrsModified :: Switch -> Config -> Config
202setAttrsModified = setFlag fILE_NOTIFY_CHANGE_ATTRIBUTES
204-- | Generate an 'isModified' event when the file size is changed.
206-- From Windows API documentation: Any file-size change in the watched
207-- directory or subtree causes a change notification wait operation to return.
208-- The operating system detects a change in file size only when the file is
209-- written to the disk. For operating systems that use extensive caching,
210-- detection occurs only when the cache is sufficiently flushed.
216setSizeModified :: Switch -> Config -> Config
217setSizeModified = setFlag fILE_NOTIFY_CHANGE_SIZE
219-- | Generate an 'isModified' event when the last write timestamp of the file
222-- From Windows API documentation: Any change to the last write-time of files
223-- in the watched directory or subtree causes a change notification wait
224-- operation to return. The operating system detects a change to the last
225-- write-time only when the file is written to the disk. For operating systems
226-- that use extensive caching, detection occurs only when the cache is
227-- sufficiently flushed.
233setLastWriteTimeModified :: Switch -> Config -> Config
234setLastWriteTimeModified = setFlag fILE_NOTIFY_CHANGE_LAST_WRITE
236-- | Generate an 'isModified' event when any security-descriptor change occurs
237-- in the watched directory or subtree.
243setSecurityModified :: Switch -> Config -> Config
244setSecurityModified = setFlag fILE_NOTIFY_CHANGE_SECURITY
246-- | Set all tunable events 'On' or 'Off'. Equivalent to setting:
248-- * setFileNameEvents
252-- * setLastWriteTimeModified
253-- * setSecurityModified
257setAllEvents :: Switch -> Config -> Config
263 . setLastWriteTimeModified s
264 . setSecurityModified s
266-- | The tunable events that are enabled by default are:
268-- * setFileNameEvents On
269-- * setDirNameEvents On
270-- * setSizeModified On
271-- * setLastWriteTimeModified On
275defaultConfig :: Config
278 $ setDirNameEvents On
280 $ setLastWriteTimeModified On
281 $ Config {watchRec = False, createFlags = 0}
283getConfigFlag :: Config -> DWORD
284getConfigFlag Config{..} = createFlags
286getConfigRecMode :: Config -> BOOL
287getConfigRecMode Config{..} = watchRec
290 { eventFlags :: DWORD
291 , eventRelPath :: String
292 , eventRootPath :: String
293 , totalBytes :: DWORD
294 } deriving (Show, Ord, Eq)
296-- For reference documentation see:
298-- See https://docs.microsoft.com/en-us/windows/win32/api/winnt/ns-winnt-file_notify_information
299data FILE_NOTIFY_INFORMATION = FILE_NOTIFY_INFORMATION
300 { fniNextEntryOffset :: DWORD
302 , fniFileName :: String
305type LPOVERLAPPED_COMPLETION_ROUTINE =
306 FunPtr ((DWORD, DWORD, LPOVERLAPPED) -> IO ())
308-- | A handle for a watch.
309getWatchHandle :: FilePath -> IO (HANDLE, FilePath)
310getWatchHandle dir = do
315 (fILE_SHARE_READ .|. fILE_SHARE_WRITE)
316 -- Security attributes
318 -- Create mode, we want to look at an existing directory
320 -- File attribute, NOT using OVERLAPPED since we work synchronously
321 fILE_FLAG_BACKUP_SEMANTICS
326-- For reference documentation see:
328-- See https://docs.microsoft.com/en-us/windows/win32/api/winbase/nf-winbase-readdirectorychangesw
329-- Note that this API uses UTF-16 for file system paths:
330-- 1. https://docs.microsoft.com/en-us/windows/win32/intl/unicode-in-the-windows-api
331-- 2. https://docs.microsoft.com/en-us/windows/win32/intl/unicode
332foreign import ccall safe
333 "windows.h ReadDirectoryChangesW" c_ReadDirectoryChangesW ::
341 -> LPOVERLAPPED_COMPLETION_ROUTINE
344readDirectoryChangesW ::
346 -> Ptr FILE_NOTIFY_INFORMATION
349 -> FileNotificationFlag
352readDirectoryChangesW h buf bufSize wst f br =
353 let res = c_ReadDirectoryChangesW
354 h (castPtr buf) bufSize wst f br nullPtr nullFunPtr
355 in failIfFalse_ "ReadDirectoryChangesW" res
357peekFNI :: Ptr FILE_NOTIFY_INFORMATION -> IO FILE_NOTIFY_INFORMATION
359 neof <- peekByteOff buf 0
360 acti <- peekByteOff buf 4
361 fnle <- peekByteOff buf 8
362 -- Note: The path is UTF-16 encoded C WChars, peekCWStringLen converts
363 -- UTF-16 to UTF-32 Char String
364 fnam <- peekCWStringLen
367 -- fnle is the length in *bytes*, and a WCHAR is 2 bytes
368 fromEnum (fnle :: DWORD) `div` 2)
369 return $ FILE_NOTIFY_INFORMATION neof acti fnam
372 Ptr FILE_NOTIFY_INFORMATION -> String -> DWORD -> IO [Event]
373readChangeEvents pfni root bytesRet = do
376 { eventFlags = fniAction fni
377 , eventRelPath = fniFileName fni
378 , eventRootPath = root
379 , totalBytes = bytesRet
381 nioff = fromEnum $ fniNextEntryOffset fni
385 else readChangeEvents (pfni `plusPtr` nioff) root bytesRet
386 return $ entry : entries
388readDirectoryChanges ::
389 String -> HANDLE -> Bool -> FileNotificationFlag -> IO [Event]
390readDirectoryChanges root h wst mask = do
391 let maxBuf = 63 * 1024
392 allocaBytes maxBuf $ \buffer -> do
394 readDirectoryChangesW h buffer (toEnum maxBuf) wst mask bret
395 bytesRet <- peekByteOff bret 0
396 readChangeEvents buffer root bytesRet
398-- XXX Try to get these from windows header files
399type FileAction = DWORD
401fILE_ACTION_ADDED :: FileAction
404fILE_ACTION_REMOVED :: FileAction
405fILE_ACTION_REMOVED = 2
407fILE_ACTION_MODIFIED :: FileAction
408fILE_ACTION_MODIFIED = 3
410fILE_ACTION_RENAMED_OLD_NAME :: FileAction
411fILE_ACTION_RENAMED_OLD_NAME = 4
413fILE_ACTION_RENAMED_NEW_NAME :: FileAction
414fILE_ACTION_RENAMED_NEW_NAME = 5
416eventStreamAggr :: (HANDLE, FilePath, Config) -> Stream IO Event
417eventStreamAggr (handle, rootPath, cfg) = do
418 let recMode = getConfigRecMode cfg
419 flagMasks = getConfigFlag cfg
420 repeatM = S.sequence . S.repeat
421 S.concatMap S.fromList $ repeatM
422 $ readDirectoryChanges rootPath handle recMode flagMasks
425 NonEmpty FilePath -> Config -> Stream IO (HANDLE, FilePath, Config)
426pathsToHandles paths cfg = do
427 let pathStream = S.fromList (NonEmpty.toList paths)
428 st2 = S.mapM getWatchHandle pathStream
429 fmap (\(h, f) -> (h, f, cfg)) st2
431-------------------------------------------------------------------------------
433-------------------------------------------------------------------------------
435utf8ToString :: Array Word8 -> FilePath
436utf8ToString = runIdentity . S.fold Fold.toList . U.decodeUtf8 . A.toStream
438utf8ToStringList :: NonEmpty (Array Word8) -> NonEmpty FilePath
439utf8ToStringList = NonEmpty.map utf8ToString
441-- | Close a Directory handle.
443closePathHandleStream :: Stream IO (HANDLE, FilePath, Config) -> IO ()
444closePathHandleStream =
445 let f (h, _, _) = closeHandle h
446 in S.fold (Fold.drainBy f)
449-- Document the path treatment for Linux/Windows/macOS modules.
450-- Remove the utf-8 encoding requirement of paths? It can be encoding agnostic
451-- "\" separated bytes, the application can decide what encoding to use.
452-- Instead of always using widechar (-W) APIs can we call the underlying APIs
453-- based on the configured code page?
454-- https://docs.microsoft.com/en-us/windows/uwp/design/globalizing/use-utf8-code-page
456-- | Start monitoring a list of directory paths for file system events with the
457-- supplied configuration modifier operation over the' defaultConfig'. The
458-- paths could be directories or symbolic links to directories.
460-- When recursive mode is True, the whole directory tree under the path is
461-- watched recursively. When recursive mode is False, only the files and
462-- directories directly under the watched directory are monitored, contents of
463-- subdirectories are not monitored. Monitoring starts from the current time
464-- onwards. The paths are specified as UTF-8 encoded 'Array' of 'Word8'.
466-- /Symbolic Links:/ If the pathname to be watched is a symbolic link then
467-- watch the target of the symbolic link instead of the symbolic link itself.
468-- Note that the path location in the events is through the original symbolic
469-- link path rather than the resolved path.
473-- ('setAttrsModified' On . 'setLastWriteTimeModified' Off)
474-- [Array.fromList "dir"]
479watchWith :: (Config -> Config) -> NonEmpty (Array Word8) -> Stream IO Event
481 S.bracket before after (S.concatMapWith parallel eventStreamAggr)
485 before = return $ pathsToHandles (utf8ToStringList paths) $ f defaultConfig
486 after = liftIO . closePathHandleStream
488-- | Same as 'watchWith' using 'defaultConfig' and recursive mode.
490-- >>> watchRecursive = watchWith (setRecursiveMode On)
494watchRecursive :: NonEmpty (Array Word8) -> Stream IO Event
495watchRecursive = watchWith (setRecursiveMode On)
497-- | Same as 'watchWith' using defaultConfig and non-recursive mode.
499-- >>> watch = watchWith id
503watch :: NonEmpty (Array Word8) -> Stream IO Event
506getFlag :: DWORD -> Event -> Bool
507getFlag mask Event{..} = eventFlags == mask
509-- XXX Change the type to Array Word8 to make it compatible with other APIs.
511-- | Get the file system object path for which the event is generated, relative
512-- to the watched root. The path is a UTF-8 encoded array of bytes.
516getRelPath :: Event -> Array Word8
517getRelPath Event{..} = (UTF8.toArray . UTF8.pack) eventRelPath
519-- XXX Change the type to Array Word8 to make it compatible with other APIs.
521-- | Get the watch root directory to which this event belongs.
525getRoot :: Event -> Array Word8
526getRoot Event{..} = (UTF8.toArray . UTF8.pack) eventRootPath
528-- | Get the absolute file system object path for which the event is generated.
530-- When the watch root is a symlink, the absolute path returned is via the
531-- original symlink and not through the resolved path.
535getAbsPath :: Event -> Array Word8
536getAbsPath ev = getRoot ev <> backSlash <> getRelPath ev
537 where backSlash = A.fromList [ fromIntegral (ord '\\') ]
539-- XXX need to document the exact semantics of these.
541-- | This event is generated when a file or directory is created in a watched
542-- directory or directory tree when in recursive watch mode. Creating a hard
543-- link also generates this event.
545-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
549isCreated :: Event -> Bool
550isCreated = getFlag fILE_ACTION_ADDED
552-- | This event is generated when a file or directory is deleted from the
553-- watched directory or directory tree when in recursive mode. This event is
554-- generated even when a hard link is deleted.
556-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
560isDeleted :: Event -> Bool
561isDeleted = getFlag fILE_ACTION_REMOVED
563-- | Generated for the original path when an object is moved from under a
564-- monitored directory.
566-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
570isMovedFrom :: Event -> Bool
571isMovedFrom = getFlag fILE_ACTION_RENAMED_OLD_NAME
573-- | Generated for the new path when an object is moved under a monitored
576-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
580isMovedTo :: Event -> Bool
581isMovedTo = getFlag fILE_ACTION_RENAMED_NEW_NAME
583-- | Generated for a path that is moved from or moved to the monitored
586-- >>> isMoved ev = isMovedFrom ev || isMovedTo ev
588-- /Occurs when either 'setFileNameEvents' or 'setDirNameEvents' is enabled/
589-- /Occurs only for an object inside the watched directory/
593isMoved :: Event -> Bool
594isMoved ev = isMovedFrom ev || isMovedTo ev
596-- XXX This event is generated only for files and not directories?
598-- | This event occurs when a file or directory contents, timestamps or
599-- attributes are modified. Since it can occur on multiple changes, you may
600-- have to check the attributes to know what exactly changed when multiple type
601-- of modified events are enabled.
603-- In non-recursive mode this event does not occur for directories. In
604-- recursive mode this event occurs for the parent directory if a file or
605-- directory inside it is created or renamed.
607-- /Occurs when one of the @set*Modified@ events is enabled/
611isModified :: Event -> Bool
612isModified = getFlag fILE_ACTION_MODIFIED
614-- | If the kernel event buffer overflows, entire contents of the buffer are
615-- discarded, therefore, events are lost. The user application must scan
616-- everything under the watched paths to know the current state of the file
621isEventsLost :: Event -> Bool
622isEventsLost Event{..} = totalBytes == 0
624-------------------------------------------------------------------------------
626-------------------------------------------------------------------------------
628-- | Convert an 'Event' record to a String representation.
629showEvent :: Event -> String
630showEvent ev@Event{..} =
631 "--------------------------"
632 ++ "\nRoot = " ++ utf8ToString (getRoot ev)
633 ++ "\nPath = " ++ utf8ToString (getRelPath ev)
634 ++ "\ngetAbsPath = " ++ utf8ToString (getAbsPath ev)
635 ++ "\nFlags " ++ show eventFlags
636 ++ showev isEventsLost "Overflow"
637 ++ showev isCreated "Created"
638 ++ showev isDeleted "Deleted"
639 ++ showev isModified "Modified"
640 ++ showev isMovedFrom "MovedFrom"
641 ++ showev isMovedTo "MovedTo"
644 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