{-# LINE 1 "NgxExport/Internal/SafeFileLock.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, InterruptibleFFI #-}

module NgxExport.Internal.SafeFileLock (safeWaitToSetLock
                                       ,getBestLockImpl
                                       ) where

import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Alloc
import System.Posix.IO
import System.Posix.Types
import System.Posix.Internals
import GHC.IO.Device




{-# LINE 21 "NgxExport/Internal/SafeFileLock.hsc" #-}



fcntlOfdSetlkw :: CInt

{-# LINE 26 "NgxExport/Internal/SafeFileLock.hsc" #-}
fcntlOfdSetlkw = (38)
{-# LINE 27 "NgxExport/Internal/SafeFileLock.hsc" #-}

{-# LINE 30 "NgxExport/Internal/SafeFileLock.hsc" #-}

fcntlOfdGetlk :: CInt

{-# LINE 33 "NgxExport/Internal/SafeFileLock.hsc" #-}
fcntlOfdGetlk = (36)
{-# LINE 34 "NgxExport/Internal/SafeFileLock.hsc" #-}

{-# LINE 37 "NgxExport/Internal/SafeFileLock.hsc" #-}

fcntlSetlkw :: CInt
fcntlSetlkw = (7)
{-# LINE 40 "NgxExport/Internal/SafeFileLock.hsc" #-}

-- functions below were mostly adopted from System.Posix.IO.Common

mode2Int :: SeekMode -> CInt
mode2Int AbsoluteSeek = (0)
{-# LINE 45 "NgxExport/Internal/SafeFileLock.hsc" #-}
mode2Int RelativeSeek = (1)
{-# LINE 46 "NgxExport/Internal/SafeFileLock.hsc" #-}
mode2Int SeekFromEnd  = (2)
{-# LINE 47 "NgxExport/Internal/SafeFileLock.hsc" #-}

lockReq2Int :: LockRequest -> CShort
lockReq2Int ReadLock  = (0)
{-# LINE 50 "NgxExport/Internal/SafeFileLock.hsc" #-}
lockReq2Int WriteLock = (1)
{-# LINE 51 "NgxExport/Internal/SafeFileLock.hsc" #-}
lockReq2Int Unlock    = (2)
{-# LINE 52 "NgxExport/Internal/SafeFileLock.hsc" #-}

allocaLock :: FileLock -> (Ptr CFLock -> IO a) -> IO a
allocaLock (lockreq, mode, start, len) io =
  allocaBytes (32) $ \p -> do
{-# LINE 56 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   p (lockReq2Int lockreq :: CShort)
{-# LINE 57 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 2)) p (fromIntegral (mode2Int mode) :: CShort)
{-# LINE 58 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8))  p start
{-# LINE 59 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16))    p len
{-# LINE 60 "NgxExport/Internal/SafeFileLock.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24))    p (0 :: CPid)
{-# LINE 61 "NgxExport/Internal/SafeFileLock.hsc" #-}
    io p

writeLock :: FileLock
writeLock = (WriteLock, AbsoluteSeek, 0, 0)

foreign import ccall interruptible "HsBase.h fcntl"
    safe_c_fcntl_lock :: CInt -> CInt -> Ptr CFLock -> IO CInt

-- interruptible version of waitToSetLock as defined in System.Posix.IO
safeWaitToSetLock :: Fd -> CInt -> IO ()
safeWaitToSetLock (Fd fd) cmd = allocaLock writeLock $ \p_flock ->
    throwErrnoIfMinus1_ "safeWaitToSetLock" $ safe_c_fcntl_lock fd cmd p_flock

-- returns fcntlOfdSetlkw if OFD locks are available, or fcntlSetlkw otherwise
getBestLockImpl :: Fd -> IO CInt
getBestLockImpl (Fd fd) = allocaLock writeLock $ \p_flock -> do
    res <- c_fcntl_lock fd fcntlOfdGetlk p_flock
    if res == -1
        then do
            errno <- getErrno
            return $ if errno == eINVAL
                         then fcntlSetlkw
                         else fcntlOfdSetlkw
        else return fcntlOfdSetlkw