    {-# OPTIONS_GHC -optc-D_GNU_SOURCE #-}
    {-# LINE 1 "src-ofd/Lukko/OFD.hsc" #-}
    {-# LANGUAGE CApiFFI #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE InterruptibleFFI #-}
    {-# LANGUAGE Trustworthy #-}
    -- | Linux open file descriptor locking.
    --
    -- <https://www.gnu.org/software/libc/manual/html_node/Open-File-Description-Locks.html>
    --
    -- We prefer this over BSD locking (e.g. flock) since the latter appears to
    -- break in some NFS configurations. Note that we intentionally do not try to
    -- use ordinary POSIX file locking due to its peculiar semantics under
    -- multi-threaded environments.
    --
    module Lukko.OFD (
        -- * Types
        FileLockingNotSupported(..),
        fileLockingSupported,
        FileLockingSupported,
        FileLockingMethod (..),
        fileLockingMethod,
        LockMode(..),
        -- * File descriptors
        FD,
        fdOpen,
        fdClose,
        fdLock,
        fdTryLock,
        fdUnlock,
        -- * Handles
        hLock,
        hTryLock,
        hUnlock,
        ) where

    -- Support for file description locks (F_OFD_SETLKW and F_OFD_SETLK) was added
    -- to glibc in version 2.20. If we have an older version then we must get the
    -- functionality directly from the linux headers.
    --
    -- See glibc 2.20 release notes: <https://sourceware.org/legacy-ml/libc-alpha/2014-09/msg00088.html>

    {-# LINE 45 "src-ofd/Lukko/OFD.hsc" #-}

    {-# LINE 46 "src-ofd/Lukko/OFD.hsc" #-}

    {-# LINE 50 "src-ofd/Lukko/OFD.hsc" #-}

    {-# LINE 53 "src-ofd/Lukko/OFD.hsc" #-}

    import Control.Monad (void)
    import System.IO (Handle)

    import Data.Function
    import Foreign.C.Error
    import Foreign.C.Types
    import Foreign.Marshal.Utils
    import Foreign.Storable
    import GHC.IO.Exception
    import GHC.Ptr
    import System.Posix.Types (COff, CPid)

    import Lukko.Internal.FD
    import Lukko.Internal.FillBytes
    import Lukko.Internal.Types

    -------------------------------------------------------------------------------
    -- Support constants
    -------------------------------------------------------------------------------

    -- | A constants specifying whether file locking is supported.
    fileLockingSupported :: Bool
    fileLockingSupported :: Bool
    fileLockingSupported = Bool
    True

    -- | A type level 'fileLockingSupported'.
    type FileLockingSupported = True

    -- | A constant specifying this method
    fileLockingMethod :: FileLockingMethod
    fileLockingMethod :: FileLockingMethod
    fileLockingMethod = FileLockingMethod
    MethodOFD

    -------------------------------------------------------------------------------
    -- FD
    -------------------------------------------------------------------------------

    -- | Lock using OFD locks.
    fdLock :: FD -> LockMode -> IO ()
    fdLock :: FD -> LockMode -> IO ()
    fdLock FD
    fd LockMode
    mode = IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl Maybe Handle
    forall a. Maybe a
    Nothing FD
    fd String
    "fdLock" LockMode
    mode Bool
    True)

    -- | Try to lock using OFD locks.
    fdTryLock :: FD -> LockMode -> IO Bool
    fdTryLock :: FD -> LockMode -> IO Bool
    fdTryLock FD
    fd LockMode
    mode = Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl Maybe Handle
    forall a. Maybe a
    Nothing FD
    fd String
    "fdTryLock" LockMode
    mode Bool
    False

    -- | Unlock using OFD locks.
    fdUnlock :: FD -> IO ()
    fdUnlock :: FD -> IO ()
    fdUnlock = FD -> IO ()
    unlockImpl

    -------------------------------------------------------------------------------
    -- Handle
    -------------------------------------------------------------------------------

    -- | Lock using OFD locks.
    hLock :: Handle -> LockMode -> IO ()
    hLock :: Handle -> LockMode -> IO ()
    hLock Handle
    h LockMode
    mode = do
        fd <- Handle -> IO FD
    handleToFd Handle
    h
        void (lockImpl (Just h) fd "hLock" mode True)

    -- | Try to lock using OFD locks.
    hTryLock :: Handle -> LockMode -> IO Bool
    hTryLock :: Handle -> LockMode -> IO Bool
    hTryLock Handle
    h LockMode
    mode = do
        fd <- Handle -> IO FD
    handleToFd Handle
    h
        lockImpl (Just h) fd "hTryLock" mode False

    -- | Unlock using OFD locks.
    hUnlock :: Handle -> IO ()
    hUnlock :: Handle -> IO ()
    hUnlock Handle
    h = do
        fd <- Handle -> IO FD
    handleToFd Handle
    h
        unlockImpl fd

    -------------------------------------------------------------------------------
    -- Compat
    -------------------------------------------------------------------------------

    -- there is no alignment in old hsc2hs

    {-# LINE 129 "src-ofd/Lukko/OFD.hsc" #-}

    {-# LINE 132 "src-ofd/Lukko/OFD.hsc" #-}

    {-# LINE 137 "src-ofd/Lukko/OFD.hsc" #-}

    {-# LINE 141 "src-ofd/Lukko/OFD.hsc" #-}

    -------------------------------------------------------------------------------
    -- implementation
    -------------------------------------------------------------------------------

    foreign import capi interruptible "fcntl.h fcntl"
      c_fcntl :: CInt -> CInt -> Ptr FLock -> IO CInt

    data FLock  = FLock { FLock -> CShort
    l_type   :: CShort
                        , FLock -> CShort
    l_whence :: CShort
                        , FLock -> COff
    l_start  :: COff
                        , FLock -> COff
    l_len    :: COff
                        , FLock -> CPid
    l_pid    :: CPid
                        }

    instance Storable FLock where
        sizeOf :: FLock -> Int
    sizeOf FLock
    _ = (Int
    32)
    {-# LINE 158 "src-ofd/Lukko/OFD.hsc" #-}
        alignment _ = 8
    {-# LINE 159 "src-ofd/Lukko/OFD.hsc" #-}
        poke ptr x = do
            fillBytes ptr 0 (sizeOf x)
            (\hsc_ptr -> pokeByteOff hsc_ptr 0)   ptr (l_type x)
    {-# LINE 162 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (l_whence x)
    {-# LINE 163 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (l_start x)
    {-# LINE 164 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 16)    ptr (l_len x)
    {-# LINE 165 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 24)    ptr (l_pid x)
    {-# LINE 166 "src-ofd/Lukko/OFD.hsc" #-}
        peek ptr = do
            x1 <- (\hsc_ptr -> peekByteOff hsc_ptr 0)   ptr
    {-# LINE 168 "src-ofd/Lukko/OFD.hsc" #-}
            x2 <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
    {-# LINE 169 "src-ofd/Lukko/OFD.hsc" #-}
            x3 <- (\hsc_ptr -> peekByteOff hsc_ptr 8)  ptr
    {-# LINE 170 "src-ofd/Lukko/OFD.hsc" #-}
            x4 <- (\hsc_ptr -> peekByteOff hsc_ptr 16)    ptr
    {-# LINE 171 "src-ofd/Lukko/OFD.hsc" #-}
            x5 <- (\hsc_ptr -> peekByteOff hsc_ptr 24)    ptr
    {-# LINE 172 "src-ofd/Lukko/OFD.hsc" #-}
            return (FLock x1 x2 x3 x4 x5)

    lockImpl :: Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl :: Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl Maybe Handle
    mh (FD CInt
    fd) String
    ctx LockMode
    mode Bool
    block = do
      FLock -> (Ptr FLock -> IO Bool) -> IO Bool
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with FLock
    flock ((Ptr FLock -> IO Bool) -> IO Bool)
    -> (Ptr FLock -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Ptr FLock
    flock_ptr -> (IO Bool -> IO Bool) -> IO Bool
    forall a. (a -> a) -> a
    fix ((IO Bool -> IO Bool) -> IO Bool)
    -> (IO Bool -> IO Bool) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \IO Bool
    retry -> do
          ret <- CInt -> CInt -> Ptr FLock -> IO CInt
    c_fcntl CInt
    fd CInt
    mode' Ptr FLock
    flock_ptr
          case ret of
            CInt
    0 -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
            CInt
    _ -> IO Errno
    getErrno IO Errno -> (Errno -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Errno
    errno -> case () of
              ()
    _ | Bool -> Bool
    not Bool
    block Bool -> Bool -> Bool
    && 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
                | Errno
    errno Errno -> Errno -> Bool
    forall a. Eq a => a -> a -> Bool
    == Errno
    eINTR -> IO Bool
    retry
                | Bool
    otherwise -> IOException -> IO Bool
    forall a. HasCallStack => IOException -> IO a
    ioException (IOException -> IO Bool) -> IOException -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Errno -> Maybe Handle -> Maybe String -> IOException
    errnoToIOError String
    ctx Errno
    errno Maybe Handle
    mh Maybe String
    forall a. Maybe a
    Nothing
      where
        flock :: FLock
    flock = FLock { l_type :: CShort
    l_type = case LockMode
    mode of
                                   LockMode
    SharedLock -> CShort
    0
    {-# LINE 187 "src-ofd/Lukko/OFD.hsc" #-}
                                   LockMode
    ExclusiveLock -> CShort
    1
    {-# LINE 188 "src-ofd/Lukko/OFD.hsc" #-}
                      , l_whence :: CShort
    l_whence = CShort
    0
    {-# LINE 189 "src-ofd/Lukko/OFD.hsc" #-}
                      , l_start :: COff
    l_start = COff
    0
                      , l_len :: COff
    l_len = COff
    0
                      , l_pid :: CPid
    l_pid = CPid
    0
                      }
        mode' :: CInt
    mode'
          | Bool
    block     = CInt
    38
    {-# LINE 195 "src-ofd/Lukko/OFD.hsc" #-}
          | otherwise = 37
    {-# LINE 196 "src-ofd/Lukko/OFD.hsc" #-}

    unlockImpl :: FD -> IO ()
    unlockImpl :: FD -> IO ()
    unlockImpl (FD CInt
    fd) = do
      let flock :: FLock
    flock = FLock { l_type :: CShort
    l_type = CShort
    2
    {-# LINE 200 "src-ofd/Lukko/OFD.hsc" #-}
                        , l_whence :: CShort
    l_whence = CShort
    0
    {-# LINE 201 "src-ofd/Lukko/OFD.hsc" #-}
                        , l_start :: COff
    l_start = COff
    0
                        , l_len :: COff
    l_len = COff
    0
                        , l_pid :: CPid
    l_pid = CPid
    0
                        }
      String -> IO CInt -> IO ()
    forall a. (Eq a, Num a) => String -> IO a -> IO ()
    throwErrnoIfMinus1_ String
    "hUnlock"
          (IO CInt -> IO ()) -> IO CInt -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FLock -> (Ptr FLock -> IO CInt) -> IO CInt
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with FLock
    flock ((Ptr FLock -> IO CInt) -> IO CInt)
    -> (Ptr FLock -> IO CInt) -> IO CInt
    forall a b. (a -> b) -> a -> b
    $ CInt -> CInt -> Ptr FLock -> IO CInt
    c_fcntl CInt
    fd CInt
    37
    {-# LINE 207 "src-ofd/Lukko/OFD.hsc" #-}