{-# LINE 1 "src/Netw/Internal/Cmsg.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE DerivingStrategies #-}
module Netw.Internal.Cmsg where


import Control.Monad.Primitive
import Data.Primitive
import Data.Primitive.ByteArray.Unaligned

import Foreign
import Foreign.C

deriving newtype instance PrimUnaligned CSize

type CmsghdrType  = CInt
type CmsghdrLevel = CInt

data {-# CTYPE "sys/socket.h" "struct cmsghdr" #-} Cmsghdr  
data {-# CTYPE "unsigned char" #-} Cmsgdata

-- these function are not too nessisary
foreign import capi unsafe "sys/socket.h CMSG_ALIGN"
  _CMSG_ALIGN :: CSize -> CSize
foreign import capi unsafe "sys/socket.h CMSG_SPACE"
  _CMSG_SPACE :: CSize -> CSize
foreign import capi unsafe "sys/socket.h CMSG_LEN"
  _CMSG_LEN   :: CSize -> CSize
foreign import capi unsafe "sys/socket.h CMSG_DATA"
  _CMSG_DATA  :: Ptr Cmsghdr -> Ptr Cmsgdata

foreign import ccall unsafe "cmsg_nxthdr"
  _CMSG_NXTHDR   :: Ptr a -> CSize -> Ptr Cmsghdr -> IO (Ptr Cmsghdr)
foreign import ccall unsafe "cmsg_firsthdr"
  _CMSG_FIRSTHDR :: Ptr a -> CSize -> Ptr Cmsghdr

cmsgSpace :: Int -> Int
cmsgSpace :: Int -> Int
cmsgSpace = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (Int -> CSize) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> CSize
_CMSG_SPACE (CSize -> CSize) -> (Int -> CSize) -> Int -> CSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{- |
 - `peekCmsg buffer hdroffs reader`
 - `reader` is a function that accept the control message level and type, and the data payload.
 - The payload is given as a buffer, the offset of the payload section (cmsg_data), and the size of the payload (cmsg_len - CMSG_LEN(0)).
 - -}
peekCmsg :: ByteArray -> Int -> (CmsghdrLevel -> CmsghdrType -> ByteArray -> Int -> Int -> a) -> a
peekCmsg :: forall a.
ByteArray
-> Int
-> (CmsghdrLevel -> CmsghdrLevel -> ByteArray -> Int -> Int -> a)
-> a
peekCmsg ByteArray
buffer Int
hdroffs CmsghdrLevel -> CmsghdrLevel -> ByteArray -> Int -> Int -> a
reader = CmsghdrLevel -> CmsghdrLevel -> ByteArray -> Int -> Int -> a
reader CmsghdrLevel
cmsgLevel CmsghdrLevel
cmsgType ByteArray
buffer (Int
hdroffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cmsghdrDataOffset) (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> CSize -> Int
forall a b. (a -> b) -> a -> b
$ CSize
cmsgSize CSize -> CSize -> CSize
forall a. Num a => a -> a -> a
- CSize
cmsghdrSize)
  where cmsgSize :: CSize
cmsgSize  = forall a. PrimUnaligned a => ByteArray -> Int -> a
indexUnalignedByteArray @CSize        ByteArray
buffer (Int
hdroffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
0))
{-# LINE 48 "src/Netw/Internal/Cmsg.hsc" #-}
        cmsgLevel :: CmsghdrLevel
cmsgLevel = forall a. PrimUnaligned a => ByteArray -> Int -> a
indexUnalignedByteArray @CmsghdrLevel ByteArray
buffer (Int
hdroffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
8))
{-# LINE 49 "src/Netw/Internal/Cmsg.hsc" #-}
        cmsgType :: CmsghdrLevel
cmsgType  = forall a. PrimUnaligned a => ByteArray -> Int -> a
indexUnalignedByteArray @CmsghdrType  ByteArray
buffer (Int
hdroffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
12))
{-# LINE 50 "src/Netw/Internal/Cmsg.hsc" #-}
        cmsghdrDataOffset :: Int
cmsghdrDataOffset = Int
16
{-# LINE 51 "src/Netw/Internal/Cmsg.hsc" #-}
        cmsghdrSize :: CSize
cmsghdrSize       = CSize -> CSize
_CMSG_LEN CSize
0

{- |
 - `pokeCmsg buffer hdroffs cmsgLevel cmsgType cmsgPayloadLen cmsgPayload`
 - Store a control message element info the `buffer` at `hdroffs`.
 - `cmsgPayloadLen` is the length of the data section.
 - `cmsgPayload` is a function that take a buffer, offset into that buffer, and write the data section at that location.
 - -}
pokeCmsg :: PrimMonad m => MutableByteArray (PrimState m) -> Int -> CmsghdrLevel -> CmsghdrType -> Int -> (MutableByteArray (PrimState m) -> Int -> m ()) -> m ()
pokeCmsg :: forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int
-> CmsghdrLevel
-> CmsghdrLevel
-> Int
-> (MutableByteArray (PrimState m) -> Int -> m ())
-> m ()
pokeCmsg MutableByteArray (PrimState m)
buffer Int
hdroffs CmsghdrLevel
cmsgLevel CmsghdrLevel
cmsgType Int
cmsgPayloadLen MutableByteArray (PrimState m) -> Int -> m ()
cmsgPayload = do
  forall (m :: * -> *) a.
(PrimMonad m, PrimUnaligned a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeUnalignedByteArray @_ @CSize        MutableByteArray (PrimState m)
buffer (Int
hdroffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
0))   (CSize -> CSize
_CMSG_LEN (CSize -> CSize) -> CSize -> CSize
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cmsgPayloadLen)
{-# LINE 62 "src/Netw/Internal/Cmsg.hsc" #-}
  writeUnalignedByteArray @_ @CmsghdrLevel buffer (hdroffs + (8)) cmsgLevel
{-# LINE 63 "src/Netw/Internal/Cmsg.hsc" #-}
  writeUnalignedByteArray @_ @CmsghdrType  buffer (hdroffs + (12))  cmsgType
{-# LINE 64 "src/Netw/Internal/Cmsg.hsc" #-}
  cmsgPayload buffer (hdroffs + cmsghdrDataOffset)
  where cmsghdrDataOffset :: Int
cmsghdrDataOffset = Int
16
{-# LINE 66 "src/Netw/Internal/Cmsg.hsc" #-}

newCmsgBuffer :: PrimMonad m => Int -> m (MutableByteArray (PrimState m))
newCmsgBuffer :: forall (m :: * -> *).
PrimMonad m =>
Int -> m (MutableByteArray (PrimState m))
newCmsgBuffer Int
totalSize = do
  MutableByteArray (PrimState m)
buffer <- Int -> Int -> m (MutableByteArray (PrimState m))
forall (m :: * -> *).
PrimMonad m =>
Int -> Int -> m (MutableByteArray (PrimState m))
newAlignedPinnedByteArray Int
totalSize Int
8
{-# LINE 70 "src/Netw/Internal/Cmsg.hsc" #-}
  fillByteArray buffer 0 totalSize 0
  MutableByteArray (PrimState m)
-> m (MutableByteArray (PrimState m))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MutableByteArray (PrimState m)
buffer