{-# LINE 1 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE PackageImports   #-}

module System.File.Platform where

import Control.Exception (bracketOnError, try, SomeException, onException)
import Data.Bits
import Data.Maybe (fromJust)
import System.IO (IOMode(..), Handle)
import System.OsPath.Windows ( WindowsPath )
import qualified System.OsPath.Windows as WS
import Foreign.C.Types

import qualified System.OsString.Windows as WS hiding (decodeFS)
import System.OsString.Windows ( encodeUtf, WindowsString )
import qualified System.Win32 as Win32
import qualified System.Win32.WindowsString.File as WS
import System.Win32.WindowsString.Types (withTString, peekTString)

{-# LINE 21 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
import System.Win32.WindowsString.Types (withFilePath)

{-# LINE 23 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
import Control.Monad (when, void)

{-# LINE 27 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
import GHC.IO.Handle.FD (fdToHandle')


{-# LINE 30 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
import GHC.IORef (atomicModifyIORef'_)
import Foreign.C (getErrno, errnoToIOError)
import Data.IORef (IORef, newIORef)
import Foreign.C.String
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils (with)
import Foreign.Storable
import System.CPUTime (cpuTimePrecision, getCPUTime)
import System.Posix.Types (CMode)
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Internals (c_getpid, o_EXCL)
import Text.Printf (printf)


{-# LINE 45 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
import System.OsString.Encoding
import "os-string" System.OsString.Internal.Types (WindowsString(..), WindowsChar(..))
import qualified "os-string" System.OsString.Data.ByteString.Short as BC

{-# LINE 54 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}

-- | Open a file and return the 'Handle'.

openFile :: WindowsPath -> IOMode -> IO Handle
openFile :: WindowsPath -> IOMode -> IO Handle
openFile WindowsPath
fp IOMode
iomode = IO HANDLE
-> (HANDLE -> IO ()) -> (HANDLE -> IO Handle) -> IO Handle
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
    (WindowsPath
-> Word32
-> Word32
-> Maybe LPSECURITY_ATTRIBUTES
-> Word32
-> Word32
-> Maybe HANDLE
-> IO HANDLE
WS.createFile
      WindowsPath
fp
      Word32
accessMode
      Word32
shareMode
      Maybe LPSECURITY_ATTRIBUTES
forall a. Maybe a
Nothing
      Word32
createMode

{-# LINE 70 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
      Word32
Win32.fILE_ATTRIBUTE_NORMAL

{-# LINE 72 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
      Nothing)
    HANDLE -> IO ()
Win32.closeHandle
    (WindowsPath -> IOMode -> HANDLE -> IO Handle
toHandle WindowsPath
fp IOMode
iomode)
 where
  accessMode :: Word32
accessMode = case IOMode
iomode of
    IOMode
ReadMode      -> Word32
Win32.gENERIC_READ
    IOMode
WriteMode     -> Word32
Win32.gENERIC_WRITE
    IOMode
AppendMode    -> Word32
Win32.gENERIC_WRITE Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
Win32.fILE_APPEND_DATA
    IOMode
ReadWriteMode -> Word32
Win32.gENERIC_READ Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
Win32.gENERIC_WRITE

  createMode :: Word32
createMode = case IOMode
iomode of
    IOMode
ReadMode      -> Word32
Win32.oPEN_EXISTING
    IOMode
WriteMode     -> Word32
Win32.cREATE_ALWAYS
    IOMode
AppendMode    -> Word32
Win32.oPEN_ALWAYS
    IOMode
ReadWriteMode -> Word32
Win32.oPEN_ALWAYS

  shareMode :: Word32
shareMode = case IOMode
iomode of
    IOMode
ReadMode      -> Word32
Win32.fILE_SHARE_READ
    IOMode
WriteMode     -> Word32
writeShareMode
    IOMode
AppendMode    -> Word32
writeShareMode
    IOMode
ReadWriteMode -> Word32
maxShareMode

maxShareMode :: Win32.ShareMode
maxShareMode :: Word32
maxShareMode =
  Word32
Win32.fILE_SHARE_DELETE Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  Word32
Win32.fILE_SHARE_READ   Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  Word32
Win32.fILE_SHARE_WRITE

writeShareMode :: Win32.ShareMode
writeShareMode :: Word32
writeShareMode =
  Word32
Win32.fILE_SHARE_DELETE Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
  Word32
Win32.fILE_SHARE_READ

-- | Open an existing file and return the 'Handle'.

openExistingFile :: WindowsPath -> IOMode -> IO Handle
openExistingFile :: WindowsPath -> IOMode -> IO Handle
openExistingFile WindowsPath
fp IOMode
iomode = IO HANDLE
-> (HANDLE -> IO ()) -> (HANDLE -> IO Handle) -> IO Handle
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
    (WindowsPath
-> Word32
-> Word32
-> Maybe LPSECURITY_ATTRIBUTES
-> Word32
-> Word32
-> Maybe HANDLE
-> IO HANDLE
WS.createFile
      WindowsPath
fp
      Word32
accessMode
      Word32
shareMode
      Maybe LPSECURITY_ATTRIBUTES
forall a. Maybe a
Nothing
      Word32
createMode

{-# LINE 120 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
      Word32
Win32.fILE_ATTRIBUTE_NORMAL

{-# LINE 122 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
      Nothing)
    HANDLE -> IO ()
Win32.closeHandle
    (WindowsPath -> IOMode -> HANDLE -> IO Handle
toHandle WindowsPath
fp IOMode
iomode)
 where
  accessMode :: Word32
accessMode = case IOMode
iomode of
    IOMode
ReadMode      -> Word32
Win32.gENERIC_READ
    IOMode
WriteMode     -> Word32
Win32.gENERIC_WRITE
    IOMode
AppendMode    -> Word32
Win32.gENERIC_WRITE Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
Win32.fILE_APPEND_DATA
    IOMode
ReadWriteMode -> Word32
Win32.gENERIC_READ Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word32
Win32.gENERIC_WRITE

  createMode :: Word32
createMode = case IOMode
iomode of
    IOMode
ReadMode      -> Word32
Win32.oPEN_EXISTING
    IOMode
WriteMode     -> Word32
Win32.tRUNCATE_EXISTING
    IOMode
AppendMode    -> Word32
Win32.oPEN_EXISTING
    IOMode
ReadWriteMode -> Word32
Win32.oPEN_EXISTING

  shareMode :: Word32
shareMode = case IOMode
iomode of
    IOMode
ReadMode      -> Word32
Win32.fILE_SHARE_READ
    IOMode
WriteMode     -> Word32
writeShareMode
    IOMode
AppendMode    -> Word32
writeShareMode
    IOMode
ReadWriteMode -> Word32
maxShareMode


{-# LINE 145 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
foreign import ccall "_open_osfhandle"
  _open_osfhandle :: CIntPtr -> CInt -> IO CInt

{-# LINE 148 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}

openFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle
openFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle
openFileWithCloseOnExec = WindowsPath -> IOMode -> IO Handle
openFile

openExistingFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec :: WindowsPath -> IOMode -> IO Handle
openExistingFileWithCloseOnExec = WindowsPath -> IOMode -> IO Handle
openExistingFile

findTempName :: (WindowsString, WindowsString)
             -> String
             -> WindowsPath
             -> CMode
             -> IO (WindowsPath, Handle)
findTempName :: (WindowsPath, WindowsPath)
-> [Char] -> WindowsPath -> CMode -> IO (WindowsPath, Handle)
findTempName (WindowsPath
prefix, WindowsPath
suffix) [Char]
loc WindowsPath
tmp_dir CMode
mode = IO (WindowsPath, Handle)
go
 where
  go :: IO (WindowsPath, Handle)
go = do
    let label :: WindowsPath
label = if WindowsPath
prefix WindowsPath -> WindowsPath -> Bool
forall a. Eq a => a -> a -> Bool
== WindowsPath
forall a. Monoid a => a
mempty then Maybe WindowsPath -> WindowsPath
forall a. HasCallStack => Maybe a -> a
fromJust ([Char] -> Maybe WindowsPath
forall (m :: * -> *). MonadThrow m => [Char] -> m WindowsPath
encodeUtf [Char]
"ghc") else WindowsPath
prefix

{-# LINE 165 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
    withFilePath tmp_dir $ \c_tmp_dir ->

{-# LINE 169 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
      withTString label $ \c_template ->
        withTString suffix $ \c_suffix ->

{-# LINE 172 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
          with nullPtr $ \c_ptr -> do
            res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr
            if not res
               then do errno <- getErrno
                       ioError (errnoToIOError loc errno Nothing (Just $ lenientDecode tmp_dir))
               else do c_p <- peek c_ptr
                       filename <- peekTString c_p
                       free c_p
                       let flags = fromIntegral mode .&. o_EXCL
                       handleResultsWinIO filename (flags == o_EXCL)

{-# LINE 195 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}

  handleResultsWinIO :: WindowsPath -> Bool -> IO (WindowsPath, Handle)
handleResultsWinIO WindowsPath
filename Bool
excl = do
    h <- (if Bool
excl then WindowsPath -> IOMode -> IO Handle
openExistingFile else WindowsPath -> IOMode -> IO Handle
openFile) WindowsPath
filename IOMode
ReadWriteMode
    return (filename, h)


{-# LINE 201 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
foreign import ccall "__createUUIDTempFileErrNo" c_createUUIDTempFileErrNo
  :: CWString -> CWString -> CWString -> Ptr CWString -> IO Bool

{-# LINE 207 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}



tempCounter :: IORef Int
tempCounter :: IORef Int
tempCounter = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
{-# NOINLINE tempCounter #-}

-- build large digit-alike number

rand_string :: IO WindowsPath
rand_string :: IO WindowsPath
rand_string = do
  r1 <- forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Int (CPid -> Int) -> IO CPid -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO CPid
c_getpid
  (r2, _) <- atomicModifyIORef'_ tempCounter (+1)
  r3 <- (`quot` cpuTimePrecision) <$> getCPUTime
  return $ WS.pack $ fmap (WS.unsafeFromChar) (printf "%x-%x-%x" r1 r2 r3)

lenientDecode :: WindowsString -> String
lenientDecode :: WindowsPath -> [Char]
lenientDecode WindowsPath
ws = let utf16le' :: Either EncodingException [Char]
utf16le' = TextEncoding -> WindowsPath -> Either EncodingException [Char]
WS.decodeWith TextEncoding
utf16le_b WindowsPath
ws
                       ucs2' :: Either EncodingException [Char]
ucs2' = TextEncoding -> WindowsPath -> Either EncodingException [Char]
WS.decodeWith TextEncoding
ucs2le WindowsPath
ws
                   in case (Either EncodingException [Char]
utf16le', Either EncodingException [Char]
ucs2') of
                        (Right [Char]
s, ~Either EncodingException [Char]
_) -> [Char]
s
                        (Either EncodingException [Char]
_, Right [Char]
s) -> [Char]
s
                        (Left EncodingException
_, Left EncodingException
_) -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error [Char]
"lenientDecode: failed to decode"


toHandle :: WindowsPath -> IOMode -> Win32.HANDLE -> IO Handle

{-# LINE 237 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
toHandle :: WindowsPath -> IOMode -> HANDLE -> IO Handle
toHandle WindowsPath
fp IOMode
iomode HANDLE
h = (IO Handle -> IO () -> IO Handle
forall a b. IO a -> IO b -> IO a
`onException` HANDLE -> IO ()
Win32.closeHandle HANDLE
h) (IO Handle -> IO Handle) -> IO Handle -> IO Handle
forall a b. (a -> b) -> a -> b
$ do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IOMode
iomode IOMode -> IOMode -> Bool
forall a. Eq a => a -> a -> Bool
== IOMode
AppendMode ) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ HANDLE -> Int64 -> Word32 -> IO Int64
Win32.setFilePointerEx HANDLE
h Int64
0 Word32
Win32.fILE_END
    fd <- CIntPtr -> CInt -> IO CInt
_open_osfhandle (IntPtr -> CIntPtr
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HANDLE -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr HANDLE
h)) (CInt
32768)
{-# LINE 240 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}
    fp' <- either (const (fmap WS.toChar . WS.unpack $ fp)) id <$> try @SomeException (WS.decodeFS fp)
    fdToHandle' fd Nothing False fp' iomode True

{-# LINE 243 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}


{-# LINE 250 "libraries\\file-io\\windows\\System\\File\\Platform.hsc" #-}