{-# LINE 1 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}

-- | File locking for Windows.

module GHC.IO.Handle.Lock.Windows where




{-# LINE 15 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}

#include <windows_cconv.h>


import Data.Bits
import Data.Function
import GHC.IO.Handle.Windows (handleToHANDLE)
import Foreign.C.Error
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import GHC.Base
import qualified GHC.Event.Windows as Mgr
import GHC.Event.Windows (LPOVERLAPPED, withOverlapped)
import GHC.IO.FD
import GHC.IO.Handle.FD
import GHC.IO.Handle.Types (Handle)
import GHC.IO.Handle.Lock.Common (LockMode(..))
import GHC.IO.SubSystem
import GHC.Windows

lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl = Handle -> String -> LockMode -> Bool -> IO Bool
lockImplPOSIX (Handle -> String -> LockMode -> Bool -> IO Bool)
-> (Handle -> String -> LockMode -> Bool -> IO Bool)
-> Handle
-> String
-> LockMode
-> Bool
-> IO Bool
forall a. a -> a -> a
<!> Handle -> String -> LockMode -> Bool -> IO Bool
lockImplWinIO

lockImplWinIO :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImplWinIO :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImplWinIO Handle
h String
ctx LockMode
mode Bool
block = do
  HANDLE
wh      <- Handle -> IO HANDLE
handleToHANDLE Handle
h
  (IO Bool -> IO Bool) -> IO Bool
forall a. (a -> a) -> a
fix ((IO Bool -> IO Bool) -> IO Bool)
-> (IO Bool -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \IO Bool
retry ->
          do DWORD
retcode <- String -> IO (IOResult DWORD) -> IO DWORD
forall a. String -> IO (IOResult a) -> IO a
Mgr.withException String
ctx (IO (IOResult DWORD) -> IO DWORD)
-> IO (IOResult DWORD) -> IO DWORD
forall a b. (a -> b) -> a -> b
$
                          String
-> HANDLE
-> Word64
-> StartIOCallback Int
-> CompletionCallback (IOResult DWORD)
-> IO (IOResult DWORD)
forall a.
String
-> HANDLE
-> Word64
-> StartIOCallback Int
-> CompletionCallback (IOResult a)
-> IO (IOResult a)
withOverlapped String
ctx HANDLE
wh Word64
0 (HANDLE -> StartIOCallback Int
forall {a}. HANDLE -> LPOVERLAPPED -> IO (CbResult a)
startCB HANDLE
wh) CompletionCallback (IOResult DWORD)
forall {a} {p}. Integral a => a -> p -> IO (IOResult a)
completionCB
             case () of
              ()
_ | DWORD
retcode DWORD -> DWORD -> Bool
forall a. Eq a => a -> a -> Bool
== DWORD
995 -> IO Bool
retry
{-# LINE 47 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
                | retcode == 0           -> return True
{-# LINE 48 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
                | retcode == 33 && not block
{-# LINE 49 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
                    -> return False
                | otherwise -> failWith ctx retcode
    where
      cmode = case mode of
                SharedLock    -> 0
                ExclusiveLock -> 2
{-# LINE 55 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
      flags = if block
                 then cmode
                 else cmode .|. 1
{-# LINE 58 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}

      startCB wh lpOverlapped = do
        ret <- c_LockFileEx wh flags 0 4294967295 4294967295
{-# LINE 61 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
                            lpOverlapped
        return $ Mgr.CbNone ret

      completionCB err _dwBytes
        | err == 0 = Mgr.ioSuccess 0
{-# LINE 66 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
        | otherwise                     = Mgr.ioFailed err

lockImplPOSIX :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImplPOSIX h ctx mode block = do
  FD{fdFD = fd} <- handleToFd h
  wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) ctx $ c_get_osfhandle fd
  allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do
    fillBytes ovrlpd 0 sizeof_OVERLAPPED
    let flags = cmode .|. (if block then 0 else 1)
{-# LINE 75 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
    -- We want to lock the whole file without looking up its size to be

    -- consistent with what flock does. According to documentation of LockFileEx

    -- "locking a region that goes beyond the current end-of-file position is

    -- not an error", hence we pass maximum value as the number of bytes to

    -- lock.

    fix $ \retry -> c_LockFileEx wh flags 0 4294967295 4294967295
{-# LINE 81 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
                                 ovrlpd >>= \case
      True  -> return True
      False -> getLastError >>= \err -> if
        | not block && err == 33 -> return False
{-# LINE 85 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
        | err == 995           -> retry
{-# LINE 86 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
        | otherwise                                         -> failWith ctx err
  where
    sizeof_OVERLAPPED = (32)
{-# LINE 89 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}

    cmode = case mode of
      SharedLock    -> 0
      ExclusiveLock -> 2
{-# LINE 93 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}

unlockImpl :: Handle -> IO ()
unlockImpl = unlockImplPOSIX <!> unlockImplWinIO

unlockImplWinIO :: Handle -> IO ()
unlockImplWinIO h = do
  wh <- handleToHANDLE h
  _ <- Mgr.withException "unlockImpl" $
          withOverlapped "unlockImpl" wh 0 (startCB wh) completionCB
  return ()
    where
      startCB wh lpOverlapped = do
        ret <- c_UnlockFileEx wh 0 4294967295 4294967295
{-# LINE 106 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
                              lpOverlapped
        return $ Mgr.CbNone ret

      completionCB err _dwBytes
        | err == 0 = Mgr.ioSuccess 0
{-# LINE 111 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
        | otherwise                     = Mgr.ioFailed err

unlockImplPOSIX :: Handle -> IO ()
unlockImplPOSIX h = do
  FD{fdFD = fd} <- handleToFd h
  wh <- throwErrnoIf (== iNVALID_HANDLE_VALUE) "hUnlock" $ c_get_osfhandle fd
  allocaBytes sizeof_OVERLAPPED $ \ovrlpd -> do
    fillBytes ovrlpd 0 sizeof_OVERLAPPED
    c_UnlockFileEx wh 0 4294967295 4294967295 ovrlpd >>= \case
{-# LINE 120 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}
      True  -> return ()
      False -> getLastError >>= failWith "hUnlock"
  where
    sizeof_OVERLAPPED = (32)
{-# LINE 124 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}

-- https://msdn.microsoft.com/en-us/library/aa297958.aspx

foreign import ccall unsafe "_get_osfhandle"
  c_get_osfhandle :: CInt -> IO HANDLE

-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365203.aspx

foreign import WINDOWS_CCONV interruptible "LockFileEx"
  c_LockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED
               -> IO BOOL

-- https://msdn.microsoft.com/en-us/library/windows/desktop/aa365716.aspx

foreign import WINDOWS_CCONV interruptible "UnlockFileEx"
  c_UnlockFileEx :: HANDLE -> DWORD -> DWORD -> DWORD -> LPOVERLAPPED -> IO BOOL


{-# LINE 139 "libraries\\base\\GHC\\IO\\Handle\\Lock\\Windows.hsc" #-}