{-# LINE 1 "Network/Socket/Posix/CmsgHdr.hsc" #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}



module Network.Socket.Posix.CmsgHdr (
    Cmsg(..)
  , withCmsgs
  , parseCmsgs
  ) where




import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.ForeignPtr
import qualified Data.ByteString as B
import Data.ByteString.Internal

import Network.Socket.Imports
import Network.Socket.Posix.Cmsg
import Network.Socket.Posix.MsgHdr
import Network.Socket.Types

data CmsgHdr = CmsgHdr {

{-# LINE 26 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    cmsgHdrLen   :: !CSize

{-# LINE 30 "Network/Socket/Posix/CmsgHdr.hsc" #-}
  , CmsgHdr -> CInt
cmsgHdrLevel :: !CInt
  , CmsgHdr -> CInt
cmsgHdrType  :: !CInt
  } deriving (CmsgHdr -> CmsgHdr -> Bool
(CmsgHdr -> CmsgHdr -> Bool)
-> (CmsgHdr -> CmsgHdr -> Bool) -> Eq CmsgHdr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmsgHdr -> CmsgHdr -> Bool
== :: CmsgHdr -> CmsgHdr -> Bool
$c/= :: CmsgHdr -> CmsgHdr -> Bool
/= :: CmsgHdr -> CmsgHdr -> Bool
Eq, Int -> CmsgHdr -> ShowS
[CmsgHdr] -> ShowS
CmsgHdr -> String
(Int -> CmsgHdr -> ShowS)
-> (CmsgHdr -> String) -> ([CmsgHdr] -> ShowS) -> Show CmsgHdr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmsgHdr -> ShowS
showsPrec :: Int -> CmsgHdr -> ShowS
$cshow :: CmsgHdr -> String
show :: CmsgHdr -> String
$cshowList :: [CmsgHdr] -> ShowS
showList :: [CmsgHdr] -> ShowS
Show)

instance Storable CmsgHdr where
  sizeOf :: CmsgHdr -> Int
sizeOf    CmsgHdr
_ = ((Int
16))
{-# LINE 36 "Network/Socket/Posix/CmsgHdr.hsc" #-}
  alignment _ = alignment (0 :: CInt)

  peek :: Ptr CmsgHdr -> IO CmsgHdr
peek Ptr CmsgHdr
p = do
    CSize
len <- ((\Ptr CmsgHdr
hsc_ptr -> Ptr CmsgHdr -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CmsgHdr
hsc_ptr Int
0))   Ptr CmsgHdr
p
{-# LINE 40 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    lvl <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 41 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    typ <- ((\hsc_ptr -> peekByteOff hsc_ptr 12))  p
{-# LINE 42 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    return $ CmsgHdr len lvl typ

  poke :: Ptr CmsgHdr -> CmsgHdr -> IO ()
poke Ptr CmsgHdr
p (CmsgHdr CSize
len CInt
lvl CInt
typ) = do
    Ptr CmsgHdr -> CSize -> IO ()
forall a. Ptr a -> CSize -> IO ()
zeroMemory Ptr CmsgHdr
p ((CSize
16))
{-# LINE 46 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0))   p len
{-# LINE 47 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p lvl
{-# LINE 48 "Network/Socket/Posix/CmsgHdr.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12))  p typ
{-# LINE 49 "Network/Socket/Posix/CmsgHdr.hsc" #-}

withCmsgs :: [Cmsg] -> (Ptr CmsgHdr -> Int -> IO a) -> IO a
withCmsgs :: forall a. [Cmsg] -> (Ptr CmsgHdr -> Int -> IO a) -> IO a
withCmsgs [Cmsg]
cmsgs0 Ptr CmsgHdr -> Int -> IO a
action
  | Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Ptr CmsgHdr -> Int -> IO a
action Ptr CmsgHdr
forall a. Ptr a
nullPtr Int
0
  | Bool
otherwise  = Int -> (Ptr CmsgHdr -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
total ((Ptr CmsgHdr -> IO a) -> IO a) -> (Ptr CmsgHdr -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CmsgHdr
ctrlPtr -> do
        Ptr CmsgHdr -> [Cmsg] -> [Int] -> IO ()
loop Ptr CmsgHdr
ctrlPtr [Cmsg]
cmsgs0 [Int]
spaces
        Ptr CmsgHdr -> Int -> IO a
action Ptr CmsgHdr
ctrlPtr Int
total
  where
    loop :: Ptr CmsgHdr -> [Cmsg] -> [Int] -> IO ()
loop Ptr CmsgHdr
ctrlPtr (Cmsg
cmsg:[Cmsg]
cmsgs) (Int
s:[Int]
ss) = do
        Cmsg -> Ptr CmsgHdr -> IO ()
toCmsgHdr Cmsg
cmsg Ptr CmsgHdr
ctrlPtr
        let nextPtr :: Ptr b
nextPtr = Ptr CmsgHdr
ctrlPtr Ptr CmsgHdr -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
s
        Ptr CmsgHdr -> [Cmsg] -> [Int] -> IO ()
loop Ptr CmsgHdr
forall a. Ptr a
nextPtr [Cmsg]
cmsgs [Int]
ss
    loop Ptr CmsgHdr
_ [Cmsg]
_ [Int]
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    cmsg_space :: Int -> Int
cmsg_space = 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
c_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
    spaces :: [Int]
spaces = (Cmsg -> Int) -> [Cmsg] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
cmsg_space (Int -> Int) -> (Cmsg -> Int) -> Cmsg -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
B.length (ByteString -> Int) -> (Cmsg -> ByteString) -> Cmsg -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cmsg -> ByteString
cmsgData) [Cmsg]
cmsgs0
    total :: Int
total = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
spaces

toCmsgHdr :: Cmsg -> Ptr CmsgHdr -> IO ()
toCmsgHdr :: Cmsg -> Ptr CmsgHdr -> IO ()
toCmsgHdr (Cmsg (CmsgId CInt
lvl CInt
typ) (PS ForeignPtr Word8
fptr Int
off Int
len)) Ptr CmsgHdr
ctrlPtr = do
    Ptr CmsgHdr -> CmsgHdr -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CmsgHdr
ctrlPtr (CmsgHdr -> IO ()) -> CmsgHdr -> IO ()
forall a b. (a -> b) -> a -> b
$ CSize -> CInt -> CInt -> CmsgHdr
CmsgHdr (CSize -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> CSize) -> CSize -> CSize
forall a b. (a -> b) -> a -> b
$ CSize -> CSize
c_cmsg_len (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)) CInt
lvl CInt
typ
    ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
src0 -> do
        let src :: Ptr b
src = Ptr Word8
src0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
        Ptr Word8
dst <- Ptr CmsgHdr -> IO (Ptr Word8)
c_cmsg_data Ptr CmsgHdr
ctrlPtr
        Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
forall a. Ptr a
src Int
len

parseCmsgs :: SocketAddress sa => Ptr (MsgHdr sa) -> IO [Cmsg]
parseCmsgs :: forall sa. SocketAddress sa => Ptr (MsgHdr sa) -> IO [Cmsg]
parseCmsgs Ptr (MsgHdr sa)
msgptr = do
    Ptr CmsgHdr
ptr <- Ptr (MsgHdr sa) -> IO (Ptr CmsgHdr)
forall sa. Ptr (MsgHdr sa) -> IO (Ptr CmsgHdr)
c_cmsg_firsthdr Ptr (MsgHdr sa)
msgptr
    Ptr CmsgHdr -> ([Cmsg] -> [Cmsg]) -> IO [Cmsg]
forall {c}. Ptr CmsgHdr -> ([Cmsg] -> c) -> IO c
loop Ptr CmsgHdr
ptr [Cmsg] -> [Cmsg]
forall a. a -> a
id
  where
    loop :: Ptr CmsgHdr -> ([Cmsg] -> c) -> IO c
loop Ptr CmsgHdr
ptr [Cmsg] -> c
build
      | Ptr CmsgHdr
ptr Ptr CmsgHdr -> Ptr CmsgHdr -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CmsgHdr
forall a. Ptr a
nullPtr = c -> IO c
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> IO c) -> c -> IO c
forall a b. (a -> b) -> a -> b
$ [Cmsg] -> c
build []
      | Bool
otherwise = do
            Cmsg
cmsg <- Ptr CmsgHdr -> IO Cmsg
fromCmsgHdr Ptr CmsgHdr
ptr
            Ptr CmsgHdr
nextPtr <- Ptr (MsgHdr sa) -> Ptr CmsgHdr -> IO (Ptr CmsgHdr)
forall sa. Ptr (MsgHdr sa) -> Ptr CmsgHdr -> IO (Ptr CmsgHdr)
c_cmsg_nxthdr Ptr (MsgHdr sa)
msgptr Ptr CmsgHdr
ptr
            Ptr CmsgHdr -> ([Cmsg] -> c) -> IO c
loop Ptr CmsgHdr
nextPtr ([Cmsg] -> c
build ([Cmsg] -> c) -> ([Cmsg] -> [Cmsg]) -> [Cmsg] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmsg
cmsg Cmsg -> [Cmsg] -> [Cmsg]
forall a. a -> [a] -> [a]
:))

fromCmsgHdr :: Ptr CmsgHdr -> IO Cmsg
fromCmsgHdr :: Ptr CmsgHdr -> IO Cmsg
fromCmsgHdr Ptr CmsgHdr
ptr = do
    CmsgHdr CSize
len CInt
lvl CInt
typ <- Ptr CmsgHdr -> IO CmsgHdr
forall a. Storable a => Ptr a -> IO a
peek Ptr CmsgHdr
ptr
    Ptr Word8
src <- Ptr CmsgHdr -> IO (Ptr Word8)
c_cmsg_data Ptr CmsgHdr
ptr
    let siz :: Int
siz = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Ptr Word8
src Ptr Word8 -> Ptr CmsgHdr -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr CmsgHdr
ptr)
    CmsgId -> ByteString -> Cmsg
Cmsg (CInt -> CInt -> CmsgId
CmsgId CInt
lvl CInt
typ) (ByteString -> Cmsg) -> IO ByteString -> IO Cmsg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz) (\Ptr Word8
dst -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
dst Ptr Word8
src Int
siz)

foreign import ccall unsafe "cmsg_firsthdr"
  c_cmsg_firsthdr :: Ptr (MsgHdr sa) -> IO (Ptr CmsgHdr)

foreign import ccall unsafe "cmsg_nxthdr"
  c_cmsg_nxthdr :: Ptr (MsgHdr sa) -> Ptr CmsgHdr -> IO (Ptr CmsgHdr)

foreign import ccall unsafe "cmsg_data"
  c_cmsg_data :: Ptr CmsgHdr -> IO (Ptr Word8)

foreign import ccall unsafe "cmsg_space"
  c_cmsg_space :: CSize -> CSize

foreign import ccall unsafe "cmsg_len"
  c_cmsg_len :: CSize -> CSize