{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnliftedFFITypes #-}

module Posix.File
  ( -- * Functions
    uninterruptibleGetDescriptorFlags
  , uninterruptibleGetStatusFlags
  , uninterruptibleWriteByteArray
  , uninterruptibleWriteBytes
  , uninterruptibleWriteBytesCompletely
  , uninterruptibleWriteBytesCompletelyErrno
  , uninterruptibleReadMutableByteArray
  , writeBytesCompletelyErrno
  , uninterruptibleOpen
  , uninterruptibleOpenMode
  , uninterruptibleOpenUntypedFlags
  , uninterruptibleOpenModeUntypedFlags
  , writeByteArray
  , writeMutableByteArray
  , close
  , uninterruptibleClose
  , uninterruptibleErrorlessClose
  , uninterruptibleUnlink
  , uninterruptibleLink

    -- * Types
  , AccessMode (..)
  , CreationFlags (..)
  , DescriptorFlags (..)
  , StatusFlags (..)

    -- * File Descriptor Flags
  , Types.nonblocking
  , Types.append
  , isReadOnly
  , isWriteOnly
  , isReadWrite

    -- * Open Access Mode
  , Types.readOnly
  , Types.writeOnly
  , Types.readWrite

    -- * File Creation Flags
  , Types.create
  , Types.truncate
  , Types.exclusive
  ) where

import Assertion (assertByteArrayPinned, assertMutableByteArrayPinned)
import Data.Bits ((.&.), (.|.))
import Data.Bytes.Types (Bytes (Bytes))
import Data.Primitive (ByteArray (..), MutableByteArray (MutableByteArray))
import Foreign.C.Error (Errno (Errno), eOK, getErrno)
import Foreign.C.String.Managed (ManagedCString (..))
import Foreign.C.Types (CInt (..), CSize (..))
import GHC.Exts (ByteArray#, MutableByteArray#, RealWorld)
import Posix.File.Types (AccessMode (..), CreationFlags (..), DescriptorFlags (..), StatusFlags (..))
import System.Posix.Types (CMode (..), CSsize (..), Fd (..))

import qualified Posix.File.Types as Types

{- | Get file descriptor flags. This uses the unsafe FFI to
perform @fcntl(fd,F_GETFD)@.
-}
uninterruptibleGetDescriptorFlags :: Fd -> IO (Either Errno DescriptorFlags)
uninterruptibleGetDescriptorFlags :: Fd -> IO (Either Errno DescriptorFlags)
uninterruptibleGetDescriptorFlags !Fd
fd = Fd -> IO DescriptorFlags
c_getFdFlags Fd
fd IO DescriptorFlags
-> (DescriptorFlags -> IO (Either Errno DescriptorFlags))
-> IO (Either Errno DescriptorFlags)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DescriptorFlags -> IO (Either Errno DescriptorFlags)
errorsFromDescriptorFlags

{- | Get file status flags. This uses the unsafe FFI to
perform @fcntl(fd,F_GETFL)@.
-}
uninterruptibleGetStatusFlags :: Fd -> IO (Either Errno StatusFlags)
uninterruptibleGetStatusFlags :: Fd -> IO (Either Errno StatusFlags)
uninterruptibleGetStatusFlags !Fd
fd = Fd -> IO StatusFlags
c_getFlFlags Fd
fd IO StatusFlags
-> (StatusFlags -> IO (Either Errno StatusFlags))
-> IO (Either Errno StatusFlags)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StatusFlags -> IO (Either Errno StatusFlags)
errorsFromStatusFlags

foreign import ccall unsafe "HaskellPosix.h hs_get_fd_flags"
  c_getFdFlags :: Fd -> IO DescriptorFlags

foreign import ccall unsafe "HaskellPosix.h hs_get_fl_flags"
  c_getFlFlags :: Fd -> IO StatusFlags

foreign import ccall unsafe "HaskellPosix.h write_offset"
  c_unsafe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize

foreign import ccall unsafe "HaskellPosix.h write_offset_loop"
  c_unsafe_bytearray_write_loop :: Fd -> ByteArray# -> Int -> CSize -> IO Errno

foreign import ccall safe "HaskellPosix.h write_offset_loop"
  c_safe_bytearray_write_loop :: Fd -> ByteArray# -> Int -> CSize -> IO Errno

foreign import ccall safe "HaskellPosix.h write_offset"
  c_safe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize

foreign import ccall safe "HaskellPosix.h write_offset"
  c_safe_mutablebytearray_write :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize

foreign import ccall unsafe "HaskellPosix.h open"
  c_unsafe_open :: ByteArray# -> CInt -> IO Fd

foreign import ccall unsafe "HaskellPosix.h open"
  c_unsafe_open_mode :: ByteArray# -> CInt -> CMode -> IO Fd

foreign import ccall unsafe "HaskellPosix.h unlink"
  c_unsafe_unlink :: ByteArray# -> IO CInt

foreign import ccall unsafe "HaskellPosix.h link"
  c_unsafe_link :: ByteArray# -> ByteArray# -> IO CInt

foreign import ccall safe "unistd.h close"
  c_safe_close :: Fd -> IO CInt

foreign import ccall unsafe "unistd.h close"
  c_unsafe_close :: Fd -> IO CInt

uninterruptibleOpen ::
  -- | NULL-terminated file name
  ManagedCString ->
  -- | Access mode
  AccessMode ->
  -- | Creation flags
  CreationFlags ->
  -- | Status flags
  StatusFlags ->
  IO (Either Errno Fd)
uninterruptibleOpen :: ManagedCString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> IO (Either Errno Fd)
uninterruptibleOpen (ManagedCString (ByteArray ByteArray#
name)) (AccessMode CInt
x) (CreationFlags CInt
y) (StatusFlags CInt
z) =
  ByteArray# -> CInt -> IO Fd
c_unsafe_open ByteArray#
name (CInt
x CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
y CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
z) IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd

{- | Variant of 'uninterruptibleOpen' that does not help the caller with
the types of the flags.
-}
uninterruptibleOpenUntypedFlags ::
  -- | NULL-terminated file name
  ManagedCString ->
  -- | Flags
  CInt ->
  IO (Either Errno Fd)
uninterruptibleOpenUntypedFlags :: ManagedCString -> CInt -> IO (Either Errno Fd)
uninterruptibleOpenUntypedFlags (ManagedCString (ByteArray ByteArray#
name)) CInt
x =
  ByteArray# -> CInt -> IO Fd
c_unsafe_open ByteArray#
name CInt
x IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd

{- | Variant of 'uninterruptibleOpenMode' that does not help the caller with
the types of the flags.
-}
uninterruptibleOpenModeUntypedFlags ::
  -- | NULL-terminated file name
  ManagedCString ->
  -- | Flags
  CInt ->
  -- | Mode
  CMode ->
  IO (Either Errno Fd)
uninterruptibleOpenModeUntypedFlags :: ManagedCString -> CInt -> CMode -> IO (Either Errno Fd)
uninterruptibleOpenModeUntypedFlags (ManagedCString (ByteArray ByteArray#
name)) !CInt
x !CMode
mode =
  ByteArray# -> CInt -> CMode -> IO Fd
c_unsafe_open_mode ByteArray#
name CInt
x CMode
mode IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd

uninterruptibleOpenMode ::
  -- | NULL-terminated file name
  ManagedCString ->
  -- | Access mode, should include @O_CREAT@
  AccessMode ->
  -- | Creation flags
  CreationFlags ->
  -- | Status flags
  StatusFlags ->
  -- | Permissions assigned to newly created file
  CMode ->
  IO (Either Errno Fd)
uninterruptibleOpenMode :: ManagedCString
-> AccessMode
-> CreationFlags
-> StatusFlags
-> CMode
-> IO (Either Errno Fd)
uninterruptibleOpenMode (ManagedCString (ByteArray ByteArray#
name)) (AccessMode CInt
x) (CreationFlags CInt
y) (StatusFlags CInt
z) !CMode
mode =
  ByteArray# -> CInt -> CMode -> IO Fd
c_unsafe_open_mode ByteArray#
name (CInt
x CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
y CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
z) CMode
mode IO Fd -> (Fd -> IO (Either Errno Fd)) -> IO (Either Errno Fd)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Fd -> IO (Either Errno Fd)
errorsFromFd

errorsFromDescriptorFlags :: DescriptorFlags -> IO (Either Errno DescriptorFlags)
errorsFromDescriptorFlags :: DescriptorFlags -> IO (Either Errno DescriptorFlags)
errorsFromDescriptorFlags r :: DescriptorFlags
r@(DescriptorFlags CInt
x) =
  if CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> (-CInt
1)
    then Either Errno DescriptorFlags -> IO (Either Errno DescriptorFlags)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DescriptorFlags -> Either Errno DescriptorFlags
forall a b. b -> Either a b
Right DescriptorFlags
r)
    else (Errno -> Either Errno DescriptorFlags)
-> IO Errno -> IO (Either Errno DescriptorFlags)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno DescriptorFlags
forall a b. a -> Either a b
Left IO Errno
getErrno

errorsFromStatusFlags :: StatusFlags -> IO (Either Errno StatusFlags)
errorsFromStatusFlags :: StatusFlags -> IO (Either Errno StatusFlags)
errorsFromStatusFlags r :: StatusFlags
r@(StatusFlags CInt
x) =
  if CInt
x CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> (-CInt
1)
    then Either Errno StatusFlags -> IO (Either Errno StatusFlags)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StatusFlags -> Either Errno StatusFlags
forall a b. b -> Either a b
Right StatusFlags
r)
    else (Errno -> Either Errno StatusFlags)
-> IO Errno -> IO (Either Errno StatusFlags)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno StatusFlags
forall a b. a -> Either a b
Left IO Errno
getErrno

{- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.
The byte array backing the slice does not need to be pinned.
-}
uninterruptibleWriteBytesCompletely ::
  -- | File descriptor
  Fd ->
  -- | Source bytes
  Bytes ->
  IO (Either Errno ())
uninterruptibleWriteBytesCompletely :: Fd -> Bytes -> IO (Either Errno ())
uninterruptibleWriteBytesCompletely !Fd
fd !Bytes
b = do
  Errno
e <- Fd -> Bytes -> IO Errno
uninterruptibleWriteBytesCompletelyErrno Fd
fd Bytes
b
  if Errno
e Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eOK
    then Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Errno ()
forall a b. b -> Either a b
Right ())
    else Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Errno -> Either Errno ()
forall a b. a -> Either a b
Left Errno
e)

{- | Variant of 'uninterruptibleWriteBytesCompletely' that uses errno 0
to communicate success.
-}
uninterruptibleWriteBytesCompletelyErrno ::
  -- | File descriptor
  Fd ->
  -- | Source bytes
  Bytes ->
  IO Errno
uninterruptibleWriteBytesCompletelyErrno :: Fd -> Bytes -> IO Errno
uninterruptibleWriteBytesCompletelyErrno !Fd
fd (Bytes (ByteArray ByteArray#
buf) Int
off Int
len) =
  Fd -> ByteArray# -> Int -> CSize -> IO Errno
c_unsafe_bytearray_write_loop Fd
fd ByteArray#
buf Int
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)

{- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.
The byte array backing the slice must be pinned.
-}
writeBytesCompletelyErrno ::
  -- | File descriptor
  Fd ->
  -- | Source bytes
  Bytes ->
  IO Errno
writeBytesCompletelyErrno :: Fd -> Bytes -> IO Errno
writeBytesCompletelyErrno !Fd
fd (Bytes ByteArray
buf0 Int
off Int
len) =
  let !(ByteArray ByteArray#
buf1) = ByteArray -> ByteArray
assertByteArrayPinned ByteArray
buf0
   in Fd -> ByteArray# -> Int -> CSize -> IO Errno
c_safe_bytearray_write_loop Fd
fd ByteArray#
buf1 Int
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)

{- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.
The byte array backing the slice does not need to be pinned.
-}
uninterruptibleWriteBytes ::
  -- | File descriptor
  Fd ->
  -- | Source bytes
  Bytes ->
  -- | Number of bytes written
  IO (Either Errno CSize)
uninterruptibleWriteBytes :: Fd -> Bytes -> IO (Either Errno CSize)
uninterruptibleWriteBytes !Fd
fd (Bytes (ByteArray ByteArray#
buf) Int
off Int
len) =
  Fd -> ByteArray# -> Int -> CSize -> IO CSsize
c_unsafe_bytearray_write Fd
fd ByteArray#
buf Int
off (forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @CSize Int
len)
    IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize

{- | Wrapper for @write(2)@ that takes a byte array and an offset.
The byte array does not need to be pinned.
-}
uninterruptibleWriteByteArray ::
  -- | Socket
  Fd ->
  -- | Source byte array
  ByteArray ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
uninterruptibleWriteByteArray :: Fd -> ByteArray -> Int -> CSize -> IO (Either Errno CSize)
uninterruptibleWriteByteArray !Fd
fd (ByteArray ByteArray#
buf) !Int
off !CSize
len =
  Fd -> ByteArray# -> Int -> CSize -> IO CSsize
c_unsafe_bytearray_write Fd
fd ByteArray#
buf Int
off CSize
len IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize

{- | Wrapper for @write(2)@ that takes a byte array and an offset.
Uses @safe@ FFI. The byte array must be pinned.
-}
writeByteArray ::
  -- | File descriptor
  Fd ->
  -- | Source byte array
  ByteArray ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
writeByteArray :: Fd -> ByteArray -> Int -> CSize -> IO (Either Errno CSize)
writeByteArray !Fd
fd !ByteArray
buf0 !Int
off !CSize
len =
  let !(ByteArray ByteArray#
buf1) = ByteArray -> ByteArray
assertByteArrayPinned ByteArray
buf0
   in Fd -> ByteArray# -> Int -> CSize -> IO CSsize
c_safe_bytearray_write Fd
fd ByteArray#
buf1 Int
off CSize
len IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize

-- writeByteArrayCompletely ::

{- | Variant of 'writeByteArray' that operates on mutable byte array.
Uses @safe@ FFI. The byte array must be pinned.
-}
writeMutableByteArray ::
  -- | File descriptor
  Fd ->
  -- | Source byte array
  MutableByteArray RealWorld ->
  -- | Offset into source array
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Number of bytes pushed to send buffer
  IO (Either Errno CSize)
writeMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> IO (Either Errno CSize)
writeMutableByteArray !Fd
fd !MutableByteArray RealWorld
buf0 !Int
off !CSize
len =
  let !(MutableByteArray MutableByteArray# RealWorld
buf1) = MutableByteArray RealWorld -> MutableByteArray RealWorld
forall s. MutableByteArray s -> MutableByteArray s
assertMutableByteArrayPinned MutableByteArray RealWorld
buf0
   in Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize
c_safe_mutablebytearray_write Fd
fd MutableByteArray# RealWorld
buf1 Int
off CSize
len IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize

uninterruptibleReadMutableByteArray ::
  -- | File descriptor
  Fd ->
  -- | Destination
  MutableByteArray RealWorld ->
  -- | Destination offset
  Int ->
  -- | Length in bytes
  CSize ->
  -- | Number of bytes received
  IO (Either Errno CSize)
uninterruptibleReadMutableByteArray :: Fd
-> MutableByteArray RealWorld
-> Int
-> CSize
-> IO (Either Errno CSize)
uninterruptibleReadMutableByteArray !Fd
fd !(MutableByteArray !MutableByteArray# RealWorld
b) !Int
doff !CSize
dlen = do
  Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize
c_unsafe_mutable_byte_array_read Fd
fd MutableByteArray# RealWorld
b Int
doff CSize
dlen IO CSsize
-> (CSsize -> IO (Either Errno CSize)) -> IO (Either Errno CSize)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CSsize -> IO (Either Errno CSize)
errorsFromSize

errorsFromSize :: CSsize -> IO (Either Errno CSize)
errorsFromSize :: CSsize -> IO (Either Errno CSize)
errorsFromSize CSsize
r =
  if CSsize
r CSsize -> CSsize -> Bool
forall a. Ord a => a -> a -> Bool
> (-CSsize
1)
    then Either Errno CSize -> IO (Either Errno CSize)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CSize -> Either Errno CSize
forall a b. b -> Either a b
Right (CSsize -> CSize
cssizeToCSize CSsize
r))
    else (Errno -> Either Errno CSize)
-> IO Errno -> IO (Either Errno CSize)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno CSize
forall a b. a -> Either a b
Left IO Errno
getErrno

errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd :: Fd -> IO (Either Errno Fd)
errorsFromFd Fd
r =
  if Fd
r Fd -> Fd -> Bool
forall a. Ord a => a -> a -> Bool
> (-Fd
1)
    then Either Errno Fd -> IO (Either Errno Fd)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fd -> Either Errno Fd
forall a b. b -> Either a b
Right Fd
r)
    else (Errno -> Either Errno Fd) -> IO Errno -> IO (Either Errno Fd)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno Fd
forall a b. a -> Either a b
Left IO Errno
getErrno

uninterruptibleLink ::
  -- | Path to existing file
  ManagedCString ->
  -- | Path to new file
  ManagedCString ->
  IO (Either Errno ())
uninterruptibleLink :: ManagedCString -> ManagedCString -> IO (Either Errno ())
uninterruptibleLink (ManagedCString (ByteArray ByteArray#
x)) (ManagedCString (ByteArray ByteArray#
y)) =
  ByteArray# -> ByteArray# -> IO CInt
c_unsafe_link ByteArray#
x ByteArray#
y IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_

uninterruptibleUnlink ::
  -- | File name
  ManagedCString ->
  IO (Either Errno ())
uninterruptibleUnlink :: ManagedCString -> IO (Either Errno ())
uninterruptibleUnlink (ManagedCString (ByteArray ByteArray#
x)) =
  ByteArray# -> IO CInt
c_unsafe_unlink ByteArray#
x IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_

{- | Close a file descriptor.
  The <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification>
  includes more details. This uses the safe FFI.
-}
close ::
  -- | Socket
  Fd ->
  IO (Either Errno ())
close :: Fd -> IO (Either Errno ())
close Fd
fd = Fd -> IO CInt
c_safe_close Fd
fd IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_

{- | Close a file descriptor. This uses the unsafe FFI. According to the
  <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification>,
  "If @fildes@ refers to a socket, @close()@ shall cause the socket to
  be destroyed. If the socket is in connection-mode, and the @SO_LINGER@
  option is set for the socket with non-zero linger time, and the socket
  has untransmitted data, then @close()@ shall block for up to the current
  linger interval until all data is transmitted."
-}
uninterruptibleClose ::
  -- | Socket
  Fd ->
  IO (Either Errno ())
uninterruptibleClose :: Fd -> IO (Either Errno ())
uninterruptibleClose Fd
fd = Fd -> IO CInt
c_unsafe_close Fd
fd IO CInt -> (CInt -> IO (Either Errno ())) -> IO (Either Errno ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO (Either Errno ())
errorsFromInt_

{- | Close a file descriptor with the unsafe FFI. Do not check for errors.
  It is only appropriate to use this when a file descriptor is being
  closed to handle an exceptional case. Since the user will want to
  propogate the original exception, the exception provided by
  'uninterruptibleClose' would just be discarded. This function allows us
  to potentially avoid an additional FFI call to 'getErrno'.
-}
uninterruptibleErrorlessClose ::
  -- | Socket
  Fd ->
  IO ()
uninterruptibleErrorlessClose :: Fd -> IO ()
uninterruptibleErrorlessClose Fd
fd = do
  CInt
_ <- Fd -> IO CInt
c_unsafe_close Fd
fd
  () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- only call this when it is known that the argument is non-negative
cssizeToCSize :: CSsize -> CSize
cssizeToCSize :: CSsize -> CSize
cssizeToCSize = CSsize -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral

isReadOnly :: StatusFlags -> Bool
isReadOnly :: StatusFlags -> Bool
isReadOnly (StatusFlags CInt
x) = CInt
x CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0b11 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0

isWriteOnly :: StatusFlags -> Bool
isWriteOnly :: StatusFlags -> Bool
isWriteOnly (StatusFlags CInt
x) = CInt
x CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0b11 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1

isReadWrite :: StatusFlags -> Bool
isReadWrite :: StatusFlags -> Bool
isReadWrite (StatusFlags CInt
x) = CInt
x CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.&. CInt
0b11 CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
2

-- Sometimes, functions that return an int use zero to indicate
-- success and negative one to indicate failure without including
-- additional information in the value.
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ :: CInt -> IO (Either Errno ())
errorsFromInt_ CInt
r =
  if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
    then Either Errno () -> IO (Either Errno ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either Errno ()
forall a b. b -> Either a b
Right ())
    else (Errno -> Either Errno ()) -> IO Errno -> IO (Either Errno ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Errno -> Either Errno ()
forall a b. a -> Either a b
Left IO Errno
getErrno

foreign import ccall unsafe "HaskellPosix.h read_offset"
  c_unsafe_mutable_byte_array_read :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize