{-# LINE 1 "Network/Socket/Posix/Cmsg.hsc" #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Network.Socket.Posix.Cmsg where






import Data.ByteString.Internal
import Foreign.ForeignPtr
import Foreign.Marshal.Array (peekArray, pokeArray)
import System.IO.Unsafe (unsafeDupablePerformIO)
import System.Posix.Types (Fd(..))

import Network.Socket.Imports
import Network.Socket.Types
import Network.Socket.ReadShow

import qualified Text.Read as P

-- | Control message (ancillary data) including a pair of level and type.
data Cmsg = Cmsg {
    Cmsg -> CmsgId
cmsgId   :: CmsgId
  , Cmsg -> ByteString
cmsgData :: ByteString
  } deriving (Cmsg -> Cmsg -> Bool
(Cmsg -> Cmsg -> Bool) -> (Cmsg -> Cmsg -> Bool) -> Eq Cmsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cmsg -> Cmsg -> Bool
== :: Cmsg -> Cmsg -> Bool
$c/= :: Cmsg -> Cmsg -> Bool
/= :: Cmsg -> Cmsg -> Bool
Eq, Int -> Cmsg -> ShowS
[Cmsg] -> ShowS
Cmsg -> String
(Int -> Cmsg -> ShowS)
-> (Cmsg -> String) -> ([Cmsg] -> ShowS) -> Show Cmsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cmsg -> ShowS
showsPrec :: Int -> Cmsg -> ShowS
$cshow :: Cmsg -> String
show :: Cmsg -> String
$cshowList :: [Cmsg] -> ShowS
showList :: [Cmsg] -> ShowS
Show)

----------------------------------------------------------------

-- | Identifier of control message (ancillary data).
data CmsgId = CmsgId {
    CmsgId -> CInt
cmsgLevel :: CInt
  , CmsgId -> CInt
cmsgType  :: CInt
  } deriving (CmsgId -> CmsgId -> Bool
(CmsgId -> CmsgId -> Bool)
-> (CmsgId -> CmsgId -> Bool) -> Eq CmsgId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmsgId -> CmsgId -> Bool
== :: CmsgId -> CmsgId -> Bool
$c/= :: CmsgId -> CmsgId -> Bool
/= :: CmsgId -> CmsgId -> Bool
Eq)

-- | Unsupported identifier
pattern UnsupportedCmsgId :: CmsgId
pattern $mUnsupportedCmsgId :: forall {r}. CmsgId -> ((# #) -> r) -> ((# #) -> r) -> r
$bUnsupportedCmsgId :: CmsgId
UnsupportedCmsgId = CmsgId (-1) (-1)

-- | The identifier for 'IPv4TTL'.
pattern CmsgIdIPv4TTL :: CmsgId

{-# LINE 52 "Network/Socket/Posix/Cmsg.hsc" #-}
pattern $mCmsgIdIPv4TTL :: forall {r}. CmsgId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCmsgIdIPv4TTL :: CmsgId
CmsgIdIPv4TTL = CmsgId (0) (2)
{-# LINE 53 "Network/Socket/Posix/Cmsg.hsc" #-}

{-# LINE 54 "Network/Socket/Posix/Cmsg.hsc" #-}

-- | The identifier for 'IPv6HopLimit'.
pattern CmsgIdIPv6HopLimit :: CmsgId
pattern $mCmsgIdIPv6HopLimit :: forall {r}. CmsgId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCmsgIdIPv6HopLimit :: CmsgId
CmsgIdIPv6HopLimit = CmsgId (41) (52)
{-# LINE 58 "Network/Socket/Posix/Cmsg.hsc" #-}

-- | The identifier for 'IPv4TOS'.
pattern CmsgIdIPv4TOS :: CmsgId

{-# LINE 64 "Network/Socket/Posix/Cmsg.hsc" #-}
pattern $mCmsgIdIPv4TOS :: forall {r}. CmsgId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCmsgIdIPv4TOS :: CmsgId
CmsgIdIPv4TOS = CmsgId (0) (1)
{-# LINE 65 "Network/Socket/Posix/Cmsg.hsc" #-}

{-# LINE 66 "Network/Socket/Posix/Cmsg.hsc" #-}

-- | The identifier for 'IPv6TClass'.
pattern CmsgIdIPv6TClass :: CmsgId
pattern $mCmsgIdIPv6TClass :: forall {r}. CmsgId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCmsgIdIPv6TClass :: CmsgId
CmsgIdIPv6TClass = CmsgId (41) (67)
{-# LINE 70 "Network/Socket/Posix/Cmsg.hsc" #-}

-- | The identifier for 'IPv4PktInfo'.
pattern CmsgIdIPv4PktInfo :: CmsgId

{-# LINE 74 "Network/Socket/Posix/Cmsg.hsc" #-}
pattern CmsgIdIPv4PktInfo = CmsgId (0) (8)
{-# LINE 75 "Network/Socket/Posix/Cmsg.hsc" #-}

{-# LINE 78 "Network/Socket/Posix/Cmsg.hsc" #-}

-- | The identifier for 'IPv6PktInfo'.
pattern CmsgIdIPv6PktInfo :: CmsgId

{-# LINE 82 "Network/Socket/Posix/Cmsg.hsc" #-}
pattern CmsgIdIPv6PktInfo = CmsgId (41) (50)
{-# LINE 83 "Network/Socket/Posix/Cmsg.hsc" #-}

{-# LINE 86 "Network/Socket/Posix/Cmsg.hsc" #-}

-- | The identifier for 'Fds'.
pattern CmsgIdFds :: CmsgId
pattern $mCmsgIdFds :: forall {r}. CmsgId -> ((# #) -> r) -> ((# #) -> r) -> r
$bCmsgIdFds :: CmsgId
CmsgIdFds = CmsgId (1) (1)
{-# LINE 90 "Network/Socket/Posix/Cmsg.hsc" #-}

----------------------------------------------------------------

-- | Locate a control message of the given type in a list of control
--   messages. The following shows an example usage:
--
-- > (lookupCmsg CmsgIdIPv4TOS cmsgs >>= decodeCmsg) :: Maybe IPv4TOS
lookupCmsg :: CmsgId -> [Cmsg] -> Maybe Cmsg
lookupCmsg :: CmsgId -> [Cmsg] -> Maybe Cmsg
lookupCmsg CmsgId
cid [Cmsg]
cmsgs = (Cmsg -> Bool) -> [Cmsg] -> Maybe Cmsg
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Cmsg
cmsg -> Cmsg -> CmsgId
cmsgId Cmsg
cmsg CmsgId -> CmsgId -> Bool
forall a. Eq a => a -> a -> Bool
== CmsgId
cid) [Cmsg]
cmsgs

-- | Filtering control message.
filterCmsg :: CmsgId -> [Cmsg] -> [Cmsg]
filterCmsg :: CmsgId -> [Cmsg] -> [Cmsg]
filterCmsg CmsgId
cid [Cmsg]
cmsgs = (Cmsg -> Bool) -> [Cmsg] -> [Cmsg]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Cmsg
cmsg -> Cmsg -> CmsgId
cmsgId Cmsg
cmsg CmsgId -> CmsgId -> Bool
forall a. Eq a => a -> a -> Bool
== CmsgId
cid) [Cmsg]
cmsgs

----------------------------------------------------------------

-- | Control message type class.
--   Each control message type has a numeric 'CmsgId' and encode
--   and decode functions.
class ControlMessage a where
    controlMessageId :: CmsgId
    encodeCmsg :: a -> Cmsg
    decodeCmsg :: Cmsg -> Maybe a

encodeStorableCmsg :: forall a . (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg :: forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg a
x = IO Cmsg -> Cmsg
forall a. IO a -> a
unsafeDupablePerformIO (IO Cmsg -> Cmsg) -> IO Cmsg -> Cmsg
forall a b. (a -> b) -> a -> b
$ do
    ByteString
bs <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
siz ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> do
        let p :: Ptr b
p = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p0
        Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr a
forall {b}. Ptr b
p a
x
    let cmsid :: CmsgId
cmsid = forall a. ControlMessage a => CmsgId
controlMessageId @a
    Cmsg -> IO Cmsg
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cmsg -> IO Cmsg) -> Cmsg -> IO Cmsg
forall a b. (a -> b) -> a -> b
$ CmsgId -> ByteString -> Cmsg
Cmsg CmsgId
cmsid ByteString
bs
  where
    siz :: Int
siz = a -> Int
forall a. Storable a => a -> Int
sizeOf a
x

decodeStorableCmsg :: forall a . (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg :: forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg (Cmsg CmsgId
cmsid (PS ForeignPtr Word8
fptr Int
off Int
len))
  | CmsgId
cid CmsgId -> CmsgId -> Bool
forall a. Eq a => a -> a -> Bool
/= CmsgId
cmsid = Maybe a
forall a. Maybe a
Nothing
  | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
siz    = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise    = IO (Maybe a) -> Maybe a
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe a) -> Maybe a) -> IO (Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO (Maybe a)) -> IO (Maybe a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Maybe a)) -> IO (Maybe a))
-> (Ptr Word8 -> IO (Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> do
        let p :: Ptr b
p = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
p0 Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
        a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
forall {b}. Ptr b
p
  where
    cid :: CmsgId
cid = forall a. ControlMessage a => CmsgId
controlMessageId @a
    siz :: Int
siz = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)

----------------------------------------------------------------

-- | Time to live of IPv4.

{-# LINE 141 "Network/Socket/Posix/Cmsg.hsc" #-}
newtype IPv4TTL = IPv4TTL CInt deriving (IPv4TTL -> IPv4TTL -> Bool
(IPv4TTL -> IPv4TTL -> Bool)
-> (IPv4TTL -> IPv4TTL -> Bool) -> Eq IPv4TTL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv4TTL -> IPv4TTL -> Bool
== :: IPv4TTL -> IPv4TTL -> Bool
$c/= :: IPv4TTL -> IPv4TTL -> Bool
/= :: IPv4TTL -> IPv4TTL -> Bool
Eq, Int -> IPv4TTL -> ShowS
[IPv4TTL] -> ShowS
IPv4TTL -> String
(Int -> IPv4TTL -> ShowS)
-> (IPv4TTL -> String) -> ([IPv4TTL] -> ShowS) -> Show IPv4TTL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IPv4TTL -> ShowS
showsPrec :: Int -> IPv4TTL -> ShowS
$cshow :: IPv4TTL -> String
show :: IPv4TTL -> String
$cshowList :: [IPv4TTL] -> ShowS
showList :: [IPv4TTL] -> ShowS
Show, Ptr IPv4TTL -> IO IPv4TTL
Ptr IPv4TTL -> Int -> IO IPv4TTL
Ptr IPv4TTL -> Int -> IPv4TTL -> IO ()
Ptr IPv4TTL -> IPv4TTL -> IO ()
IPv4TTL -> Int
(IPv4TTL -> Int)
-> (IPv4TTL -> Int)
-> (Ptr IPv4TTL -> Int -> IO IPv4TTL)
-> (Ptr IPv4TTL -> Int -> IPv4TTL -> IO ())
-> (forall b. Ptr b -> Int -> IO IPv4TTL)
-> (forall b. Ptr b -> Int -> IPv4TTL -> IO ())
-> (Ptr IPv4TTL -> IO IPv4TTL)
-> (Ptr IPv4TTL -> IPv4TTL -> IO ())
-> Storable IPv4TTL
forall b. Ptr b -> Int -> IO IPv4TTL
forall b. Ptr b -> Int -> IPv4TTL -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: IPv4TTL -> Int
sizeOf :: IPv4TTL -> Int
$calignment :: IPv4TTL -> Int
alignment :: IPv4TTL -> Int
$cpeekElemOff :: Ptr IPv4TTL -> Int -> IO IPv4TTL
peekElemOff :: Ptr IPv4TTL -> Int -> IO IPv4TTL
$cpokeElemOff :: Ptr IPv4TTL -> Int -> IPv4TTL -> IO ()
pokeElemOff :: Ptr IPv4TTL -> Int -> IPv4TTL -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO IPv4TTL
peekByteOff :: forall b. Ptr b -> Int -> IO IPv4TTL
$cpokeByteOff :: forall b. Ptr b -> Int -> IPv4TTL -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> IPv4TTL -> IO ()
$cpeek :: Ptr IPv4TTL -> IO IPv4TTL
peek :: Ptr IPv4TTL -> IO IPv4TTL
$cpoke :: Ptr IPv4TTL -> IPv4TTL -> IO ()
poke :: Ptr IPv4TTL -> IPv4TTL -> IO ()
Storable)

{-# LINE 143 "Network/Socket/Posix/Cmsg.hsc" #-}

instance ControlMessage IPv4TTL where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdIPv4TTL
    encodeCmsg :: IPv4TTL -> Cmsg
encodeCmsg = IPv4TTL -> Cmsg
forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg
    decodeCmsg :: Cmsg -> Maybe IPv4TTL
decodeCmsg = Cmsg -> Maybe IPv4TTL
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg

----------------------------------------------------------------

-- | Hop limit of IPv6.
newtype IPv6HopLimit = IPv6HopLimit CInt deriving (IPv6HopLimit -> IPv6HopLimit -> Bool
(IPv6HopLimit -> IPv6HopLimit -> Bool)
-> (IPv6HopLimit -> IPv6HopLimit -> Bool) -> Eq IPv6HopLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv6HopLimit -> IPv6HopLimit -> Bool
== :: IPv6HopLimit -> IPv6HopLimit -> Bool
$c/= :: IPv6HopLimit -> IPv6HopLimit -> Bool
/= :: IPv6HopLimit -> IPv6HopLimit -> Bool
Eq, Int -> IPv6HopLimit -> ShowS
[IPv6HopLimit] -> ShowS
IPv6HopLimit -> String
(Int -> IPv6HopLimit -> ShowS)
-> (IPv6HopLimit -> String)
-> ([IPv6HopLimit] -> ShowS)
-> Show IPv6HopLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IPv6HopLimit -> ShowS
showsPrec :: Int -> IPv6HopLimit -> ShowS
$cshow :: IPv6HopLimit -> String
show :: IPv6HopLimit -> String
$cshowList :: [IPv6HopLimit] -> ShowS
showList :: [IPv6HopLimit] -> ShowS
Show, Ptr IPv6HopLimit -> IO IPv6HopLimit
Ptr IPv6HopLimit -> Int -> IO IPv6HopLimit
Ptr IPv6HopLimit -> Int -> IPv6HopLimit -> IO ()
Ptr IPv6HopLimit -> IPv6HopLimit -> IO ()
IPv6HopLimit -> Int
(IPv6HopLimit -> Int)
-> (IPv6HopLimit -> Int)
-> (Ptr IPv6HopLimit -> Int -> IO IPv6HopLimit)
-> (Ptr IPv6HopLimit -> Int -> IPv6HopLimit -> IO ())
-> (forall b. Ptr b -> Int -> IO IPv6HopLimit)
-> (forall b. Ptr b -> Int -> IPv6HopLimit -> IO ())
-> (Ptr IPv6HopLimit -> IO IPv6HopLimit)
-> (Ptr IPv6HopLimit -> IPv6HopLimit -> IO ())
-> Storable IPv6HopLimit
forall b. Ptr b -> Int -> IO IPv6HopLimit
forall b. Ptr b -> Int -> IPv6HopLimit -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: IPv6HopLimit -> Int
sizeOf :: IPv6HopLimit -> Int
$calignment :: IPv6HopLimit -> Int
alignment :: IPv6HopLimit -> Int
$cpeekElemOff :: Ptr IPv6HopLimit -> Int -> IO IPv6HopLimit
peekElemOff :: Ptr IPv6HopLimit -> Int -> IO IPv6HopLimit
$cpokeElemOff :: Ptr IPv6HopLimit -> Int -> IPv6HopLimit -> IO ()
pokeElemOff :: Ptr IPv6HopLimit -> Int -> IPv6HopLimit -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO IPv6HopLimit
peekByteOff :: forall b. Ptr b -> Int -> IO IPv6HopLimit
$cpokeByteOff :: forall b. Ptr b -> Int -> IPv6HopLimit -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> IPv6HopLimit -> IO ()
$cpeek :: Ptr IPv6HopLimit -> IO IPv6HopLimit
peek :: Ptr IPv6HopLimit -> IO IPv6HopLimit
$cpoke :: Ptr IPv6HopLimit -> IPv6HopLimit -> IO ()
poke :: Ptr IPv6HopLimit -> IPv6HopLimit -> IO ()
Storable)

instance ControlMessage IPv6HopLimit where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdIPv6HopLimit
    encodeCmsg :: IPv6HopLimit -> Cmsg
encodeCmsg = IPv6HopLimit -> Cmsg
forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg
    decodeCmsg :: Cmsg -> Maybe IPv6HopLimit
decodeCmsg = Cmsg -> Maybe IPv6HopLimit
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg

----------------------------------------------------------------

-- | TOS of IPv4.
newtype IPv4TOS = IPv4TOS CChar deriving (IPv4TOS -> IPv4TOS -> Bool
(IPv4TOS -> IPv4TOS -> Bool)
-> (IPv4TOS -> IPv4TOS -> Bool) -> Eq IPv4TOS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv4TOS -> IPv4TOS -> Bool
== :: IPv4TOS -> IPv4TOS -> Bool
$c/= :: IPv4TOS -> IPv4TOS -> Bool
/= :: IPv4TOS -> IPv4TOS -> Bool
Eq, Int -> IPv4TOS -> ShowS
[IPv4TOS] -> ShowS
IPv4TOS -> String
(Int -> IPv4TOS -> ShowS)
-> (IPv4TOS -> String) -> ([IPv4TOS] -> ShowS) -> Show IPv4TOS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IPv4TOS -> ShowS
showsPrec :: Int -> IPv4TOS -> ShowS
$cshow :: IPv4TOS -> String
show :: IPv4TOS -> String
$cshowList :: [IPv4TOS] -> ShowS
showList :: [IPv4TOS] -> ShowS
Show, Ptr IPv4TOS -> IO IPv4TOS
Ptr IPv4TOS -> Int -> IO IPv4TOS
Ptr IPv4TOS -> Int -> IPv4TOS -> IO ()
Ptr IPv4TOS -> IPv4TOS -> IO ()
IPv4TOS -> Int
(IPv4TOS -> Int)
-> (IPv4TOS -> Int)
-> (Ptr IPv4TOS -> Int -> IO IPv4TOS)
-> (Ptr IPv4TOS -> Int -> IPv4TOS -> IO ())
-> (forall b. Ptr b -> Int -> IO IPv4TOS)
-> (forall b. Ptr b -> Int -> IPv4TOS -> IO ())
-> (Ptr IPv4TOS -> IO IPv4TOS)
-> (Ptr IPv4TOS -> IPv4TOS -> IO ())
-> Storable IPv4TOS
forall b. Ptr b -> Int -> IO IPv4TOS
forall b. Ptr b -> Int -> IPv4TOS -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: IPv4TOS -> Int
sizeOf :: IPv4TOS -> Int
$calignment :: IPv4TOS -> Int
alignment :: IPv4TOS -> Int
$cpeekElemOff :: Ptr IPv4TOS -> Int -> IO IPv4TOS
peekElemOff :: Ptr IPv4TOS -> Int -> IO IPv4TOS
$cpokeElemOff :: Ptr IPv4TOS -> Int -> IPv4TOS -> IO ()
pokeElemOff :: Ptr IPv4TOS -> Int -> IPv4TOS -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO IPv4TOS
peekByteOff :: forall b. Ptr b -> Int -> IO IPv4TOS
$cpokeByteOff :: forall b. Ptr b -> Int -> IPv4TOS -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> IPv4TOS -> IO ()
$cpeek :: Ptr IPv4TOS -> IO IPv4TOS
peek :: Ptr IPv4TOS -> IO IPv4TOS
$cpoke :: Ptr IPv4TOS -> IPv4TOS -> IO ()
poke :: Ptr IPv4TOS -> IPv4TOS -> IO ()
Storable)

instance ControlMessage IPv4TOS where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdIPv4TOS
    encodeCmsg :: IPv4TOS -> Cmsg
encodeCmsg = IPv4TOS -> Cmsg
forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg
    decodeCmsg :: Cmsg -> Maybe IPv4TOS
decodeCmsg = Cmsg -> Maybe IPv4TOS
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg

----------------------------------------------------------------

-- | Traffic class of IPv6.
newtype IPv6TClass = IPv6TClass CInt deriving (IPv6TClass -> IPv6TClass -> Bool
(IPv6TClass -> IPv6TClass -> Bool)
-> (IPv6TClass -> IPv6TClass -> Bool) -> Eq IPv6TClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv6TClass -> IPv6TClass -> Bool
== :: IPv6TClass -> IPv6TClass -> Bool
$c/= :: IPv6TClass -> IPv6TClass -> Bool
/= :: IPv6TClass -> IPv6TClass -> Bool
Eq, Int -> IPv6TClass -> ShowS
[IPv6TClass] -> ShowS
IPv6TClass -> String
(Int -> IPv6TClass -> ShowS)
-> (IPv6TClass -> String)
-> ([IPv6TClass] -> ShowS)
-> Show IPv6TClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IPv6TClass -> ShowS
showsPrec :: Int -> IPv6TClass -> ShowS
$cshow :: IPv6TClass -> String
show :: IPv6TClass -> String
$cshowList :: [IPv6TClass] -> ShowS
showList :: [IPv6TClass] -> ShowS
Show, Ptr IPv6TClass -> IO IPv6TClass
Ptr IPv6TClass -> Int -> IO IPv6TClass
Ptr IPv6TClass -> Int -> IPv6TClass -> IO ()
Ptr IPv6TClass -> IPv6TClass -> IO ()
IPv6TClass -> Int
(IPv6TClass -> Int)
-> (IPv6TClass -> Int)
-> (Ptr IPv6TClass -> Int -> IO IPv6TClass)
-> (Ptr IPv6TClass -> Int -> IPv6TClass -> IO ())
-> (forall b. Ptr b -> Int -> IO IPv6TClass)
-> (forall b. Ptr b -> Int -> IPv6TClass -> IO ())
-> (Ptr IPv6TClass -> IO IPv6TClass)
-> (Ptr IPv6TClass -> IPv6TClass -> IO ())
-> Storable IPv6TClass
forall b. Ptr b -> Int -> IO IPv6TClass
forall b. Ptr b -> Int -> IPv6TClass -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
$csizeOf :: IPv6TClass -> Int
sizeOf :: IPv6TClass -> Int
$calignment :: IPv6TClass -> Int
alignment :: IPv6TClass -> Int
$cpeekElemOff :: Ptr IPv6TClass -> Int -> IO IPv6TClass
peekElemOff :: Ptr IPv6TClass -> Int -> IO IPv6TClass
$cpokeElemOff :: Ptr IPv6TClass -> Int -> IPv6TClass -> IO ()
pokeElemOff :: Ptr IPv6TClass -> Int -> IPv6TClass -> IO ()
$cpeekByteOff :: forall b. Ptr b -> Int -> IO IPv6TClass
peekByteOff :: forall b. Ptr b -> Int -> IO IPv6TClass
$cpokeByteOff :: forall b. Ptr b -> Int -> IPv6TClass -> IO ()
pokeByteOff :: forall b. Ptr b -> Int -> IPv6TClass -> IO ()
$cpeek :: Ptr IPv6TClass -> IO IPv6TClass
peek :: Ptr IPv6TClass -> IO IPv6TClass
$cpoke :: Ptr IPv6TClass -> IPv6TClass -> IO ()
poke :: Ptr IPv6TClass -> IPv6TClass -> IO ()
Storable)

instance ControlMessage IPv6TClass where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdIPv6TClass
    encodeCmsg :: IPv6TClass -> Cmsg
encodeCmsg = IPv6TClass -> Cmsg
forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg
    decodeCmsg :: Cmsg -> Maybe IPv6TClass
decodeCmsg = Cmsg -> Maybe IPv6TClass
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg

----------------------------------------------------------------

-- | Network interface ID and local IPv4 address.
data IPv4PktInfo = IPv4PktInfo Int HostAddress HostAddress deriving (IPv4PktInfo -> IPv4PktInfo -> Bool
(IPv4PktInfo -> IPv4PktInfo -> Bool)
-> (IPv4PktInfo -> IPv4PktInfo -> Bool) -> Eq IPv4PktInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv4PktInfo -> IPv4PktInfo -> Bool
== :: IPv4PktInfo -> IPv4PktInfo -> Bool
$c/= :: IPv4PktInfo -> IPv4PktInfo -> Bool
/= :: IPv4PktInfo -> IPv4PktInfo -> Bool
Eq)

instance Show IPv4PktInfo where
    show :: IPv4PktInfo -> String
show (IPv4PktInfo Int
n HostAddress
sa HostAddress
ha) = String
"IPv4PktInfo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word8, Word8, Word8, Word8) -> String
forall a. Show a => a -> String
show (HostAddress -> (Word8, Word8, Word8, Word8)
hostAddressToTuple HostAddress
sa) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word8, Word8, Word8, Word8) -> String
forall a. Show a => a -> String
show (HostAddress -> (Word8, Word8, Word8, Word8)
hostAddressToTuple HostAddress
ha)

instance ControlMessage IPv4PktInfo where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdIPv4PktInfo
    encodeCmsg :: IPv4PktInfo -> Cmsg
encodeCmsg = IPv4PktInfo -> Cmsg
forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg
    decodeCmsg :: Cmsg -> Maybe IPv4PktInfo
decodeCmsg = Cmsg -> Maybe IPv4PktInfo
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg

instance Storable IPv4PktInfo where

{-# LINE 194 "Network/Socket/Posix/Cmsg.hsc" #-}
    sizeOf    ~_ = ((12))
{-# LINE 195 "Network/Socket/Posix/Cmsg.hsc" #-}
    alignment ~_ = alignment (0 :: CInt)
    poke :: Ptr IPv4PktInfo -> IPv4PktInfo -> IO ()
poke Ptr IPv4PktInfo
p (IPv4PktInfo Int
n HostAddress
sa HostAddress
ha) = do
        ((\Ptr IPv4PktInfo
hsc_ptr -> Ptr IPv4PktInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IPv4PktInfo
hsc_ptr Int
0))  Ptr IPv4PktInfo
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: CInt)
{-# LINE 198 "Network/Socket/Posix/Cmsg.hsc" #-}
        ((\Ptr IPv4PktInfo
hsc_ptr -> Ptr IPv4PktInfo -> Int -> HostAddress -> IO ()
forall b. Ptr b -> Int -> HostAddress -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IPv4PktInfo
hsc_ptr Int
4)) Ptr IPv4PktInfo
p HostAddress
sa
{-# LINE 199 "Network/Socket/Posix/Cmsg.hsc" #-}
        ((\Ptr IPv4PktInfo
hsc_ptr -> Ptr IPv4PktInfo -> Int -> HostAddress -> IO ()
forall b. Ptr b -> Int -> HostAddress -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IPv4PktInfo
hsc_ptr Int
8))     Ptr IPv4PktInfo
p HostAddress
ha
{-# LINE 200 "Network/Socket/Posix/Cmsg.hsc" #-}
    peek p = do
        n  <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))  p
{-# LINE 202 "Network/Socket/Posix/Cmsg.hsc" #-}
        sa <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 203 "Network/Socket/Posix/Cmsg.hsc" #-}
        ha <- ((\hsc_ptr -> peekByteOff hsc_ptr 8))     p
{-# LINE 204 "Network/Socket/Posix/Cmsg.hsc" #-}
        return $ IPv4PktInfo n sa ha

{-# LINE 211 "Network/Socket/Posix/Cmsg.hsc" #-}

----------------------------------------------------------------

-- | Network interface ID and local IPv4 address.
data IPv6PktInfo = IPv6PktInfo Int HostAddress6 deriving (IPv6PktInfo -> IPv6PktInfo -> Bool
(IPv6PktInfo -> IPv6PktInfo -> Bool)
-> (IPv6PktInfo -> IPv6PktInfo -> Bool) -> Eq IPv6PktInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IPv6PktInfo -> IPv6PktInfo -> Bool
== :: IPv6PktInfo -> IPv6PktInfo -> Bool
$c/= :: IPv6PktInfo -> IPv6PktInfo -> Bool
/= :: IPv6PktInfo -> IPv6PktInfo -> Bool
Eq)

instance Show IPv6PktInfo where
    show :: IPv6PktInfo -> String
show (IPv6PktInfo Int
n HostAddress6
ha6) = String
"IPv6PktInfo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
-> String
forall a. Show a => a -> String
show (HostAddress6
-> (Word16, Word16, Word16, Word16, Word16, Word16, Word16, Word16)
hostAddress6ToTuple HostAddress6
ha6)

instance ControlMessage IPv6PktInfo where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdIPv6PktInfo
    encodeCmsg :: IPv6PktInfo -> Cmsg
encodeCmsg = IPv6PktInfo -> Cmsg
forall a. (ControlMessage a, Storable a) => a -> Cmsg
encodeStorableCmsg
    decodeCmsg :: Cmsg -> Maybe IPv6PktInfo
decodeCmsg = Cmsg -> Maybe IPv6PktInfo
forall a. (ControlMessage a, Storable a) => Cmsg -> Maybe a
decodeStorableCmsg

instance Storable IPv6PktInfo where

{-# LINE 227 "Network/Socket/Posix/Cmsg.hsc" #-}
    sizeOf    ~_ = ((20))
{-# LINE 228 "Network/Socket/Posix/Cmsg.hsc" #-}
    alignment ~_ = alignment (0 :: CInt)
    poke :: Ptr IPv6PktInfo -> IPv6PktInfo -> IO ()
poke Ptr IPv6PktInfo
p (IPv6PktInfo Int
n HostAddress6
ha6) = do
        ((\Ptr IPv6PktInfo
hsc_ptr -> Ptr IPv6PktInfo -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IPv6PktInfo
hsc_ptr Int
16)) Ptr IPv6PktInfo
p (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: CInt)
{-# LINE 231 "Network/Socket/Posix/Cmsg.hsc" #-}
        ((\Ptr IPv6PktInfo
hsc_ptr -> Ptr IPv6PktInfo -> Int -> In6Addr -> IO ()
forall b. Ptr b -> Int -> In6Addr -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr IPv6PktInfo
hsc_ptr Int
0))    Ptr IPv6PktInfo
p (HostAddress6 -> In6Addr
In6Addr HostAddress6
ha6)
{-# LINE 232 "Network/Socket/Posix/Cmsg.hsc" #-}
    peek p = do
        In6Addr ha6 <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))    p
{-# LINE 234 "Network/Socket/Posix/Cmsg.hsc" #-}
        n :: CInt   <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 235 "Network/Socket/Posix/Cmsg.hsc" #-}
        return $ IPv6PktInfo (fromIntegral n) ha6

{-# LINE 242 "Network/Socket/Posix/Cmsg.hsc" #-}

----------------------------------------------------------------

instance ControlMessage [Fd] where
    controlMessageId :: CmsgId
controlMessageId = CmsgId
CmsgIdFds

    encodeCmsg :: [Fd] -> Cmsg
encodeCmsg [Fd]
fds = IO Cmsg -> Cmsg
forall a. IO a -> a
unsafeDupablePerformIO (IO Cmsg -> Cmsg) -> IO Cmsg -> Cmsg
forall a b. (a -> b) -> a -> b
$ do
        ByteString
bs <- Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create Int
siz ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> do
            let p :: Ptr b
p = Ptr Word8 -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
p0
            Ptr Fd -> [Fd] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr Fd
forall {b}. Ptr b
p [Fd]
fds
        Cmsg -> IO Cmsg
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cmsg -> IO Cmsg) -> Cmsg -> IO Cmsg
forall a b. (a -> b) -> a -> b
$ CmsgId -> ByteString -> Cmsg
Cmsg CmsgId
CmsgIdFds ByteString
bs
        where
            siz :: Int
siz = Fd -> Int
forall a. Storable a => a -> Int
sizeOf (Fd
forall a. HasCallStack => a
undefined :: Fd) Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Fd] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Fd]
fds

    decodeCmsg :: Cmsg -> Maybe [Fd]
decodeCmsg (Cmsg CmsgId
cmsid (PS ForeignPtr Word8
fptr Int
off Int
len))
        | CmsgId
cmsid CmsgId -> CmsgId -> Bool
forall a. Eq a => a -> a -> Bool
/= CmsgId
CmsgIdFds = Maybe [Fd]
forall a. Maybe a
Nothing
        | Bool
otherwise          =
            IO (Maybe [Fd]) -> Maybe [Fd]
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe [Fd]) -> Maybe [Fd]) -> IO (Maybe [Fd]) -> Maybe [Fd]
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe [Fd])) -> IO (Maybe [Fd])
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (Maybe [Fd])) -> IO (Maybe [Fd]))
-> (Ptr Word8 -> IO (Maybe [Fd])) -> IO (Maybe [Fd])
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p0 -> do
                let p :: Ptr b
p = Ptr Any -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr (Ptr Word8
p0 Ptr Word8 -> Int -> Ptr Any
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off)
                    numFds :: Int
numFds = Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
sizeOfFd
                [Fd] -> Maybe [Fd]
forall a. a -> Maybe a
Just ([Fd] -> Maybe [Fd]) -> IO [Fd] -> IO (Maybe [Fd])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr Fd -> IO [Fd]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
numFds Ptr Fd
forall {b}. Ptr b
p
        where
            sizeOfFd :: Int
sizeOfFd = Fd -> Int
forall a. Storable a => a -> Int
sizeOf (Fd
forall a. HasCallStack => a
undefined :: Fd)

cmsgIdBijection :: Bijection CmsgId String
cmsgIdBijection :: Bijection CmsgId String
cmsgIdBijection =
    [ (CmsgId
UnsupportedCmsgId, String
"UnsupportedCmsgId")
    , (CmsgId
CmsgIdIPv4TTL, String
"CmsgIdIPv4TTL")
    , (CmsgId
CmsgIdIPv6HopLimit, String
"CmsgIdIPv6HopLimit")
    , (CmsgId
CmsgIdIPv4TOS, String
"CmsgIdIPv4TOS")
    , (CmsgId
CmsgIdIPv6TClass, String
"CmsgIdIPv6TClass")
    , (CmsgId
CmsgIdIPv4PktInfo, String
"CmsgIdIPv4PktInfo")
    , (CmsgId
CmsgIdIPv6PktInfo, String
"CmsgIdIPv6PktInfo")
    , (CmsgId
CmsgIdFds, String
"CmsgIdFds")
    ]

instance Show CmsgId where
    showsPrec :: Int -> CmsgId -> ShowS
showsPrec = Bijection CmsgId String
-> (Int -> CmsgId -> ShowS) -> Int -> CmsgId -> ShowS
forall a.
Eq a =>
Bijection a String -> (Int -> a -> ShowS) -> Int -> a -> ShowS
bijectiveShow Bijection CmsgId String
cmsgIdBijection Int -> CmsgId -> ShowS
def
      where
        defname :: String
defname = String
"CmsgId"
        unId :: CmsgId -> (CInt, CInt)
unId = \(CmsgId CInt
l CInt
t) -> (CInt
l,CInt
t)
        def :: Int -> CmsgId -> ShowS
def = String
-> (CmsgId -> (CInt, CInt))
-> (Int -> (CInt, CInt) -> ShowS)
-> Int
-> CmsgId
-> ShowS
forall a b.
Eq a =>
String -> (a -> b) -> (Int -> b -> ShowS) -> Int -> a -> ShowS
defShow String
defname CmsgId -> (CInt, CInt)
unId Int -> (CInt, CInt) -> ShowS
forall a b. (Show a, Show b) => Int -> (a, b) -> ShowS
showIntInt

instance Read CmsgId where
    readPrec :: ReadPrec CmsgId
readPrec = Bijection CmsgId String -> ReadPrec CmsgId -> ReadPrec CmsgId
forall a. Eq a => Bijection a String -> ReadPrec a -> ReadPrec a
bijectiveRead Bijection CmsgId String
cmsgIdBijection ReadPrec CmsgId
def
      where
        defname :: String
defname = String
"CmsgId"
        def :: ReadPrec CmsgId
def = String
-> ((CInt, CInt) -> CmsgId)
-> ReadPrec (CInt, CInt)
-> ReadPrec CmsgId
forall a b. Eq a => String -> (b -> a) -> ReadPrec b -> ReadPrec a
defRead String
defname ((CInt -> CInt -> CmsgId) -> (CInt, CInt) -> CmsgId
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CInt -> CInt -> CmsgId
CmsgId) ReadPrec (CInt, CInt)
forall a b.
(Bounded a, Integral a, Bounded b, Integral b) =>
ReadPrec (a, b)
readIntInt