Add util to allocate shared memory

quasar-wayland.cabal

@@ -84,12 +84,16 @@ library
     Quasar.Wayland.Protocol.TH
   other-modules:
     Quasar.Wayland.Protocol.Core
+    Quasar.Wayland.Utils.InlineC
+    Quasar.Wayland.Utils.SharedMemory
   build-depends:
     base >=4.7 && <5,
     binary,
     bytestring,
+    containers,
     exceptions,
     filepath,
+    inline-c,
     mtl,
     network,
     quasar,

src/Quasar/Wayland/Utils/InlineC.hs

+module Quasar.Wayland.Utils.InlineC (
+  ctx
+) where
+
+import Data.Map.Strict as Map
+import Language.C.Inline.Context
+import Language.C.Types
+import Language.Haskell.TH
+import Quasar.Prelude
+import System.Posix.Types (COff(..))
+
+ctx :: Context
+ctx = baseCtx <> extraTypesCtx
+
+emptyCtx :: Context
+emptyCtx = Context {
+  ctxTypesTable = mempty,
+  ctxAntiQuoters = mempty,
+  ctxOutput = mempty,
+  ctxForeignSrcLang = Nothing,
+  ctxEnableCpp = False
+}
+
+extraTypesCtx :: Context
+extraTypesCtx =
+  emptyCtx {
+    ctxTypesTable = Map.fromList types
+  }
+
+types :: [(TypeSpecifier, TypeQ)]
+types = [
+  (TypeName "off_t", [t|COff|])
+  ]

src/Quasar/Wayland/Utils/SharedMemory.hs

+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Quasar.Wayland.Utils.SharedMemory (
+  allocateShmFd,
+) where
+
+import Foreign.C.Error
+import Language.C.Inline qualified as C
+import Language.C.Inline.Unsafe qualified as CU
+import Quasar.Prelude
+import Quasar.Wayland.Utils.InlineC
+import System.Posix.Types (COff(..), Fd(Fd))
+
+C.context ctx
+
+C.verbatim "#define _GNU_SOURCE"
+C.include "<unistd.h>"
+C.include "<sys/mman.h>"
+
+allocateShmFd :: COff -> IO Fd
+allocateShmFd size = Fd <$> throwErrnoIfMinus1 "allocateShmFd"
+  [CU.block|
+    int {
+      int fd = memfd_create("shm", MFD_CLOEXEC | MFD_ALLOW_SEALING);
+      if (fd < 0) {
+              return fd;
+      }
+
+      if (ftruncate(fd, $(off_t size)) < 0) {
+              close(fd);
+              return -1;
+      }
+      return fd;
+    }
+  |]