-- | Provides shared memory for IPC (Inter Process Communication).
module SharedMemory
  ( openSharedMemory
  ) where

import           Foreign.C.Types (CSize)
import qualified Foreign.Concurrent as FC
import           Foreign.ForeignPtr
import           Foreign.Ptr
import           System.Posix.Files
import           System.Posix.SharedMem
import           System.Posix.Types

import           MMAP


-- | @openSharedMemory shmemPath size openFlags openFileMode@:
-- Creates a shared memory file using @shm_open@ at @shmemPath@ of @size@ bytes,
-- returning the created `Fd` and `ForeignPtr` pointing to the @mmap@'ed memory.
--
-- Note that there are portability considerations, that put constraints on what
-- you can pass to this function. For example, @shmemPath@ is recommended to
-- start with @/@, and BSD as of writing requires that. Consult @man shm_open@.
--
-- The `Fd` can be used to resize the shared memory region.
--
-- When the returned `ForeignPtr` is garbage collected, the memory is @munmap@'ed,
-- but the `Fd` remains open until it is closed or garbage collected.
--
-- Closing the `Fd` will not invalidate the returned `ForeignPtr`.
openSharedMemory :: String -> CSize -> ShmOpenFlags -> FileMode -> IO (ForeignPtr (), Fd)
openSharedMemory :: String
-> CSize -> ShmOpenFlags -> FileMode -> IO (ForeignPtr (), Fd)
openSharedMemory String
shmemPath CSize
size ShmOpenFlags
openFlags FileMode
openFileMode = do
  Fd
fd <- String -> ShmOpenFlags -> FileMode -> IO Fd
shmOpen String
shmemPath ShmOpenFlags
openFlags FileMode
openFileMode
  Fd -> FileOffset -> IO ()
setFdSize Fd
fd (forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
size)
  Ptr ()
ptr <- Ptr ()
-> CSize
-> ProtOption
-> MmapFlags
-> Fd
-> FileOffset
-> IO (Ptr ())
mmap forall a. Ptr a
nullPtr
              CSize
size
              (ProtOption
protRead forall a. Semigroup a => a -> a -> a
<> ProtOption
protWrite)
              (MmapSharedFlag -> MmapOptionalFlag -> MmapFlags
mkMmapFlags MmapSharedFlag
mapShared forall a. Monoid a => a
mempty)
              Fd
fd
              FileOffset
0
  ForeignPtr ()
fptr <- forall a. Ptr a -> IO () -> IO (ForeignPtr a)
FC.newForeignPtr Ptr ()
ptr (Ptr () -> CSize -> IO ()
munmap Ptr ()
ptr CSize
size)
  forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ()
fptr, Fd
fd)