    {-# 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

    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
    fd <- Handle -> IO FD
    handleToFd Handle
    h
        IO Bool -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Maybe Handle -> FD -> String -> LockMode -> Bool -> IO Bool
    lockImpl (Handle -> Maybe Handle
    forall a. a -> Maybe a
    Just Handle
    h) FD
    fd String
    "hLock" LockMode
    mode Bool
    True)

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

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

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

    -- there is no alignment in old hsc2hs

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

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

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

    {-# LINE 127 "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 144 "src-ofd/Lukko/OFD.hsc" #-}
        alignment _ = 8
    {-# LINE 145 "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 148 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 2) ptr (l_whence x)
    {-# LINE 149 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 8)  ptr (l_start x)
    {-# LINE 150 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 16)    ptr (l_len x)
    {-# LINE 151 "src-ofd/Lukko/OFD.hsc" #-}
            (\hsc_ptr -> pokeByteOff hsc_ptr 24)    ptr (l_pid x)
    {-# LINE 152 "src-ofd/Lukko/OFD.hsc" #-}
        peek ptr = do
            x1 <- (\hsc_ptr -> peekByteOff hsc_ptr 0)   ptr
    {-# LINE 154 "src-ofd/Lukko/OFD.hsc" #-}
            x2 <- (\hsc_ptr -> peekByteOff hsc_ptr 2) ptr
    {-# LINE 155 "src-ofd/Lukko/OFD.hsc" #-}
            x3 <- (\hsc_ptr -> peekByteOff hsc_ptr 8)  ptr
    {-# LINE 156 "src-ofd/Lukko/OFD.hsc" #-}
            x4 <- (\hsc_ptr -> peekByteOff hsc_ptr 16)    ptr
    {-# LINE 157 "src-ofd/Lukko/OFD.hsc" #-}
            x5 <- (\hsc_ptr -> peekByteOff hsc_ptr 24)    ptr
    {-# LINE 158 "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
          CInt
    ret <- CInt -> CInt -> Ptr FLock -> IO CInt
    c_fcntl CInt
    fd CInt
    mode' Ptr FLock
    flock_ptr
          case CInt
    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. 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 173 "src-ofd/Lukko/OFD.hsc" #-}
                                   LockMode
    ExclusiveLock -> CShort
    1
    {-# LINE 174 "src-ofd/Lukko/OFD.hsc" #-}
                      , l_whence :: CShort
    l_whence = CShort
    0
    {-# LINE 175 "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 181 "src-ofd/Lukko/OFD.hsc" #-}
          | otherwise = 37
    {-# LINE 182 "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 186 "src-ofd/Lukko/OFD.hsc" #-}
                        , l_whence :: CShort
    l_whence = CShort
    0
    {-# LINE 187 "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 193 "src-ofd/Lukko/OFD.hsc" #-}