1{-# LANGUAGE CPP #-}
2{- |
3   Module      :  System.Win32.HardLink
4   Copyright   :  2013 shelarcy
5   License     :  BSD-style
6
7   Maintainer  :  shelarcy@gmail.com
8   Stability   :  Provisional
9   Portability :  Non-portable (Win32 API)
10
11   Handling hard link using Win32 API. [NTFS only]
12
13   Note: You should worry about file system type when use this module's function in your application:
14
15     * NTFS only supprts this functionality.
16
17     * ReFS doesn't support hard link currently.
18-}
19module System.Win32.HardLink
20  ( module System.Win32.HardLink
21  ) where
22import System.Win32.File   ( LPSECURITY_ATTRIBUTES, failIfFalseWithRetry_ )
23import System.Win32.String ( LPCTSTR, withTString )
24import System.Win32.Types  ( BOOL, nullPtr )
25
26#include "windows_cconv.h"
27
28-- | NOTE: createHardLink is /flipped arguments/ to provide compatiblity for Unix.
29--
30-- If you want to create hard link by Windows way, use 'createHardLink'' instead.
31createHardLink :: FilePath -- ^ Target file path
32               -> FilePath -- ^ Hard link name
33               -> IO ()
34createHardLink = flip createHardLink'
35
36createHardLink' :: FilePath -- ^ Hard link name
37                -> FilePath -- ^ Target file path
38                -> IO ()
39createHardLink' link target =
40   withTString target $ \c_target ->
41   withTString link   $ \c_link ->
42        failIfFalseWithRetry_ (unwords ["CreateHardLinkW",show link,show target]) $
43          c_CreateHardLink c_link c_target nullPtr
44
45foreign import WINDOWS_CCONV unsafe "windows.h CreateHardLinkW"
46  c_CreateHardLink :: LPCTSTR -- ^ Hard link name
47                   -> LPCTSTR -- ^ Target file path
48                   -> LPSECURITY_ATTRIBUTES -- ^ This parameter is reserved. You should pass just /nullPtr/.
49                   -> IO BOOL
50
51{-
52-- We plan to check file system type internally.
53
54-- We are thinking about API design, currently...
55data VolumeInformation = VolumeInformation
56      { volumeName         :: String
57      , volumeSerialNumber :: DWORD
58      , maximumComponentLength :: DWORD
59      , fileSystemFlags    :: DWORD
60      , fileSystemName     :: String
61      } deriving Show
62
63getVolumeInformation :: Maybe String -> IO VolumeInformation
64getVolumeInformation drive =
65   maybeWith withTString drive $ \c_drive ->
66   withTStringBufferLen 256    $ \(vnBuf, vnLen) ->
67   alloca $ \serialNum ->
68   alloca $ \maxLen ->
69   alloca $ \fsFlags ->
70   withTStringBufferLen 256 $ \(fsBuf, fsLen) -> do
71       failIfFalse_ (unwords ["GetVolumeInformationW", drive]) $
72         c_GetVolumeInformation c_drive vnBuf (fromIntegral vnLen)
73                                serialNum maxLen fsFlags
74                                fsBuf (fromIntegral fsLen)
75       return VolumeInformation
76         <*> peekTString vnBuf
77         <*> peek serialNum
78         <*> peek maxLen
79         <*> peek fsFlags
80         <*> peekTString fsBuf
81
82-- Which is better?
83getVolumeFileType :: String -> IO String
84getVolumeFileType drive = fileSystemName <$> getVolumeInformation drive
85
86getVolumeFileType :: String -> IO String
87getVolumeFileType drive =
88   withTString drive        $ \c_drive ->
89   withTStringBufferLen 256 $ \(buf, len) -> do
90       failIfFalse_ (unwords ["GetVolumeInformationW", drive]) $
91         c_GetVolumeInformation c_drive nullPtr 0 nullPtr nullPtr nullPtr buf (fromIntegral len)
92       peekTString buf
93
94foreign import WINDOWS_CCONV unsafe "windows.h GetVolumeInformationW"
95  c_GetVolumeInformation :: LPCTSTR -> LPTSTR -> DWORD -> LPDWORD -> LPDWORD -> LPDWORD -> LPTSTR -> DWORD -> IO BOOL
96-}
97