{-# LINE 1 "src-unix/Lukko/Internal/FD.hsc" #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE InterruptibleFFI #-}
{-# LANGUAGE Trustworthy #-}
module Lukko.Internal.FD (
    FD (..),
    fdOpen,
    fdClose,
    handleToFd,
    ) where




import Data.Bits          ((.|.))
import Foreign.C.Error    (throwErrnoIfMinus1Retry)
import Foreign.C.Types
import Foreign.C.String   (CString, withCString)
import System.IO          (Handle)
import System.Posix.Types (CMode (..))

import qualified GHC.IO.FD        as GHC (FD (..))

import Lukko.Internal.HandleToFD (ghcHandleToFd)

-- | Opaque /file descriptor/
--
-- This is a wrapper over 'CInt'
newtype FD = FD CInt

foreign import capi interruptible "fcntl.h open"
   c_open :: CString -> CInt -> CMode -> IO CInt

foreign import ccall interruptible "close"
   c_close :: CInt -> IO CInt

-- | Open file to be used for locking.
--
-- @
-- open(path, O_RDWR | O_CREAT);
-- @
fdOpen :: FilePath -> IO FD
fdOpen :: FilePath -> IO FD
fdOpen FilePath
fp = FilePath -> (CString -> IO FD) -> IO FD
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
fp ((CString -> IO FD) -> IO FD) -> (CString -> IO FD) -> IO FD
forall a b. (a -> b) -> a -> b
$ \CString
cfp -> do
    CInt
fd <- FilePath -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => FilePath -> IO a -> IO a
throwErrnoIfMinus1Retry FilePath
"open" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ CString -> CInt -> CMode -> IO CInt
c_open CString
cfp CInt
flags CMode
mode
    FD -> IO FD
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> FD
FD CInt
fd)
  where
    flags :: CInt
flags = CInt
2 CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
64
{-# LINE 48 "src-unix/Lukko/Internal/FD.hsc" #-}
    mode  = CMode 0o666

-- | Close lock file.
--
-- @
-- close(fd);
-- @
fdClose :: FD -> IO ()
fdClose :: FD -> IO ()
fdClose (FD CInt
fd) =  do
    CInt
ret <- FilePath -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => FilePath -> IO a -> IO a
throwErrnoIfMinus1Retry FilePath
"close" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ CInt -> IO CInt
c_close CInt
fd
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Convert GHC 'Handle' to lukko 'FD'.
handleToFd :: Handle -> IO FD
handleToFd :: Handle -> IO FD
handleToFd Handle
h = do
    GHC.FD {fdFD :: FD -> CInt
GHC.fdFD = CInt
fd} <- Handle -> IO FD
ghcHandleToFd Handle
h
    FD -> IO FD
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> FD
FD CInt
fd)