{-# LINE 1 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
{-# LANGUAGE Trustworthy          #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE NoImplicitPrelude    #-}
{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE FlexibleContexts     #-}
-- Whether there are identities depends on the platform

{-# OPTIONS_HADDOCK hide #-}

-----------------------------------------------------------------------------

-- |

-- Module      :  GHC.Internal.IO.Windows.Handle

-- Copyright   :  (c) The University of Glasgow, 2017

-- License     :  see libraries/base/LICENSE

--

-- Maintainer  :  libraries@haskell.org

-- Stability   :  internal

-- Portability :  non-portable

--

-- Raw read/write operations on Windows Handles

--

-----------------------------------------------------------------------------


module GHC.Internal.IO.Windows.Handle
 ( -- * Basic Types

   NativeHandle(),
   ConsoleHandle(),
   IoHandle(),
   HANDLE,
   Io(),

   -- * Utility functions

   convertHandle,
   toHANDLE,
   fromHANDLE,
   handleToMode,
   isAsynchronous,
   optimizeFileAccess,

   -- * Standard Handles

   stdin,
   stdout,
   stderr,

   -- * File utilities

   openFile,
   openFileAsTemp,
   release
 ) where




#include "windows_cconv.h"

-- Can't avoid these semantics leaks, they are base constructs

import GHC.Internal.Data.Bits ((.|.), (.&.), shiftL)
import GHC.Internal.Data.Functor ((<$>))
import GHC.Internal.Data.Typeable

import GHC.Internal.Base
import GHC.Internal.Enum
import GHC.Internal.Num
import GHC.Internal.Real
import GHC.Internal.List
import GHC.Internal.Word (Word8, Word16, Word64)

import GHC.Internal.IO hiding (mask)
import GHC.Internal.IO.Buffer
import GHC.Internal.IO.BufferedIO
import qualified GHC.Internal.IO.Device as GHC.IO.Device
import GHC.Internal.IO.Device (SeekMode(..), IODeviceType(..), IODevice(), devType, setSize)
import GHC.Internal.IO.Exception
import GHC.Internal.IO.IOMode
import GHC.Internal.IO.Windows.Encoding (withGhcInternalToUTF16, withUTF16ToGhcInternal)
import GHC.Internal.IO.Windows.Paths (getDevicePath)
import GHC.Internal.IO.Handle.Internals (debugIO)
import GHC.Internal.IORef
import GHC.Internal.Event.Windows (LPOVERLAPPED, withOverlappedEx, IOResult(..))
import GHC.Internal.Foreign.Ptr
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.C.Error
import GHC.Internal.Foreign.C.String
import GHC.Internal.Foreign.Marshal.Array (pokeArray)
import GHC.Internal.Foreign.Marshal.Alloc (alloca, allocaBytes)
import GHC.Internal.Foreign.Marshal.Utils (with, fromBool)
import GHC.Internal.Foreign.Storable (Storable (..))
import qualified GHC.Internal.Event.Windows as Mgr

import GHC.Internal.Windows (LPVOID, LPDWORD, DWORD, HANDLE, BOOL, LPCTSTR, ULONG, WORD,
                             UCHAR, failIf, iNVALID_HANDLE_VALUE, failWith,
                             failIfFalse_, getLastError)
import GHC.Internal.Text.Show

-- -----------------------------------------------------------------------------

-- The Windows IO device handles


data NativeHandle
data ConsoleHandle

-- | Bit of a Hack, but we don't want every handle to have a cooked entry

--   but all copies of the handles for which we do want one need to share

--   the same value.

--   We can't store it separately because we don't know when the handle will

--   be destroyed or invalidated.

data IoHandle a where
  NativeHandle  :: { getNativeHandle  :: HANDLE
                   -- In certain cases we have inherited a handle and the

                   -- handle and it may not have been created for async

                   -- access.  In those case we can't issue a completion

                   -- request as it would never finish and we'd deadlock.

                   , isAsynchronous :: Bool } -> IoHandle NativeHandle
  ConsoleHandle :: { getConsoleHandle :: HANDLE
                   , cookedHandle :: IORef Bool
                   } -> IoHandle ConsoleHandle

type Io a = IoHandle a

-- | Convert a ConsoleHandle into a general FileHandle

--   This will change which DeviceIO is used.

convertHandle :: Io ConsoleHandle -> Bool -> Io NativeHandle
convertHandle io async
  = let !hwnd = getConsoleHandle io
    in NativeHandle hwnd async

-- | @since base-4.11.0.0

instance Show (Io NativeHandle) where
  show = show . toHANDLE

-- | @since base-4.11.0.0

instance Show (Io ConsoleHandle) where
  show = show . getConsoleHandle

-- | @since base-4.11.0.0

instance GHC.IO.Device.RawIO (Io NativeHandle) where
  read             = hwndRead
  readNonBlocking  = hwndReadNonBlocking
  write            = hwndWrite
  writeNonBlocking = hwndWriteNonBlocking

-- | @since base-4.11.0.0

instance GHC.IO.Device.RawIO (Io ConsoleHandle) where
  read             = consoleRead True
  readNonBlocking  = consoleReadNonBlocking
  write            = consoleWrite
  writeNonBlocking = consoleWriteNonBlocking

-- | Generalize a way to get and create handles.

class (GHC.IO.Device.RawIO a, IODevice a, BufferedIO a, Typeable a)
      => RawHandle a where
  toHANDLE   :: a -> HANDLE
  fromHANDLE :: HANDLE -> a
  isLockable :: a -> Bool
  setCooked  :: a -> Bool -> IO a
  isCooked   :: a -> IO Bool

instance RawHandle (Io NativeHandle) where
  toHANDLE     = getNativeHandle
  -- In order to convert to a native handle we have to check to see

  -- is the handle can be used async or not.

  fromHANDLE   = flip NativeHandle True
  isLockable _ = True
  setCooked    = const . return
  isCooked   _ = return False

instance RawHandle (Io ConsoleHandle) where
  toHANDLE         = getConsoleHandle
  fromHANDLE h     = unsafePerformIO $ ConsoleHandle h <$> newIORef False
  isLockable _     = False
  setCooked  h val =
    do writeIORef (cookedHandle h) val
       return h
  isCooked   h     = readIORef (cookedHandle h)

-- -----------------------------------------------------------------------------

-- The Windows IO device implementation


-- | @since base-4.11.0.0

instance GHC.IO.Device.IODevice (Io NativeHandle) where
  ready      = handle_ready
  close      = handle_close
  isTerminal = handle_is_console
  isSeekable = handle_is_seekable
  seek       = handle_seek
  tell       = handle_tell
  getSize    = handle_get_size
  setSize    = handle_set_size
  setEcho    = handle_set_echo
  getEcho    = handle_get_echo
  setRaw     = handle_set_buffering
  devType    = handle_dev_type
  dup        = handle_duplicate

-- | @since base-4.11.0.0

instance GHC.IO.Device.IODevice (Io ConsoleHandle) where
  ready      = handle_ready
  close      = handle_close . flip convertHandle False
  isTerminal = handle_is_console
  isSeekable = handle_is_seekable
  seek       = handle_console_seek
  tell       = handle_console_tell
  getSize    = handle_get_console_size
  setSize    = handle_set_console_size
  setEcho    = handle_set_echo
  getEcho    = handle_get_echo
  setRaw     = console_set_buffering
  devType    = handle_dev_type
  dup        = handle_duplicate

-- Default sequential read buffer size.

-- for Windows 8k seems to be the optimal

-- buffer size.

dEFAULT_BUFFER_SIZE :: Int
dEFAULT_BUFFER_SIZE = 8192

-- | @since base-4.11.0.0

-- See libraries/base/GHC/IO/BufferedIO.hs

instance BufferedIO (Io NativeHandle) where
  newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state
  fillReadBuffer       = readBuf'
  fillReadBuffer0      = readBufNonBlocking
  flushWriteBuffer     = writeBuf'
  flushWriteBuffer0    = writeBufNonBlocking

-- | @since base-4.11.0.0

-- See libraries/base/GHC/IO/BufferedIO.hs

instance BufferedIO (Io ConsoleHandle) where
  newBuffer _dev state = newByteBuffer dEFAULT_BUFFER_SIZE state
  fillReadBuffer       = readBuf'
  fillReadBuffer0      = readBufNonBlocking
  flushWriteBuffer     = writeBuf'
  flushWriteBuffer0    = writeBufNonBlocking


readBuf' :: RawHandle a => a -> Buffer Word8 -> IO (Int, Buffer Word8)
readBuf' hnd buf = do
  debugIO ("readBuf handle=" ++ show (toHANDLE hnd) ++ " " ++
           summaryBuffer buf ++ "\n")
  (r,buf') <- readBuf hnd buf
  debugIO ("after: " ++ summaryBuffer buf' ++ "\n")
  return (r,buf')

writeBuf' :: RawHandle a => a -> Buffer Word8 -> IO (Buffer Word8)
writeBuf' hnd buf = do
  debugIO ("writeBuf handle=" ++ show (toHANDLE hnd) ++ " " ++
           summaryBuffer buf ++ "\n")
  writeBuf hnd buf

-- -----------------------------------------------------------------------------

-- Standard I/O handles


type StdHandleId  = DWORD

sTD_INPUT_HANDLE   :: StdHandleId
sTD_INPUT_HANDLE   =  4294967286
sTD_OUTPUT_HANDLE  :: StdHandleId
sTD_OUTPUT_HANDLE  =  4294967285
sTD_ERROR_HANDLE   :: StdHandleId
sTD_ERROR_HANDLE   =  4294967284

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

getStdHandle :: StdHandleId -> IO HANDLE
getStdHandle hid =
  failIf (== iNVALID_HANDLE_VALUE) "GetStdHandle" $ c_GetStdHandle hid

stdin, stdout, stderr :: Io ConsoleHandle
stdin  = unsafePerformIO $ mkConsoleHandle =<< getStdHandle sTD_INPUT_HANDLE
stdout = unsafePerformIO $ mkConsoleHandle =<< getStdHandle sTD_OUTPUT_HANDLE
stderr = unsafePerformIO $ mkConsoleHandle =<< getStdHandle sTD_ERROR_HANDLE

mkConsoleHandle :: HANDLE -> IO (Io ConsoleHandle)
mkConsoleHandle hwnd
  = do ref <- newIORef False
       return $ ConsoleHandle hwnd ref

-- -----------------------------------------------------------------------------

-- Some console internal types to detect EOF.


-- ASCII Ctrl+D (EOT) character.  Typically used by Unix consoles.

-- use for cross platform compatibility and to adhere to the ASCII standard.

acCtrlD :: Int
acCtrlD = 0x04
-- ASCII Ctrl+Z (SUB) character. Typically used by Windows consoles to denote

-- EOT.  Use for compatibility with user expectations.

acCtrlZ :: Int
acCtrlZ = 0x1A

-- Mask to use to trigger ReadConsole input processing end.

acEotMask :: ULONG
acEotMask = (1 `shiftL` acCtrlD) .|. (1 `shiftL` acCtrlZ)

-- Structure to hold the control character masks

type PCONSOLE_READCONSOLE_CONTROL = Ptr CONSOLE_READCONSOLE_CONTROL
data CONSOLE_READCONSOLE_CONTROL = CONSOLE_READCONSOLE_CONTROL
  { crcNLength           :: ULONG
  , crcNInitialChars     :: ULONG
  , crcDwCtrlWakeupMask  :: ULONG
  , crcDwControlKeyState :: ULONG
  } deriving Show

instance Storable CONSOLE_READCONSOLE_CONTROL where
  sizeOf = const (16)
{-# LINE 303 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
  alignment = const 4
{-# LINE 304 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
  poke buf crc = do
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))           buf
{-# LINE 306 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        (crcNLength           crc)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4))     buf
{-# LINE 308 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        (crcNInitialChars     crc)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  buf
{-# LINE 310 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        (crcDwCtrlWakeupMask  crc)
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) buf
{-# LINE 312 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        (crcDwControlKeyState crc)

  peek buf = do
    vNLength           <-
      ((\hsc_ptr -> peekByteOff hsc_ptr 0))           buf
{-# LINE 317 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
    vNInitialChars     <-
      ((\hsc_ptr -> peekByteOff hsc_ptr 4))     buf
{-# LINE 319 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
    vDwCtrlWakeupMask  <-
      ((\hsc_ptr -> peekByteOff hsc_ptr 8))  buf
{-# LINE 321 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
    vDwControlKeyState <-
      ((\hsc_ptr -> peekByteOff hsc_ptr 12)) buf
{-# LINE 323 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
    return $ CONSOLE_READCONSOLE_CONTROL {
        crcNLength           = vNLength,
        crcNInitialChars     = vNInitialChars,
        crcDwCtrlWakeupMask  = vDwCtrlWakeupMask,
        crcDwControlKeyState = vDwControlKeyState
      }

-- Create CONSOLE_READCONSOLE_CONTROL for breaking on control characters

-- specified by acEotMask

eotControl :: CONSOLE_READCONSOLE_CONTROL
eotControl =
  CONSOLE_READCONSOLE_CONTROL
    { crcNLength           = fromIntegral $
                               sizeOf (undefined :: CONSOLE_READCONSOLE_CONTROL)
    , crcNInitialChars     = 0
    , crcDwCtrlWakeupMask  = acEotMask
    , crcDwControlKeyState = 0
    }

type PINPUT_RECORD = Ptr ()
-- -----------------------------------------------------------------------------

-- Foreign imports



foreign import WINDOWS_CCONV safe "windows.h CreateFileW"
    c_CreateFile :: LPCTSTR -> DWORD -> DWORD -> LPSECURITY_ATTRIBUTES
                 -> DWORD -> DWORD -> HANDLE
                 -> IO HANDLE

foreign import WINDOWS_CCONV safe "windows.h SetFileCompletionNotificationModes"
    c_SetFileCompletionNotificationModes :: HANDLE -> UCHAR -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h ReadFile"
    c_ReadFile :: HANDLE -> LPVOID -> DWORD -> LPDWORD -> LPOVERLAPPED
               -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h WriteFile"
    c_WriteFile :: HANDLE -> LPVOID -> DWORD -> LPDWORD -> LPOVERLAPPED
                -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h GetStdHandle"
    c_GetStdHandle :: StdHandleId -> IO HANDLE

foreign import ccall safe "__handle_ready"
    c_handle_ready :: HANDLE -> BOOL -> CInt -> IO CInt

foreign import ccall safe "__is_console"
    c_is_console :: HANDLE -> IO BOOL

foreign import ccall safe "__set_console_buffering"
    c_set_console_buffering :: HANDLE -> BOOL -> IO BOOL

foreign import ccall safe "__set_console_echo"
    c_set_console_echo :: HANDLE -> BOOL -> IO BOOL

foreign import ccall safe "__get_console_echo"
    c_get_console_echo :: HANDLE -> IO BOOL

foreign import ccall safe "__close_handle"
    c_close_handle :: HANDLE -> IO Bool

foreign import ccall safe "__handle_type"
    c_handle_type :: HANDLE -> IO Int

foreign import ccall safe "__set_file_pointer"
  c_set_file_pointer :: HANDLE -> CLong -> DWORD -> Ptr CLong -> IO BOOL

foreign import ccall safe "__get_file_pointer"
  c_get_file_pointer :: HANDLE -> IO CLong

foreign import ccall safe "__get_file_size"
  c_get_file_size :: HANDLE -> IO CLong

foreign import ccall safe "__set_file_size"
  c_set_file_size :: HANDLE -> CLong -> IO BOOL

foreign import ccall safe "__duplicate_handle"
  c_duplicate_handle :: HANDLE -> Ptr HANDLE -> IO BOOL

foreign import ccall safe "__set_console_pointer"
  c_set_console_pointer :: HANDLE -> CLong -> DWORD -> Ptr CLong -> IO BOOL

foreign import ccall safe "__get_console_pointer"
  c_get_console_pointer :: HANDLE -> IO CLong

foreign import ccall safe "__get_console_buffer_size"
  c_get_console_buffer_size :: HANDLE -> IO CLong

foreign import ccall safe "__set_console_buffer_size"
  c_set_console_buffer_size :: HANDLE -> CLong -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h ReadConsoleW"
  c_read_console :: HANDLE -> Ptr Word16 -> DWORD -> Ptr DWORD
                 -> PCONSOLE_READCONSOLE_CONTROL -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h WriteConsoleW"
  c_write_console :: HANDLE -> Ptr Word16 -> DWORD -> Ptr DWORD -> Ptr ()
                  -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h ReadConsoleInputW"
  c_read_console_input :: HANDLE -> PINPUT_RECORD -> DWORD -> LPDWORD -> IO BOOL

foreign import WINDOWS_CCONV safe "windows.h GetNumberOfConsoleInputEvents"
  c_get_num_console_inputs :: HANDLE -> LPDWORD -> IO BOOL

type LPSECURITY_ATTRIBUTES = LPVOID

-- -----------------------------------------------------------------------------

-- Reading and Writing


-- For this to actually block, the file handle must have

-- been created with FILE_FLAG_OVERLAPPED not set. As an implementation note I

-- am choosing never to let this block. But this can be easily accomplished by

-- a getOverlappedResult call with True

hwndRead :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
hwndRead hwnd ptr offset bytes = do
  mngr <- Mgr.getSystemManager
  fmap fromIntegral $ Mgr.withException "hwndRead" $
     withOverlappedEx mngr "hwndRead" (toHANDLE hwnd) (isAsynchronous hwnd)
                      offset (startCB ptr) completionCB
  where
    startCB outBuf lpOverlapped = do
      debugIO ":: hwndRead"
      -- See Note [ReadFile/WriteFile].

      ret <- c_ReadFile (toHANDLE hwnd) (castPtr outBuf)
                        (fromIntegral bytes) nullPtr lpOverlapped
      return $ Mgr.CbNone ret

    completionCB err dwBytes
      | err == 0       = Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 453 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 38    = Mgr.ioSuccess 0
{-# LINE 454 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == -1073741807  = Mgr.ioSuccess 0
{-# LINE 455 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 109   = Mgr.ioSuccess 0
{-# LINE 456 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == -1073741493  = Mgr.ioSuccess 0
{-# LINE 457 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 259 = Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 458 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 234     = Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 459 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | otherwise                           = Mgr.ioFailed err

-- In WinIO we'll never block in the FFI call, so this call is equivalent to

-- hwndRead,  Though we may revisit this when implementing sockets and pipes.

-- It still won't block, but may set up extra book keeping so threadWait and

-- threadWrite may work.

hwndReadNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int
                    -> IO (Maybe Int)
hwndReadNonBlocking hwnd ptr offset bytes
  = do mngr <- Mgr.getSystemManager
       val <- withOverlappedEx mngr "hwndReadNonBlocking" (toHANDLE hwnd)
                               (isAsynchronous hwnd) offset (startCB ptr)
                               completionCB
       return $ ioValue val
  where
    startCB inputBuf lpOverlapped = do
      debugIO ":: hwndReadNonBlocking"
      -- See Note [ReadFile/WriteFile].

      ret <- c_ReadFile (toHANDLE hwnd) (castPtr inputBuf)
                        (fromIntegral bytes) nullPtr lpOverlapped
      return $ Mgr.CbNone ret

    completionCB err dwBytes
      | err == 0       = Mgr.ioSuccess $ Just $! fromIntegral dwBytes
{-# LINE 483 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 38    = Mgr.ioSuccess Nothing
{-# LINE 484 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == -1073741807  = Mgr.ioSuccess Nothing
{-# LINE 485 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 109   = Mgr.ioSuccess Nothing
{-# LINE 486 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == -1073741493  = Mgr.ioSuccess Nothing
{-# LINE 487 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 259 = Mgr.ioSuccess Nothing
{-# LINE 488 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | err == 234     = Mgr.ioSuccess $ Just $! fromIntegral dwBytes
{-# LINE 489 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
      | otherwise                           = Mgr.ioFailedAny err

hwndWrite :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO ()
hwndWrite hwnd ptr offset bytes
  = do mngr <- Mgr.getSystemManager
       _ <- Mgr.withException "hwndWrite" $
          withOverlappedEx mngr "hwndWrite" (toHANDLE hwnd)
                           (isAsynchronous hwnd) offset (startCB ptr)
                           completionCB
       return ()
  where
    startCB outBuf lpOverlapped = do
      debugIO ":: hwndWrite"
      -- See Note [ReadFile/WriteFile].

      ret <- c_WriteFile (toHANDLE hwnd) (castPtr outBuf)
                         (fromIntegral bytes) nullPtr lpOverlapped
      return $ Mgr.CbNone ret

    completionCB err dwBytes
        | err == 0  =   Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 509 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        | err == 38 = Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 510 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        | otherwise                        = Mgr.ioFailed err

hwndWriteNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
hwndWriteNonBlocking hwnd ptr offset bytes
  = do mngr <- Mgr.getSystemManager
       val <- withOverlappedEx mngr "hwndReadNonBlocking" (toHANDLE hwnd)
                               (isAsynchronous hwnd) offset (startCB ptr)
                               completionCB
       return $ fromIntegral $ ioValue val
  where
    startCB :: Ptr a -> LPOVERLAPPED -> IO (Mgr.CbResult a1)
    startCB outBuf lpOverlapped = do
      debugIO ":: hwndWriteNonBlocking"
      -- See Note [ReadFile/WriteFile].

      ret <- c_WriteFile (toHANDLE hwnd) (castPtr outBuf)
                         (fromIntegral bytes) nullPtr lpOverlapped
      return $ Mgr.CbNone ret

    completionCB err dwBytes
        | err == 0    = Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 530 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        | err == 38 = Mgr.ioSuccess $ fromIntegral dwBytes
{-# LINE 531 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
        | otherwise                        = Mgr.ioFailed err

-- Note [ReadFile/WriteFile]

-- ~~~~~~~~~~~~~~~~~~~~~~~~~

-- The results of these functions are somewhat different when working in an

-- asynchronous manner. The returning bool has two meaning.

--

-- True: The operation is done and was completed synchronously.  This is

--       possible because of the optimization flags we enable.  In this case

--       there won't be a completion event for this call and so we shouldn't

--       queue one up. If we do this request will never terminate.  It's also

--       safe to free the OVERLAPPED structure immediately.

--

-- False: Only indicates that the operation was not completed synchronously, a

--        call to GetLastError () is needed to find out the actual status. If

--        the result is ERROR_IO_PENDING then the operation has been queued on

--        the completion port and we should proceed asynchronously.  Any other

--        state is usually an indication that the call failed.

--

-- NB. reading an EOF will result in ERROR_HANDLE_EOF or STATUS_END_OF_FILE

-- during the checking of the completion results.  We need to check for these

-- so we don't incorrectly fail.



consoleWrite :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO ()
consoleWrite hwnd ptr _offset bytes
  = alloca $ \res ->
      do failIfFalse_ "GHC.Internal.IO.Handle.consoleWrite" $ do
           debugIO ":: consoleWrite"
           withGhcInternalToUTF16 ptr bytes $ \(w_ptr, w_len) -> do
              success <- c_write_console (toHANDLE hwnd) w_ptr
                                         (fromIntegral w_len) res nullPtr
              if not success
                 then return False
                 else do val <- fromIntegral <$> peek res
                         return $ val == w_len

consoleWriteNonBlocking :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
consoleWriteNonBlocking hwnd ptr _offset bytes
  = alloca $ \res ->
      do failIfFalse_ "GHC.Internal.IO.Handle.consoleWriteNonBlocking" $ do
            debugIO ":: consoleWriteNonBlocking"
            withGhcInternalToUTF16 ptr bytes $ \(w_ptr, w_len) -> do
              c_write_console (toHANDLE hwnd) w_ptr (fromIntegral w_len)
                              res nullPtr
         val <- fromIntegral <$> peek res
         return val

consoleRead :: Bool -> Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int -> IO Int
consoleRead blocking hwnd ptr _offset bytes
  = alloca $ \res -> do
      cooked <- isCooked hwnd
      -- Cooked input must be handled differently when the STD handles are

      -- attached to a real console handle.  For File based handles we can't do

      -- proper cooked inputs, but since the actions are async you would get

      -- results as soon as available.

      --

      -- For console handles We have to use a lower level API then ReadConsole,

      -- namely we must use ReadConsoleInput which requires us to process

      -- all console message manually.

      --

      -- Do note that MSYS2 shells such as bash don't attach to a real handle,

      -- and instead have by default a pipe/file based std handles.  Which

      -- means the cooked behaviour is best when used in a native Windows

      -- terminal such as cmd, powershell or ConEmu.

      case cooked || not blocking of
        False -> withUTF16ToGhcInternal ptr bytes $ \reqBytes w_ptr ->  do
          debugIO "consoleRead :: un-cooked I/O read."
          -- eotControl allows us to handle control characters like EOL

          -- without needing a newline, which would sort of defeat the point

          -- of an EOL.

          res_code <- with eotControl $ \p_eotControl ->
                c_read_console (toHANDLE hwnd) w_ptr (fromIntegral reqBytes) res
                               p_eotControl

          -- Restore a quirk of the POSIX read call, which only returns a fail

          -- when the handle is invalid, e.g. closed or not a handle.  It how-

          -- ever returns 0 when the handle is valid but unreadable, such as

          -- passing a handle with no GENERIC_READ permission, like /dev/null

          err <- getLastError
          when (not res_code) $
            case () of
             _ | err == 1 -> return ()
{-# LINE 614 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               | otherwise -> failWith "GHC.Internal.IO.Handle.consoleRead" err
          b_read <- fromIntegral <$> peek res
          if b_read /= 1
              then return b_read
              else do w_first <- peekElemOff w_ptr 0
                      case () of
                        -- Handle Ctrl+Z which is the actual EOL sequence on

                        -- windows, but also handle Ctrl+D which is what the

                        -- ASCII standard defines as EOL.

                        _ | w_first == fromIntegral acCtrlD -> return 0
                          | w_first == fromIntegral acCtrlZ -> return 0
                          | otherwise                       -> return b_read
        True -> do
          debugIO "consoleRead :: cooked I/O read."
          -- Input is cooked, don't wait till a line return and consume all

          -- characters as they are.  Technically this function can handle any

          -- console event.  Including mouse, window and virtual key events

          -- but for now I'm only interested in key presses.

          let entries = fromIntegral $ bytes `div` ((20))
{-# LINE 633 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
          allocaBytes entries $ \p_inputs ->
            maybeReadEvent p_inputs entries res ptr

          -- Check to see if we have been explicitly asked to do a non-blocking

          -- I/O, and if we were, make sure that if we didn't have any console

          -- events that we don't block.

    where maybeReadEvent p_inputs entries res w_ptr =
            case (not blocking) of
              True -> do
                avail <- with (0 :: DWORD) $ \num_events_ptr -> do
                  failIfFalse_ "GHC.Internal.IO.Handle.consoleRead [non-blocking]" $
                    c_get_num_console_inputs (toHANDLE hwnd) num_events_ptr
                  peek num_events_ptr
                debugIO $ "consoleRead [avail] :: " ++ show avail
                if avail > 0
                  then readEvent p_inputs entries res w_ptr
                  else return 0
              False -> readEvent p_inputs entries res w_ptr

          -- Unconditionally issue the first read, but conditionally

          -- do the recursion.

          readEvent p_inputs entries res w_ptr = do
            failIfFalse_ "GHC.Internal.IO.Handle.consoleRead" $
              c_read_console_input (toHANDLE hwnd) p_inputs
                                   (fromIntegral entries) res

            b_read <- fromIntegral <$> peek res
            read <- cobble b_read w_ptr p_inputs
            debugIO $ "readEvent: =" ++ show read
            if read > 0
               then return $ fromIntegral read
               else maybeReadEvent p_inputs entries res w_ptr

          -- Dereference and read console input records.  We only read the bare

          -- minimum required to know which key/sequences were pressed.  To do

          -- this and prevent having to fully port the PINPUT_RECORD structure

          -- in Haskell we use some GCC builtins to find the correct offsets.

          cobble :: Int -> Ptr Word8 -> PINPUT_RECORD -> IO Int
          cobble 0 _ _ = do debugIO "cobble: done."
                            return 0
          cobble n w_ptr p_inputs =
            do eventType <- peekByteOff p_inputs 0 :: IO WORD
               debugIO $ "cobble: Length=" ++ show n
               debugIO $ "cobble: Type=" ++ show eventType
               let ni_offset      = (20)
{-# LINE 678 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               let event          = 4
{-# LINE 679 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               let char_offset    = event + 10
{-# LINE 680 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               let btnDown_offset = event + 0
{-# LINE 681 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               let repeat_offset  = event + 4
{-# LINE 682 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               let n'             = n - 1
               let p_inputs'      = p_inputs `plusPtr` ni_offset
               btnDown  <- peekByteOff p_inputs btnDown_offset
               repeated <- fromIntegral <$> (peekByteOff p_inputs repeat_offset :: IO WORD)
               debugIO $ "cobble: BtnDown=" ++ show btnDown
               -- Handle the key only on button down and not on button up.

               if eventType == 1 && btnDown
{-# LINE 689 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                  then do debugIO $ "cobble: read-char."
                          char <- peekByteOff p_inputs char_offset
                          let w_ptr' = w_ptr `plusPtr` 1
                          debugIO $ "cobble: offset - " ++ show char_offset
                          debugIO $ "cobble: show > " ++ show char
                          debugIO $ "cobble: repeat: " ++ show repeated
                          -- The documentation here is rather subtle, but

                          -- according to MSDN the uWChar being provided here

                          -- has been "translated".  What this actually means

                          -- is that the surrogate pairs have already been

                          -- translated into byte sequences.  That is, despite

                          -- the Word16 storage type, it's actually a byte

                          -- stream.  This means we shouldn't try to decode

                          -- to UTF-8 again since we'd end up incorrectly

                          -- interpreting two bytes as an extended unicode

                          -- character.

                          pokeArray w_ptr $ replicate repeated char
                          (+repeated) <$> cobble n' w_ptr' p_inputs'
                  else do debugIO $ "cobble: skip event."
                          cobble n' w_ptr p_inputs'


consoleReadNonBlocking :: Io ConsoleHandle -> Ptr Word8 -> Word64 -> Int
                       -> IO (Maybe Int)
consoleReadNonBlocking hwnd ptr offset bytes
  = Just <$> consoleRead False hwnd ptr offset bytes

-- -----------------------------------------------------------------------------

-- Operations on file handles


handle_ready :: RawHandle a => a -> Bool -> Int -> IO Bool
handle_ready hwnd write msecs = do
  r <- throwErrnoIfMinus1Retry "GHC.Internal.IO.Windows.Handle.handle_ready" $
          c_handle_ready (toHANDLE hwnd) write (fromIntegral msecs)
  return (toEnum (fromIntegral r))

handle_is_console :: RawHandle a => a -> IO Bool
handle_is_console = c_is_console . toHANDLE

handle_close :: RawHandle a => a -> IO ()
handle_close h = do release h
                    failIfFalse_ "handle_close" $ c_close_handle (toHANDLE h)

handle_dev_type :: RawHandle a => a -> IO IODeviceType
handle_dev_type hwnd = do _type <- c_handle_type $ toHANDLE hwnd
                          return $ case _type of
                                     _ | _type == 3 -> Stream
                                       | _type == 5 -> RawDevice
                                       | otherwise  -> RegularFile

handle_is_seekable :: RawHandle a => a -> IO Bool
handle_is_seekable hwnd = do
  t <- handle_dev_type hwnd
  return (t == RegularFile || t == RawDevice)

handle_seek :: RawHandle a => a -> SeekMode -> Integer -> IO Integer
handle_seek hwnd mode off =
  with 0 $ \off_rel -> do
    failIfFalse_ "GHC.Internal.IO.Handle.handle_seek" $
        c_set_file_pointer (toHANDLE hwnd) (fromIntegral off) seektype off_rel
    fromIntegral <$> peek off_rel
 where
    seektype :: DWORD
    seektype = case mode of
                   AbsoluteSeek -> 0
{-# LINE 754 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                   RelativeSeek -> 1
{-# LINE 755 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                   SeekFromEnd  -> 2
{-# LINE 756 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}

handle_tell :: RawHandle a => a -> IO Integer
handle_tell hwnd =
   fromIntegral `fmap`
      (throwErrnoIfMinus1Retry "GHC.Internal.IO.Handle.handle_tell" $
          c_get_file_pointer (toHANDLE hwnd))

handle_set_size :: RawHandle a => a -> Integer -> IO ()
handle_set_size hwnd size =
  failIfFalse_ "GHC.Internal.IO.Handle.handle_set_size" $
      c_set_file_size (toHANDLE hwnd) (fromIntegral size)

handle_get_size :: RawHandle a => a -> IO Integer
handle_get_size hwnd =
   fromIntegral `fmap`
      (throwErrnoIfMinus1Retry "GHC.Internal.IO.Handle.handle_set_size" $
          c_get_file_size (toHANDLE hwnd))

handle_set_echo :: RawHandle a => a -> Bool -> IO ()
handle_set_echo hwnd value =
  failIfFalse_ "GHC.Internal.IO.Handle.handle_set_echo" $
      c_set_console_echo (toHANDLE hwnd) value

handle_get_echo :: RawHandle a => a -> IO Bool
handle_get_echo = c_get_console_echo . toHANDLE

handle_duplicate :: RawHandle a => a -> IO a
handle_duplicate hwnd = alloca $ \ptr -> do
  failIfFalse_ "GHC.Internal.IO.Handle.handle_duplicate" $
      c_duplicate_handle (toHANDLE hwnd) ptr
  fromHANDLE <$> peek ptr

console_set_buffering :: Io ConsoleHandle -> Bool -> IO ()
console_set_buffering hwnd value = setCooked hwnd value >> return ()

handle_set_buffering :: RawHandle a => a -> Bool -> IO ()
handle_set_buffering hwnd value =
  failIfFalse_ "GHC.Internal.IO.Handle.handle_set_buffering" $
      c_set_console_buffering (toHANDLE hwnd) value

handle_console_seek :: RawHandle a => a -> SeekMode -> Integer -> IO Integer
handle_console_seek hwnd mode off =
  with 0 $ \loc_ptr -> do
    failIfFalse_ "GHC.Internal.IO.Handle.handle_console_seek" $
      c_set_console_pointer (toHANDLE hwnd) (fromIntegral off) seektype loc_ptr
    fromIntegral <$> peek loc_ptr
 where
    seektype :: DWORD
    seektype = case mode of
                 AbsoluteSeek -> 0
{-# LINE 806 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                 RelativeSeek -> 1
{-# LINE 807 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                 SeekFromEnd  -> 2
{-# LINE 808 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}

handle_console_tell :: RawHandle a => a -> IO Integer
handle_console_tell hwnd =
   fromIntegral `fmap`
      (throwErrnoIfMinus1Retry "GHC.Internal.IO.Handle.handle_console_tell" $
          c_get_console_pointer (toHANDLE hwnd))

handle_set_console_size :: RawHandle a => a -> Integer -> IO ()
handle_set_console_size hwnd size =
  failIfFalse_ "GHC.Internal.IO.Handle.handle_set_console_size" $
      c_set_console_buffer_size (toHANDLE hwnd) (fromIntegral size)

handle_get_console_size :: RawHandle a => a -> IO Integer
handle_get_console_size hwnd =
   fromIntegral `fmap`
      (throwErrnoIfMinus1Retry "GHC.Internal.IO.Handle.handle_get_console_size" $
          c_get_console_buffer_size (toHANDLE hwnd))

-- -----------------------------------------------------------------------------

-- opening files


-- | Describes if and which temp file flags to use.

data TempFileOptions = NoTemp | TempNonExcl | TempExcl deriving Eq

-- | Open a file and make an 'NativeHandle' for it.  Truncates the file to zero

-- size when the `IOMode` is `WriteMode`.

openFile
  :: FilePath -- ^ file to open

  -> IOMode   -- ^ mode in which to open the file

  -> Bool     -- ^ open the file in non-blocking mode?

  -> IO (Io NativeHandle, IODeviceType)
openFile filepath iomode non_blocking = openFile' filepath iomode non_blocking NoTemp

-- | Open a file as a temporary file and make an 'NativeHandle' for it.

-- Truncates the file to zero size when the `IOMode` is `WriteMode`.

openFileAsTemp
  :: FilePath -- ^ file to open

  -> Bool     -- ^ open the file in non-blocking mode?

  -> Bool     -- ^ Exclusive mode

  -> IO (Io NativeHandle, IODeviceType)
openFileAsTemp filepath non_blocking excl
  = openFile' filepath ReadWriteMode non_blocking (if excl then TempExcl else TempNonExcl)

-- | Open a file and make an 'NativeHandle' for it.  Truncates the file to zero

-- size when the `IOMode` is `WriteMode`.

openFile'
  :: FilePath -- ^ file to open

  -> IOMode   -- ^ mode in which to open the file

  -> Bool     -- ^ open the file in non-blocking mode?

  -> TempFileOptions
  -> IO (Io NativeHandle, IODeviceType)
openFile' filepath iomode non_blocking tmp_opts =
   do devicepath <- getDevicePath filepath
      h <- createFile devicepath
      -- Attach the handle to the I/O manager's CompletionPort.  This allows the

      -- I/O manager to service requests for this Handle.

      Mgr.associateHandle' h
      let hwnd = fromHANDLE h
      _type <- devType hwnd

      -- Use the rts to enforce any file locking we may need.

      let write_lock = iomode /= ReadMode

      case _type of
        -- Regular files need to be locked.

        -- See also Note [RTS File locking]

        RegularFile -> do
          optimizeFileAccess h -- Set a few optimization flags on file handles.

          (unique_dev, unique_ino) <- getUniqueFileInfo hwnd
          r <- lockFile (fromIntegral $ ptrToWordPtr h) unique_dev unique_ino
                        (fromBool write_lock)
          when (r == -1)  $
               ioException (IOError Nothing ResourceBusy "openFile"
                                  "file is locked" Nothing Nothing)

        -- I don't see a reason for blocking directories.  So unlike the FD

        -- implementation I'll allow it.

        _ -> return ()

      -- We want to truncate() if this is an open in WriteMode, but only

      -- if the target is a RegularFile.  but TRUNCATE_EXISTING would fail if

      -- the file didn't exit.  So just set the size afterwards.

      when (iomode == WriteMode && _type == RegularFile) $
        setSize hwnd 0

      return (hwnd, _type)
        where
          flagIf p f2
            | p         = f2
            | otherwise = 0
          -- We have to use in-process locking (e.g. use the locking mechanism

          -- in the rts) so we're consistent with the linux behavior and the

          -- rts knows about the lock.  See #4363 for more.

          file_share_mode =  1
{-# LINE 902 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                         .|. 4
{-# LINE 903 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                         -- Don't support shared writing for temp files.

                         .|. (flagIf (tmp_opts == NoTemp)
                                     2)
{-# LINE 906 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}

          file_access_mode =
            case iomode of
              ReadMode      -> 2147483648
{-# LINE 910 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
              WriteMode     -> 1073741824
{-# LINE 911 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
              ReadWriteMode -> 2147483648
{-# LINE 912 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                            .|. 1073741824
{-# LINE 913 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
              AppendMode    -> 1073741824
{-# LINE 914 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                            .|. 4
{-# LINE 915 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}

          file_open_mode =
            case iomode of
              ReadMode      -> 3 -- O_RDONLY

{-# LINE 919 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
              WriteMode     -> 4   -- O_CREAT | O_WRONLY | O_TRUNC

{-# LINE 920 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
              ReadWriteMode ->
                case tmp_opts of
                  NoTemp    -> 4   -- O_CREAT | O_RDWR

{-# LINE 923 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                  TempNonExcl ->  2 -- O_CREAT | O_RDWR

{-# LINE 924 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                  TempExcl  -> 1    -- O_CREAT | O_RDWR | O_EXCL

{-# LINE 925 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
              AppendMode    -> 4   -- O_APPEND

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

          file_create_flags =
            if non_blocking
               -- On Windows, the choice of whether an operation completes

               -- asynchronously or not depends on how the Handle was created

               -- and not on the operation called.  As in, the behaviour of

               -- ReadFile and WriteFile depends on the flags used to open the

               -- handle.   For WinIO we always use FILE_FLAG_OVERLAPPED, which

               -- means we always issue asynchronous file operation using an

               -- OVERLAPPED structure.  All blocking, if required must be done

               -- on the Haskell side by using existing mechanisms such as MVar

               -- or IOPorts.

               then 1073741824
{-# LINE 939 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                    -- I believe most haskell programs do sequential scans, so

                    -- optimize for the common case.  Though ideally, this would

                    -- be parameterized by openFile.  This will absolutely trash

                    -- the cache on reverse scans.

                    --

                    -- TODO: make a parameter to openFile and specify only for

                    -- operations we know are sequential.  This parameter should

                    -- be usable by madvise too.

                    .|. 134217728
{-# LINE 948 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                    .|. (flagIf (tmp_opts /= NoTemp)
                                -- Hold data in cache for as long as possible

                                256 )
{-# LINE 951 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
               else 128
{-# LINE 952 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
                    .|. (flagIf (tmp_opts /= NoTemp)
                                -- Hold data in cache for as long as possible

                                256 )
{-# LINE 955 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}

          createFile devicepath =
            withCWString devicepath $ \fp ->
                failIf (== iNVALID_HANDLE_VALUE) "CreateFile" $
                      c_CreateFile fp file_access_mode
                                      file_share_mode
                                      nullPtr
                                      file_open_mode
                                      file_create_flags
                                      nullPtr

-- Tell the OS that we support skipping the request Queue if the

-- IRQ can be handled immediately, e.g. if the data is in the cache.

optimizeFileAccess :: HANDLE -> IO ()
optimizeFileAccess handle =
    failIfFalse_ "SetFileCompletionNotificationModes"  $
      c_SetFileCompletionNotificationModes handle
          (    1
{-# LINE 973 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
            .|. 2)
{-# LINE 974 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}

-- Reconstruct an I/O mode from an open HANDLE

handleToMode :: HANDLE -> IO IOMode
handleToMode hwnd = do
  mask <- c_get_handle_access_mask hwnd
  let hasFlag flag = (flag .&. mask) == flag
  case () of
    () | hasFlag (4)                        -> return AppendMode
{-# LINE 982 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
       | hasFlag (1073741824 .|. 2147483648) -> return ReadWriteMode
{-# LINE 983 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
       | hasFlag (2147483648)                            -> return ReadMode
{-# LINE 984 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
       | hasFlag (1073741824)                           -> return WriteMode
{-# LINE 985 "libraries\\ghc-internal\\src\\GHC\\Internal\\IO\\Windows\\Handle.hsc" #-}
       | otherwise -> error "unknown access mask in handleToMode."

foreign import ccall unsafe "__get_handle_access_mask"
  c_get_handle_access_mask :: HANDLE -> IO DWORD

release :: RawHandle a => a -> IO ()
release h = if isLockable h
               then do let handle = fromIntegral $ ptrToWordPtr $ toHANDLE h
                       _ <- unlockFile handle
                       return ()
               else return ()

-- -----------------------------------------------------------------------------

-- Locking/unlocking


foreign import ccall unsafe "lockFile"
  lockFile :: CUIntPtr -> Word64 -> Word64 -> CInt -> IO CInt

foreign import ccall unsafe "unlockFile"
  unlockFile :: CUIntPtr -> IO CInt

-- | Returns -1 on error. Otherwise writes two values representing

-- the file into the given ptrs.

foreign import ccall unsafe "get_unique_file_info_hwnd"
  c_getUniqueFileInfo :: HANDLE -> Ptr Word64 -> Ptr Word64 -> IO ()

-- | getUniqueFileInfo assumes the C call to getUniqueFileInfo

-- succeeds.

getUniqueFileInfo :: RawHandle a => a -> IO (Word64, Word64)
getUniqueFileInfo handle = do
  with 0 $ \devptr -> do
    with 0 $ \inoptr -> do
      c_getUniqueFileInfo (toHANDLE handle) devptr inoptr
      liftM2 (,) (peek devptr) (peek inoptr)