{-# LINE 1 "System/FileLock/Internal/Flock.hsc" #-}
{-# LANGUAGE InterruptibleFFI #-}

module System.FileLock.Internal.Flock

{-# LINE 7 "System/FileLock/Internal/Flock.hsc" #-}
  (Lock, lock, tryLock, unlock) where



import Control.Applicative
import Control.Concurrent (yield)
import qualified Control.Exception as E
import Data.Bits
import Foreign.C.Error
import Foreign.C.Types
import System.Posix.Files
import System.Posix.IO
  ( openFd, closeFd, defaultFileFlags, OpenMode(..)

{-# LINE 21 "System/FileLock/Internal/Flock.hsc" #-}
  , OpenFileFlags(cloexec, creat)

{-# LINE 25 "System/FileLock/Internal/Flock.hsc" #-}
  )
import System.Posix.Types
import Prelude

type Lock = Fd

lock :: FilePath -> Bool -> IO Lock
lock :: FilePath -> Bool -> IO Lock
lock FilePath
path Bool
exclusive = do
  fd <- FilePath -> IO Lock
open FilePath
path
  (`E.onException` closeFd fd) $ do
    True <- flock fd exclusive True
    return fd

tryLock :: FilePath -> Bool -> IO (Maybe Lock)
tryLock :: FilePath -> Bool -> IO (Maybe Lock)
tryLock FilePath
path Bool
exclusive = do
  fd <- FilePath -> IO Lock
open FilePath
path
  (`E.onException` closeFd fd) $ do
    success <- flock fd exclusive False
    if success
      then return $ Just $ fd
      else Nothing <$ closeFd fd

unlock :: Lock -> IO ()
unlock :: Lock -> IO ()
unlock Lock
fd = Lock -> IO ()
closeFd Lock
fd

open :: FilePath -> IO Fd
open :: FilePath -> IO Lock
open FilePath
path = do

{-# LINE 53 "System/FileLock/Internal/Flock.hsc" #-}
  fd <- openFd path WriteOnly defaultFileFlags{ cloexec = True, creat = Just stdFileMode }
    -- Field cloexec only available from unix-2.8

{-# LINE 66 "System/FileLock/Internal/Flock.hsc" #-}
  return fd

flock :: Fd -> Bool -> Bool -> IO Bool
flock :: Lock -> Bool -> Bool -> IO Bool
flock (Fd CInt
fd) Bool
exclusive Bool
block = do
  r <- CInt -> CInt -> IO CInt
c_flock CInt
fd (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ CInt
modeOp CInt -> CInt -> CInt
forall a. Bits a => a -> a -> a
.|. CInt
blockOp
  if r == 0
    then return True -- success
    else do
      errno <- getErrno
      case () of
        ()
_ | Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eWOULDBLOCK
            -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- already taken
          | Errno
errno Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
eINTR -> do
              -- If InterruptibleFFI interrupted the syscall with EINTR,
              -- we need to give the accompanying Haskell exception a chance to bubble.
              -- See also https://gitlab.haskell.org/ghc/ghc/issues/8684#note_142404.
              IO () -> IO ()
forall a. IO a -> IO a
E.interruptible IO ()
yield
              Lock -> Bool -> Bool -> IO Bool
flock (CInt -> Lock
Fd CInt
fd) Bool
exclusive Bool
block
          | Bool
otherwise -> FilePath -> IO Bool
forall a. FilePath -> IO a
throwErrno FilePath
"flock"
  where
    modeOp :: CInt
modeOp = case Bool
exclusive of
      Bool
False -> CInt
1
{-# LINE 88 "System/FileLock/Internal/Flock.hsc" #-}
      True -> 2
{-# LINE 89 "System/FileLock/Internal/Flock.hsc" #-}
    blockOp = case block of
      True -> 0
      False -> 4
{-# LINE 92 "System/FileLock/Internal/Flock.hsc" #-}

-- `interruptible` so that async exceptions like `timeout` can stop it
-- when used in blocking mode (without `LOCK_NB`).
foreign import ccall interruptible "flock"
  c_flock :: CInt -> CInt -> IO CInt


{-# LINE 99 "System/FileLock/Internal/Flock.hsc" #-}