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

-- | File locking for Windows.

module GHC.Internal.IO.Handle.Lock.Windows where




{-# LINE 16 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}

#include <windows_cconv.h>


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

lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImpl = lockImplPOSIX <!> lockImplWinIO

lockImplWinIO :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImplWinIO :: Handle -> String -> LockMode -> Bool -> IO Bool
lockImplWinIO h ctx mode block = do
  wh      <- handleToHANDLE h
  fix $ \retry ->
          do retcode <- Mgr.withException ctx $
                          withOverlapped ctx wh 0 (startCB wh) completionCB
             case () of
              _ | retcode == 995 -> retry
{-# LINE 48 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
                | retcode == 0           -> return True
{-# LINE 49 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
                | retcode == 33 && not block
{-# LINE 50 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
                    -> return False
                | otherwise -> failWith ctx retcode
    where
      cmode = case mode of
                SharedLock    -> 0
                ExclusiveLock -> 2
{-# LINE 56 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
      flags = if block
                 then cmode
                 else cmode .|. 1
{-# LINE 59 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}

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

      completionCB err _dwBytes
        | err == 0 = Mgr.ioSuccess 0
{-# LINE 67 "libraries\\ghc-internal\\src\\GHC\\Internal\\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 76 "libraries\\ghc-internal\\src\\GHC\\Internal\\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 82 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
                                 ovrlpd >>= \case
      True  -> return True
      False -> getLastError >>= \err -> if
        | not block && err == 33 -> return False
{-# LINE 86 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
        | err == 995           -> retry
{-# LINE 87 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
        | otherwise                                         -> failWith ctx err
  where
    sizeof_OVERLAPPED = (32)
{-# LINE 90 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}

    cmode = case mode of
      SharedLock    -> 0
      ExclusiveLock -> 2
{-# LINE 94 "libraries\\ghc-internal\\src\\GHC\\Internal\\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 107 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
                              lpOverlapped
        return $ Mgr.CbNone ret

      completionCB err _dwBytes
        | err == 0 = Mgr.ioSuccess 0
{-# LINE 112 "libraries\\ghc-internal\\src\\GHC\\Internal\\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 121 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}
      True  -> return ()
      False -> getLastError >>= failWith "hUnlock"
  where
    sizeof_OVERLAPPED = (32)
{-# LINE 125 "libraries\\ghc-internal\\src\\GHC\\Internal\\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 140 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Handle\\Lock\\Windows.hsc" #-}