{-# LANGUAGE Safe #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}

{-|
    This module bridges between Haskell handles and underlying operating-system
    features.
-}
module GHC.Internal.System.IO.OS
(
    -- * Obtaining file descriptors and Windows handles
    withFileDescriptorReadingBiased,
    withFileDescriptorWritingBiased,
    withWindowsHandleReadingBiased,
    withWindowsHandleWritingBiased,
    withFileDescriptorReadingBiasedRaw,
    withFileDescriptorWritingBiasedRaw,
    withWindowsHandleReadingBiasedRaw,
    withWindowsHandleWritingBiasedRaw

    -- ** Caveats
    -- $with-ref-caveats
)
where

import GHC.Internal.Control.Monad (return)
import GHC.Internal.Control.Concurrent.MVar (MVar)
import GHC.Internal.Control.Exception (mask)
import GHC.Internal.Data.Function (const, (.), ($))
import GHC.Internal.Data.Functor (fmap)
#if defined(mingw32_HOST_OS)
import GHC.Internal.Data.Bool (otherwise)
#endif
import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe)
#if defined(mingw32_HOST_OS)
import GHC.Internal.Data.Maybe (Maybe (Just))
#endif
import GHC.Internal.Data.List ((++))
import GHC.Internal.Data.String (String)
import GHC.Internal.Data.Typeable (Typeable, cast)
import GHC.Internal.System.IO (IO)
import GHC.Internal.IO.FD (fdFD)
#if defined(mingw32_HOST_OS)
import GHC.Internal.IO.Windows.Handle
       (
           NativeHandle,
           ConsoleHandle,
           IoHandle,
           toHANDLE
       )
#endif
import GHC.Internal.IO.Handle.Types
       (
           Handle (FileHandle, DuplexHandle),
           Handle__ (Handle__, haDevice)
       )
import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer)
import GHC.Internal.IO.Exception
       (
           IOErrorType (InappropriateType),
           IOException (IOError),
           ioException
       )
import GHC.Internal.Foreign.Ptr (Ptr)
import GHC.Internal.Foreign.C.Types (CInt)

-- * Obtaining POSIX file descriptors and Windows handles

{-|
    Executes a user-provided action on an operating-system handle that underlies
    a Haskell handle. Before the user-provided action is run, user-defined
    preparation based on the handle state that contains the operating-system
    handle is performed. While the user-provided action is executed, further
    operations on the Haskell handle are blocked to a degree that interference
    with this action is prevented.

    See [below](#with-ref-caveats) for caveats regarding this operation.
-}
withOSHandle :: String
                -- ^ The name of the overall operation
             -> (Handle -> MVar Handle__)
                {-^
                    Obtaining of the handle state variable that holds the
                    operating-system handle
                -}
             -> (forall d. Typeable d => d -> IO a)
                -- ^ Conversion of a device into an operating-system handle
             -> (Handle__ -> IO ())
                -- ^ The preparation
             -> Handle
                -- ^ The Haskell handle to use
             -> (a -> IO r)
                -- ^ The action to execute on the operating-system handle
             -> IO r
withOSHandle :: forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
opName Handle -> MVar Handle__
handleStateVar forall d. Typeable d => d -> IO a
getOSHandle Handle__ -> IO ()
prepare Handle
handle a -> IO r
act
    = ((forall a. IO a -> IO a) -> IO r) -> IO r
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO r) -> IO r)
-> ((forall a. IO a -> IO a) -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \ forall a. IO a -> IO a
withOriginalMaskingState ->
      (Handle__ -> IO r) -> IO r
forall {a}. (Handle__ -> IO a) -> IO a
withHandleState ((Handle__ -> IO r) -> IO r) -> (Handle__ -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ \ handleState :: Handle__
handleState@Handle__ {haDevice :: ()
haDevice = dev
dev} -> do
          osHandle <- dev -> IO a
forall d. Typeable d => d -> IO a
getOSHandle dev
dev
          prepare handleState
          withOriginalMaskingState $ act osHandle
      where

      withHandleState :: (Handle__ -> IO a) -> IO a
withHandleState = String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
forall a.
String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
withHandle_' String
opName Handle
handle (Handle -> MVar Handle__
handleStateVar Handle
handle)
{-
    The 'withHandle_'' operation, which we use here, already performs masking.
    Still, we have to employ 'mask', in order do obtain the operation that
    restores the original masking state. The user-provided action should be
    executed with this original masking state, as there is no inherent reason to
    generally perform it with masking in place. The masking that 'withHandle_''
    performs is only for safely accessing handle state and thus constitutes an
    implementation detail; it has nothing to do with the user-provided action.
-}
{-
    The order of actions in 'withOSHandle' is such that any exception from
    'getOSHandle' is thrown before the user-defined preparation is performed.
-}

{-|
    Obtains the handle state variable that underlies a handle or specifically
    the handle state variable for reading if the handle uses different state
    variables for reading and writing.
-}
handleStateVarReadingBiased :: Handle -> MVar Handle__
handleStateVarReadingBiased :: Handle -> MVar Handle__
handleStateVarReadingBiased (FileHandle String
_ MVar Handle__
var)            = MVar Handle__
var
handleStateVarReadingBiased (DuplexHandle String
_ MVar Handle__
readingVar MVar Handle__
_) = MVar Handle__
readingVar

{-|
    Obtains the handle state variable that underlies a handle or specifically
    the handle state variable for writing if the handle uses different state
    variables for reading and writing.
-}
handleStateVarWritingBiased :: Handle -> MVar Handle__
handleStateVarWritingBiased :: Handle -> MVar Handle__
handleStateVarWritingBiased (FileHandle String
_ MVar Handle__
var)            = MVar Handle__
var
handleStateVarWritingBiased (DuplexHandle String
_ MVar Handle__
_ MVar Handle__
writingVar) = MVar Handle__
writingVar

{-|
    Yields the result of another operation if that operation succeeded, and
    otherwise throws an exception that signals that the other operation failed
    because some Haskell handle does not use an operating-system handle of a
    required type.
-}
requiringOSHandleOfType :: String
                           -- ^ The name of the operating-system handle type
                        -> Maybe a
                           {-^
                               The result of the other operation if it succeeded
                           -}
                        -> IO a
requiringOSHandleOfType :: forall a. String -> Maybe a -> IO a
requiringOSHandleOfType String
osHandleTypeName
    = IO a -> (a -> IO a) -> Maybe a -> IO a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IOException -> IO a
forall a. HasCallStack => IOException -> IO a
ioException IOException
osHandleOfTypeRequired) a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    where

    osHandleOfTypeRequired :: IOException
    osHandleOfTypeRequired :: IOException
osHandleOfTypeRequired
        = Maybe Handle
-> IOErrorType
-> String
-> String
-> Maybe CInt
-> Maybe String
-> IOException
IOError Maybe Handle
forall a. Maybe a
Nothing
                  IOErrorType
InappropriateType
                  String
""
                  (String
"handle does not use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
osHandleTypeName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s")
                  Maybe CInt
forall a. Maybe a
Nothing
                  Maybe String
forall a. Maybe a
Nothing

{-|
    Obtains the POSIX file descriptor of a device if the device contains one,
    and throws an exception otherwise.
-}
getFileDescriptor :: Typeable d => d -> IO CInt
getFileDescriptor :: forall d. Typeable d => d -> IO CInt
getFileDescriptor = String -> Maybe CInt -> IO CInt
forall a. String -> Maybe a -> IO a
requiringOSHandleOfType String
"POSIX file descriptor" (Maybe CInt -> IO CInt) -> (d -> Maybe CInt) -> d -> IO CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    (FD -> CInt) -> Maybe FD -> Maybe CInt
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FD -> CInt
fdFD (Maybe FD -> Maybe CInt) -> (d -> Maybe FD) -> d -> Maybe CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast

{-|
    Obtains the Windows handle of a device if the device contains one, and
    throws an exception otherwise.
-}
getWindowsHandle :: Typeable d => d -> IO (Ptr ())
getWindowsHandle :: forall d. Typeable d => d -> IO (Ptr ())
getWindowsHandle = String -> Maybe (Ptr ()) -> IO (Ptr ())
forall a. String -> Maybe a -> IO a
requiringOSHandleOfType String
"Windows handle" (Maybe (Ptr ()) -> IO (Ptr ()))
-> (d -> Maybe (Ptr ())) -> d -> IO (Ptr ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                   d -> Maybe (Ptr ())
forall d. Typeable d => d -> Maybe (Ptr ())
toMaybeWindowsHandle
    where

    toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
#if defined(mingw32_HOST_OS)
    toMaybeWindowsHandle dev
        | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
            = Just (toHANDLE nativeHandle)
        | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
            = Just (toHANDLE consoleHandle)
        | otherwise
            = Nothing
    {-
        This is inspired by the implementation of
        'System.Win32.Types.withHandleToHANDLENative'.
    -}
#else
    toMaybeWindowsHandle :: forall d. Typeable d => d -> Maybe (Ptr ())
toMaybeWindowsHandle d
_ = Maybe (Ptr ())
forall a. Maybe a
Nothing
#endif

{-|
    Executes a user-provided action on the POSIX file descriptor that underlies
    a handle or specifically on the POSIX file descriptor for reading if the
    handle uses different file descriptors for reading and writing. The
    Haskell-managed buffers related to the file descriptor are flushed before
    the user-provided action is run. While this action is executed, further
    operations on the handle are blocked to a degree that interference with this
    action is prevented.

    If the handle does not use POSIX file descriptors, an exception is thrown.

    See [below](#with-ref-caveats) for caveats regarding this operation.
-}
withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
withFileDescriptorReadingBiased :: forall r. Handle -> (CInt -> IO r) -> IO r
withFileDescriptorReadingBiased = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO CInt)
-> (Handle__ -> IO ())
-> Handle
-> (CInt -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withFileDescriptorReadingBiased"
                                               Handle -> MVar Handle__
handleStateVarReadingBiased
                                               d -> IO CInt
forall d. Typeable d => d -> IO CInt
getFileDescriptor
                                               Handle__ -> IO ()
flushBuffer

{-|
    Executes a user-provided action on the POSIX file descriptor that underlies
    a handle or specifically on the POSIX file descriptor for writing if the
    handle uses different file descriptors for reading and writing. The
    Haskell-managed buffers related to the file descriptor are flushed before
    the user-provided action is run. While this action is executed, further
    operations on the handle are blocked to a degree that interference with this
    action is prevented.

    If the handle does not use POSIX file descriptors, an exception is thrown.

    See [below](#with-ref-caveats) for caveats regarding this operation.
-}
withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
withFileDescriptorWritingBiased :: forall r. Handle -> (CInt -> IO r) -> IO r
withFileDescriptorWritingBiased = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO CInt)
-> (Handle__ -> IO ())
-> Handle
-> (CInt -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withFileDescriptorWritingBiased"
                                               Handle -> MVar Handle__
handleStateVarWritingBiased
                                               d -> IO CInt
forall d. Typeable d => d -> IO CInt
getFileDescriptor
                                               Handle__ -> IO ()
flushBuffer

{-|
    Executes a user-provided action on the Windows handle that underlies a
    Haskell handle or specifically on the Windows handle for reading if the
    Haskell handle uses different Windows handles for reading and writing. The
    Haskell-managed buffers related to the Windows handle are flushed before the
    user-provided action is run. While this action is executed, further
    operations on the Haskell handle are blocked to a degree that interference
    with this action is prevented.

    If the Haskell handle does not use Windows handles, an exception is thrown.

    See [below](#with-ref-caveats) for caveats regarding this operation.
-}
withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleReadingBiased :: forall r. Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleReadingBiased = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO (Ptr ()))
-> (Handle__ -> IO ())
-> Handle
-> (Ptr () -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withWindowsHandleReadingBiased"
                                              Handle -> MVar Handle__
handleStateVarReadingBiased
                                              d -> IO (Ptr ())
forall d. Typeable d => d -> IO (Ptr ())
getWindowsHandle
                                              Handle__ -> IO ()
flushBuffer

{-|
    Executes a user-provided action on the Windows handle that underlies a
    Haskell handle or specifically on the Windows handle for writing if the
    Haskell handle uses different Windows handles for reading and writing. The
    Haskell-managed buffers related to the Windows handle are flushed before the
    user-provided action is run. While this action is executed, further
    operations on the Haskell handle are blocked to a degree that interference
    with this action is prevented.

    If the Haskell handle does not use Windows handles, an exception is thrown.

    See [below](#with-ref-caveats) for caveats regarding this operation.
-}
withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleWritingBiased :: forall r. Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleWritingBiased = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO (Ptr ()))
-> (Handle__ -> IO ())
-> Handle
-> (Ptr () -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withWindowsHandleWritingBiased"
                                              Handle -> MVar Handle__
handleStateVarWritingBiased
                                              d -> IO (Ptr ())
forall d. Typeable d => d -> IO (Ptr ())
getWindowsHandle
                                              Handle__ -> IO ()
flushBuffer

{-|
    Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
    are not flushed.
-}
withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
withFileDescriptorReadingBiasedRaw :: forall r. Handle -> (CInt -> IO r) -> IO r
withFileDescriptorReadingBiasedRaw
    = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO CInt)
-> (Handle__ -> IO ())
-> Handle
-> (CInt -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withFileDescriptorReadingBiasedRaw"
                   Handle -> MVar Handle__
handleStateVarReadingBiased
                   d -> IO CInt
forall d. Typeable d => d -> IO CInt
getFileDescriptor
                   (IO () -> Handle__ -> IO ()
forall a b. a -> b -> a
const (IO () -> Handle__ -> IO ()) -> IO () -> Handle__ -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

{-|
    Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
    are not flushed.
-}
withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
withFileDescriptorWritingBiasedRaw :: forall r. Handle -> (CInt -> IO r) -> IO r
withFileDescriptorWritingBiasedRaw
    = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO CInt)
-> (Handle__ -> IO ())
-> Handle
-> (CInt -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withFileDescriptorWritingBiasedRaw"
                   Handle -> MVar Handle__
handleStateVarWritingBiased
                   d -> IO CInt
forall d. Typeable d => d -> IO CInt
getFileDescriptor
                   (IO () -> Handle__ -> IO ()
forall a b. a -> b -> a
const (IO () -> Handle__ -> IO ()) -> IO () -> Handle__ -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

{-|
    Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
    are not flushed.
-}
withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleReadingBiasedRaw :: forall r. Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleReadingBiasedRaw
    = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO (Ptr ()))
-> (Handle__ -> IO ())
-> Handle
-> (Ptr () -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withWindowsHandleReadingBiasedRaw"
                   Handle -> MVar Handle__
handleStateVarReadingBiased
                   d -> IO (Ptr ())
forall d. Typeable d => d -> IO (Ptr ())
getWindowsHandle
                   (IO () -> Handle__ -> IO ()
forall a b. a -> b -> a
const (IO () -> Handle__ -> IO ()) -> IO () -> Handle__ -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

{-|
    Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
    are not flushed.
-}
withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleWritingBiasedRaw :: forall r. Handle -> (Ptr () -> IO r) -> IO r
withWindowsHandleWritingBiasedRaw
    = String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO (Ptr ()))
-> (Handle__ -> IO ())
-> Handle
-> (Ptr () -> IO r)
-> IO r
forall a r.
String
-> (Handle -> MVar Handle__)
-> (forall d. Typeable d => d -> IO a)
-> (Handle__ -> IO ())
-> Handle
-> (a -> IO r)
-> IO r
withOSHandle String
"withWindowsHandleWritingBiasedRaw"
                   Handle -> MVar Handle__
handleStateVarWritingBiased
                   d -> IO (Ptr ())
forall d. Typeable d => d -> IO (Ptr ())
getWindowsHandle
                   (IO () -> Handle__ -> IO ()
forall a b. a -> b -> a
const (IO () -> Handle__ -> IO ()) -> IO () -> Handle__ -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- ** Caveats

{-$with-ref-caveats
    #with-ref-caveats#This subsection is just a dummy, whose purpose is to serve
    as the target of the hyperlinks above. The real documentation of the caveats
    is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which
    re-exports the above operations.
-}