{-# LINE 1 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
module Streamly.Internal.FileSystem.Posix.File
    (

{-# LINE 4 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}

    -- * File open flags
      OpenFlags (..)
    , defaultOpenFlags

    -- * File status flags
    , setAppend
    , setNonBlock
    , setSync

    -- * File creation flags
    , setCloExec
    , setDirectory
    , setExcl
    , setNoCtty
    , setNoFollow
    -- setTmpFile
    , setTrunc

    -- * File create mode
    , defaultCreateMode

    -- ** User Permissions
    , setUr
    , setUw
    , setUx

    , clrUr
    , clrUw
    , clrUx

    -- ** Group Permissions
    , setGr
    , setGw
    , setGx

    , clrGr
    , clrGw
    , clrGx

    -- ** Other Permissions
    , setOr
    , setOw
    , setOx

    , clrOr
    , clrOw
    , clrOx

    -- ** Status bits
    , setSuid
    , setSgid
    , setSticky

    , clrSuid
    , clrSgid
    , clrSticky

    -- * Fd based Low Level
    , openAt
    , close

    -- * Handle based
    , openFile
    , withFile
    , openBinaryFile
    , withBinaryFile

    -- Re-exported
    , Fd

{-# LINE 75 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
    ) where


{-# LINE 78 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}

-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

import Data.Bits ((.|.), (.&.), complement)
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.C.String (CString)
import Foreign.C.Types (CInt(..))
import GHC.IO.Handle.FD (fdToHandle)
import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfMinus1Retry)
import Streamly.Internal.FileSystem.PosixPath (PosixPath)
import System.IO (IOMode(..), Handle)
import System.Posix.Types (Fd(..), CMode(..))

import qualified Streamly.Internal.FileSystem.File.Common as File
import qualified Streamly.Internal.FileSystem.PosixPath as Path

-- We want to remain close to the Posix C API. A function based API to set and
-- clear the modes is simple, type safe and directly mirrors the C API. It does
-- not require explicit mapping from Haskell ADT to C types, we can dirctly
-- manipulate the C type.



-------------------------------------------------------------------------------
-- Create mode
-------------------------------------------------------------------------------

-- | Open flags, see posix open system call man page.
newtype FileMode = FileMode CMode

#define MK_MODE_API(name1,name2,x) \
{-# INLINE name1 #-}; \
name1 :: FileMode -> FileMode; \
name1 (FileMode mode) = FileMode (x .|. mode); \
{-# INLINE name2 #-}; \
name2 :: FileMode -> FileMode; \
name2 (FileMode mode) = FileMode (x .&. complement mode)

{-
#define S_ISUID  0004000
#define S_ISGID  0002000
#define S_ISVTX  0001000

#define S_IRWXU 00700
#define S_IRUSR 00400
#define S_IWUSR 00200
#define S_IXUSR 00100

#define S_IRWXG 00070
#define S_IRGRP 00040
#define S_IWGRP 00020
#define S_IXGRP 00010

#define S_IRWXO 00007
#define S_IROTH 00004
#define S_IWOTH 00002
#define S_IXOTH 00001

#define AT_FDCWD (-100)
-}

MK_MODE_API(setSuid,clrSuid,S_ISUID)
MK_MODE_API(setSgid,clrSgid,S_ISGID)
MK_MODE_API(setSticky,clrSticky,S_ISVTX)

-- MK_MODE_API(setUrwx,clrUrwx,S_IRWXU)
MK_MODE_API(setUr,clrUr,S_IRUSR)
MK_MODE_API(setUw,clrUw,S_IWUSR)
MK_MODE_API(setUx,clrUx,S_IXUSR)

-- MK_MODE_API(setGrwx,clrGrwx,S_IRWXU)
MK_MODE_API(setGr,clrGr,S_IRUSR)
MK_MODE_API(setGw,clrGw,S_IWUSR)
MK_MODE_API(setGx,clrGx,S_IXUSR)

-- MK_MODE_API(setOrwx,clrOrwx,S_IRWXU)
MK_MODE_API(setOr,clrOr,S_IRUSR)
MK_MODE_API(setOw,clrOw,S_IWUSR)
MK_MODE_API(setOx,clrOx,S_IXUSR)

-- Uses the same default mode as openFileWith in base
defaultCreateMode :: FileMode
defaultCreateMode :: FileMode
defaultCreateMode = CMode -> FileMode
FileMode CMode
0o666

-------------------------------------------------------------------------------
-- Open Flags
-------------------------------------------------------------------------------

-- | Open flags, see posix open system call man page.
newtype OpenFlags = OpenFlags CInt

#define MK_FLAG_API(name,x) \
{-# INLINE name #-}; \
name :: OpenFlags -> OpenFlags; \
name (OpenFlags flags) = OpenFlags (flags .|. x)

-- foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt
-- These affect the first two bits in flags.
MK_FLAG_API(setReadOnly,0)
{-# LINE 179 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_FLAG_API(setWriteOnly,1)
{-# LINE 180 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_FLAG_API(setReadWrite,2)
{-# LINE 181 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}

#define MK_BOOL_FLAG_API(name,x) \
{-# INLINE name #-}; \
name :: Bool -> OpenFlags -> OpenFlags; \
name True (OpenFlags flags) = OpenFlags (flags .|. x); \
name False (OpenFlags flags) = OpenFlags (flags .&. complement x)

-- setCreat is internal only, do not export this. This is automatically set
-- when create mode is passed, otherwise cleared.
MK_BOOL_FLAG_API(setCreat,64)
{-# LINE 191 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}

MK_BOOL_FLAG_API(setExcl,128)
{-# LINE 193 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setNoCtty,256)
{-# LINE 194 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setTrunc,512)
{-# LINE 195 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setAppend,1024)
{-# LINE 196 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setNonBlock,2048)
{-# LINE 197 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setDirectory,65536)
{-# LINE 198 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setNoFollow,131072)
{-# LINE 199 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setCloExec,524288)
{-# LINE 200 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
MK_BOOL_FLAG_API(setSync,1052672)
{-# LINE 201 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}

-- | Default values for the 'OpenFlags'.
--
-- By default a 0 value is used, no flag is set. See the open system call man
-- page.
defaultOpenFlags :: OpenFlags
defaultOpenFlags :: OpenFlags
defaultOpenFlags = CInt -> OpenFlags
OpenFlags CInt
0

-------------------------------------------------------------------------------
-- Low level (fd returning) file opening APIs
-------------------------------------------------------------------------------

-- XXX Should we use interruptible open as in base openFile?
foreign import capi unsafe "fcntl.h openat"
   c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt

-- | Open and optionally create (when create mode is specified) a file relative
-- to an optional directory file descriptor. If directory fd is not specified
-- then opens relative to the current directory.
-- {-# INLINE openAtCString #-}
openAtCString ::
       Maybe Fd -- ^ Optional directory file descriptor
    -> CString -- ^ Pathname to open
    -> OpenFlags -- ^ Append, exclusive, etc.
    -> Maybe FileMode -- ^ Create mode
    -> IO Fd
openAtCString :: Maybe Fd -> CString -> OpenFlags -> Maybe FileMode -> IO Fd
openAtCString Maybe Fd
fdMay CString
path OpenFlags
flags Maybe FileMode
cmode =
    CInt -> Fd
Fd (CInt -> Fd) -> IO CInt -> IO Fd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> CString -> CInt -> CMode -> IO CInt
c_openat CInt
c_fd CString
path CInt
flags1 CMode
mode

    where

    c_fd :: CInt
c_fd = CInt -> (Fd -> CInt) -> Maybe Fd -> CInt
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (-CInt
100) (\ (Fd CInt
fd) -> CInt
fd) Maybe Fd
fdMay
{-# LINE 233 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}
    FileMode mode = maybe defaultCreateMode id cmode
    OpenFlags CInt
flags1 = OpenFlags -> (FileMode -> OpenFlags) -> Maybe FileMode -> OpenFlags
forall b a. b -> (a -> b) -> Maybe a -> b
maybe OpenFlags
flags (\FileMode
_ -> Bool -> OpenFlags -> OpenFlags
setCreat Bool
True OpenFlags
flags) Maybe FileMode
cmode

-- | Open a file relative to an optional directory file descriptor.
--
-- Note: In Haskell, using an fd directly for IO may be problematic as blocking
-- file system operations on the file might block the capability and GC for
-- "unsafe" calls. "safe" calls may be more expensive. Also, you may have to
-- synchronize concurrent access via multiple threads.
--
{-# INLINE openAt #-}
openAt ::
       Maybe Fd -- ^ Optional directory file descriptor
    -> PosixPath -- ^ Pathname to open
    -> OpenFlags -- ^ Append, exclusive, truncate, etc.
    -> Maybe FileMode -- ^ Create mode
    -> IO Fd
openAt :: Maybe Fd -> PosixPath -> OpenFlags -> Maybe FileMode -> IO Fd
openAt Maybe Fd
fdMay PosixPath
path OpenFlags
flags Maybe FileMode
cmode =
   PosixPath -> (CString -> IO Fd) -> IO Fd
forall a. PosixPath -> (CString -> IO a) -> IO a
Path.asCString PosixPath
path ((CString -> IO Fd) -> IO Fd) -> (CString -> IO Fd) -> IO Fd
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> do
     String -> PosixPath -> IO Fd -> IO Fd
forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO a
throwErrnoPathIfMinus1Retry String
"openAt" PosixPath
path
        (IO Fd -> IO Fd) -> IO Fd -> IO Fd
forall a b. (a -> b) -> a -> b
$ Maybe Fd -> CString -> OpenFlags -> Maybe FileMode -> IO Fd
openAtCString Maybe Fd
fdMay CString
cstr OpenFlags
flags Maybe FileMode
cmode


-- | Open a regular file, return an Fd.
--
-- Sets O_NOCTTY, O_NONBLOCK flags to be compatible with the base openFile
-- behavior. O_NOCTTY affects opening of terminal special files and O_NONBLOCK
-- affects fifo special files, and mandatory locking.
--
openFileFdWith :: OpenFlags -> PosixPath -> IOMode -> IO Fd
openFileFdWith :: OpenFlags -> PosixPath -> IOMode -> IO Fd
openFileFdWith OpenFlags
oflags PosixPath
path IOMode
iomode = do
    case IOMode
iomode of
        IOMode
ReadMode -> OpenFlags -> Maybe FileMode -> IO Fd
open1 (OpenFlags -> OpenFlags
setReadOnly OpenFlags
oflags1) Maybe FileMode
forall a. Maybe a
Nothing
        IOMode
WriteMode ->
            OpenFlags -> Maybe FileMode -> IO Fd
open1 (OpenFlags -> OpenFlags
setWriteOnly OpenFlags
oflags1) (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
defaultCreateMode)
        IOMode
AppendMode ->
            OpenFlags -> Maybe FileMode -> IO Fd
open1
                ((Bool -> OpenFlags -> OpenFlags
setAppend Bool
True (OpenFlags -> OpenFlags)
-> (OpenFlags -> OpenFlags) -> OpenFlags -> OpenFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OpenFlags -> OpenFlags
setWriteOnly) OpenFlags
oflags1)
                (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
defaultCreateMode)
        IOMode
ReadWriteMode ->
            OpenFlags -> Maybe FileMode -> IO Fd
open1 (OpenFlags -> OpenFlags
setReadWrite OpenFlags
oflags) (FileMode -> Maybe FileMode
forall a. a -> Maybe a
Just FileMode
defaultCreateMode)

    where

    oflags1 :: OpenFlags
oflags1 = Bool -> OpenFlags -> OpenFlags
setNoCtty Bool
True (OpenFlags -> OpenFlags) -> OpenFlags -> OpenFlags
forall a b. (a -> b) -> a -> b
$ Bool -> OpenFlags -> OpenFlags
setNonBlock Bool
True OpenFlags
oflags
    open1 :: OpenFlags -> Maybe FileMode -> IO Fd
open1 = Maybe Fd -> PosixPath -> OpenFlags -> Maybe FileMode -> IO Fd
openAt Maybe Fd
forall a. Maybe a
Nothing PosixPath
path

openFileFd :: PosixPath -> IOMode -> IO Fd
openFileFd :: PosixPath -> IOMode -> IO Fd
openFileFd = OpenFlags -> PosixPath -> IOMode -> IO Fd
openFileFdWith OpenFlags
defaultOpenFlags

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

close :: Fd -> IO ()
close :: Fd -> IO ()
close (Fd CInt
fd) = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ (String
"close " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
fd) (CInt -> IO CInt
c_close CInt
fd)

-------------------------------------------------------------------------------
-- base openFile compatible, Handle returning, APIs
-------------------------------------------------------------------------------

-- | Open a regular file, return a Handle. The file is locked, the Handle is
-- NOT set up to close the file on garbage collection.
{-# INLINE openFileHandle #-}
openFileHandle :: PosixPath -> IOMode -> IO Handle
openFileHandle :: PosixPath -> IOMode -> IO Handle
openFileHandle PosixPath
p IOMode
x = PosixPath -> IOMode -> IO Fd
openFileFd PosixPath
p IOMode
x IO Fd -> (Fd -> IO Handle) -> IO Handle
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 Handle
fdToHandle (CInt -> IO Handle) -> (Fd -> CInt) -> Fd -> IO Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fd -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Like openFile in base package but using Path instead of FilePath.
-- Use hSetBinaryMode on the handle if you want to use binary mode.
openFile :: PosixPath -> IOMode -> IO Handle
openFile :: PosixPath -> IOMode -> IO Handle
openFile = Bool
-> (PosixPath -> IOMode -> IO Handle)
-> PosixPath
-> IOMode
-> IO Handle
File.openFile Bool
False PosixPath -> IOMode -> IO Handle
openFileHandle

-- | Like withFile in base package but using Path instead of FilePath.
-- Use hSetBinaryMode on the handle if you want to use binary mode.
withFile :: PosixPath -> IOMode -> (Handle -> IO r) -> IO r
withFile :: forall r. PosixPath -> IOMode -> (Handle -> IO r) -> IO r
withFile = Bool
-> (PosixPath -> IOMode -> IO Handle)
-> PosixPath
-> IOMode
-> (Handle -> IO r)
-> IO r
forall r.
Bool
-> (PosixPath -> IOMode -> IO Handle)
-> PosixPath
-> IOMode
-> (Handle -> IO r)
-> IO r
File.withFile Bool
False PosixPath -> IOMode -> IO Handle
openFileHandle

-- | Like openBinaryFile in base package but using Path instead of FilePath.
openBinaryFile :: PosixPath -> IOMode -> IO Handle
openBinaryFile :: PosixPath -> IOMode -> IO Handle
openBinaryFile = Bool
-> (PosixPath -> IOMode -> IO Handle)
-> PosixPath
-> IOMode
-> IO Handle
File.openFile Bool
True PosixPath -> IOMode -> IO Handle
openFileHandle

-- | Like withBinaryFile in base package but using Path instead of FilePath.
withBinaryFile :: PosixPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile :: forall r. PosixPath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile = Bool
-> (PosixPath -> IOMode -> IO Handle)
-> PosixPath
-> IOMode
-> (Handle -> IO r)
-> IO r
forall r.
Bool
-> (PosixPath -> IOMode -> IO Handle)
-> PosixPath
-> IOMode
-> (Handle -> IO r)
-> IO r
File.withFile Bool
True PosixPath -> IOMode -> IO Handle
openFileHandle

{-# LINE 317 "src/Streamly/Internal/FileSystem/Posix/File.hsc" #-}