    {-# OPTIONS_GHC -optc-DWINVER=0x0600 #-}
    {-# OPTIONS_GHC -optc-D_WIN32_WINNT=0x0600 #-}
    {-# LINE 1 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    {-# LINE 4 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
    {-# LANGUAGE Safe #-}

    {-# LINE 8 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
    -----------------------------------------------------------------------------

    -- |

    -- Module      :  System.Win32.MinTTY

    -- Copyright   :  (c) University of Glasgow 2006

    -- License     :  BSD-style (see the file LICENSE)

    --

    -- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>

    -- Stability   :  provisional

    -- Portability :  portable

    --

    -- A function to check if the current terminal uses an old version of MinTTY

    -- that emulates a TTY. Note, however, that this does not check for more recent

    -- versions of MinTTY that use the native Windows console PTY directly. The old

    -- approach (where MinTTY emulates a TTY) sometimes requires different

    -- approaches to handling keyboard inputs.

    --

    -- Much of this code was originally authored by Phil Ruffwind and the

    -- git-for-windows project.

    --

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

    module System.Win32.MinTTY (isMinTTY, isMinTTYHandle) where

    import Graphics.Win32.Misc
    import System.Win32.DLL
    import System.Win32.File
    import System.Win32.Types

    {-# LINE 37 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
    import Control.Exception (catch)

    {-# LINE 39 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
    import Data.List (isInfixOf)
    import Foreign
    import Foreign.C.Types

    {-# LINE 46 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}

    -- The headers that are shipped with GHC's copy of MinGW-w64 assume Windows XP.

    -- Since we need some structs that are only available with Vista or later,

    -- we must manually set WINVER/_WIN32_WINNT accordingly.

    #include "windows_cconv.h"

    -- | Returns 'True' if the current process's standard error is attached to an

    -- emulated MinTTY console (e.g., Cygwin or MSYS that use an old version of

    -- MinTTY). Returns 'False' otherwise.

    isMinTTY :: IO Bool
    isMinTTY = do
        h <- getStdHandle sTD_ERROR_HANDLE
               `catch` \(_ :: IOError) ->
                 return nullHANDLE
        if h == nullHANDLE
           then return False
           else isMinTTYHandle h

    -- | Returns 'True' is the given handle is attached to an emulated MinTTY

    -- console (e.g., Cygwin or MSYS that use an old version of MinTTY). Returns

    -- 'False' otherwise.

    isMinTTYHandle :: HANDLE -> IO Bool
    isMinTTYHandle h = do
        fileType <- getFileType h
        if fileType /= fILE_TYPE_PIPE
          then return False
          else isMinTTYVista h `catch` \(_ :: IOError) -> isMinTTYCompat h
          -- GetFileNameByHandleEx is only available on Vista and later (hence

          -- the name isMinTTYVista). If we're on an older version of Windows,

          -- getProcAddress will throw an IOException when it fails to find

          -- GetFileNameByHandleEx, and thus we will default to using

          -- NtQueryObject (isMinTTYCompat).

    isMinTTYVista :: HANDLE -> IO Bool
    isMinTTYVista h = do
        fn <- getFileNameByHandle h
        return $ cygwinMSYSCheck fn
      `catch` \(_ :: IOError) ->
        return False

    isMinTTYCompat :: HANDLE -> IO Bool
    isMinTTYCompat h = do
        fn <- ntQueryObjectNameInformation h
        return $ cygwinMSYSCheck fn
      `catch` \(_ :: IOError) ->
        return False

    cygwinMSYSCheck :: String -> Bool
    cygwinMSYSCheck fn = ("cygwin-" `isInfixOf` fn || "msys-" `isInfixOf` fn) &&
                "-pty" `isInfixOf` fn
    -- Note that GetFileInformationByHandleEx might return a filepath like:

    --

    --    \msys-dd50a72ab4668b33-pty1-to-master

    --

    -- But NtQueryObject might return something like:

    --

    --    \Device\NamedPipe\msys-dd50a72ab4668b33-pty1-to-master

    --

    -- This means we can't rely on "\cygwin-" or "\msys-" being at the very start

    -- of the filepath. As a result, we use `isPrefixOf` to check for "cygwin" and

    -- "msys".

    --

    -- It's unclear if "-master" will always appear in the filepath name. Recent

    -- versions of MinTTY have been known to give filepaths like this (#186):

    --

    --    \msys-dd50a72ab4668b33-pty0-to-master-nat

    --

    -- Just in case MinTTY ever changes this convention, we don't bother checking

    -- for the presence of "-master" in the filepath name at all.

    getFileNameByHandle :: HANDLE -> IO String
    getFileNameByHandle h = do
      let sizeOfDWORD = sizeOf (undefined :: DWORD)
          -- note: implicitly assuming that DWORD has stronger alignment than wchar_t

          bufSize     = sizeOfDWORD + mAX_PATH * sizeOfTCHAR
      allocaBytes bufSize $ \buf -> do
        getFileInformationByHandleEx h fileNameInfo buf (fromIntegral bufSize)
        fni <- peek buf
        return $ fniFileName fni

    getFileInformationByHandleEx
      :: HANDLE -> CInt -> Ptr FILE_NAME_INFO -> DWORD -> IO ()
    getFileInformationByHandleEx h cls buf bufSize = do
      lib <- getModuleHandle (Just "kernel32.dll")
      ptr <- getProcAddress lib "GetFileInformationByHandleEx"
      let c_GetFileInformationByHandleEx =
            mk_GetFileInformationByHandleEx (castPtrToFunPtr ptr)
      failIfFalse_ "getFileInformationByHandleEx"
        (c_GetFileInformationByHandleEx h cls buf bufSize)

    ntQueryObjectNameInformation :: HANDLE -> IO String
    ntQueryObjectNameInformation h = do
      let sizeOfONI = sizeOf (undefined :: OBJECT_NAME_INFORMATION)
          bufSize   = sizeOfONI + mAX_PATH * sizeOfTCHAR
      allocaBytes bufSize $ \buf ->
        alloca $ \p_len -> do
          hwnd <- getModuleHandle (Just "ntdll.exe")
          addr <- getProcAddress hwnd "NtQueryObject"
          let c_NtQueryObject = mk_NtQueryObject (castPtrToFunPtr addr)
          _ <- failIfNeg "NtQueryObject" $ c_NtQueryObject
                 h objectNameInformation buf (fromIntegral bufSize) p_len
          oni <- peek buf
          return $ usBuffer $ oniName oni

    fileNameInfo :: CInt
    fileNameInfo = 2
    {-# LINE 158 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}

    mAX_PATH :: Num a => a
    mAX_PATH = 260
    {-# LINE 161 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}

    objectNameInformation :: CInt
    objectNameInformation = 1
    {-# LINE 164 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}

    type F_NtQueryObject = HANDLE -> CInt -> Ptr OBJECT_NAME_INFORMATION
                         -> ULONG -> Ptr ULONG -> IO NTSTATUS

    foreign import WINDOWS_CCONV "dynamic"
      mk_NtQueryObject :: FunPtr F_NtQueryObject -> F_NtQueryObject

    type F_GetFileInformationByHandleEx =
      HANDLE -> CInt -> Ptr FILE_NAME_INFO -> DWORD -> IO BOOL

    foreign import WINDOWS_CCONV "dynamic"
      mk_GetFileInformationByHandleEx
        :: FunPtr F_GetFileInformationByHandleEx -> F_GetFileInformationByHandleEx

    data FILE_NAME_INFO = FILE_NAME_INFO
      { fniFileNameLength :: DWORD
      , fniFileName       :: String
      } deriving Show

    instance Storable FILE_NAME_INFO where
        sizeOf    _ = (8)
    {-# LINE 185 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        alignment _ = 4
    {-# LINE 186 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        poke buf fni = withTStringLen (fniFileName fni) $ \(str, len) -> do
            let len'  = (min mAX_PATH len) * sizeOfTCHAR
                start = advancePtr (castPtr buf) ((4))
    {-# LINE 189 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
                end   = advancePtr start len'
            ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf len'
    {-# LINE 191 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            copyArray start (castPtr str :: Ptr Word8) len'
            poke (castPtr end) (0 :: TCHAR)
        peek buf = do
            vfniFileNameLength <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
    {-# LINE 195 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            let len = fromIntegral vfniFileNameLength `div` sizeOfTCHAR
            vfniFileName <- peekTStringLen (plusPtr buf ((4)), len)
    {-# LINE 197 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            return $ FILE_NAME_INFO
              { fniFileNameLength = vfniFileNameLength
              , fniFileName       = vfniFileName
              }

    type NTSTATUS = Int32
    {-# LINE 203 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}

    newtype OBJECT_NAME_INFORMATION = OBJECT_NAME_INFORMATION
      { oniName :: UNICODE_STRING
      } deriving Show

    instance Storable OBJECT_NAME_INFORMATION where
        sizeOf    _ = (16)
    {-# LINE 210 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        alignment _ = 8
    {-# LINE 211 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        poke buf oni = ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) buf (oniName oni)
    {-# LINE 212 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        peek buf = fmap OBJECT_NAME_INFORMATION $ ((\hsc_ptr -> peekByteOff hsc_ptr 0)) buf
    {-# LINE 213 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}

    data UNICODE_STRING = UNICODE_STRING
      { usLength        :: USHORT
      , usMaximumLength :: USHORT
      , usBuffer        :: String
      } deriving Show

    instance Storable UNICODE_STRING where
        sizeOf    _ = (16)
    {-# LINE 222 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        alignment _ = 8
    {-# LINE 223 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
        poke buf us = withTStringLen (usBuffer us) $ \(str, len) -> do
            let len'  = (min mAX_PATH len) * sizeOfTCHAR
                start = advancePtr (castPtr buf) ((16))
    {-# LINE 226 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
                end   = advancePtr start len'
            ((\hsc_ptr -> pokeByteOff hsc_ptr 0))        buf len'
    {-# LINE 228 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) buf (len' + sizeOfTCHAR)
    {-# LINE 229 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            ((\hsc_ptr -> pokeByteOff hsc_ptr 8))        buf start
    {-# LINE 230 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            copyArray start (castPtr str :: Ptr Word8) len'
            poke (castPtr end) (0 :: TCHAR)
        peek buf = do
            vusLength        <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))        buf
    {-# LINE 234 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            vusMaximumLength <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) buf
    {-# LINE 235 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            vusBufferPtr     <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))        buf
    {-# LINE 236 "libraries\\Win32\\System\\Win32\\MinTTY.hsc" #-}
            let len          =  fromIntegral vusLength `div` sizeOfTCHAR
            vusBuffer        <- peekTStringLen (vusBufferPtr, len)
            return $ UNICODE_STRING
              { usLength        = vusLength
              , usMaximumLength = vusMaximumLength
              , usBuffer        = vusBuffer
              }

    sizeOfTCHAR :: Int
    sizeOfTCHAR = sizeOf (undefined :: TCHAR)