{-# LINE 1 "src/System/Linux/RTNetlink/Link.hsc" #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module System.Linux.RTNetlink.Link where
import Control.Applicative ((<$>), (<*>))
import Data.Bits ((.&.))
import Data.Int (Int32)
import Data.Monoid ((<>))
import Data.Serialize
import Data.Word (Word8, Word32)
import qualified Data.ByteString as S
import System.Linux.RTNetlink.Packet
import System.Linux.RTNetlink.Message
{-# LINE 32 "src/System/Linux/RTNetlink/Link.hsc" #-}
{-# LINE 33 "src/System/Linux/RTNetlink/Link.hsc" #-}
{-# LINE 34 "src/System/Linux/RTNetlink/Link.hsc" #-}
newtype LinkIndex = LinkIndex Int
deriving (Show, Eq, Num, Ord)
instance Message LinkIndex where
type MessageHeader LinkIndex = IfInfoMsg
messageHeader (LinkIndex ix) = IfInfoMsg (fromIntegral ix) 0 0
instance Destroy LinkIndex where
destroyTypeNumber = const 17
{-# LINE 43 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Request LinkIndex where
requestTypeNumber = const 18
{-# LINE 45 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Reply LinkIndex where
type ReplyHeader LinkIndex = IfInfoMsg
replyTypeNumbers = const [16]
{-# LINE 48 "src/System/Linux/RTNetlink/Link.hsc" #-}
fromNLMessage = Just . LinkIndex . fromIntegral . ifIndex . nlmHeader
newtype LinkName = LinkName S.ByteString
deriving (Show, Eq)
instance Message LinkName where
type MessageHeader LinkName = IfInfoMsg
messageAttrs (LinkName bs) = AttributeList
[cStringAttr 3 $ S.take 16 bs]
{-# LINE 57 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Destroy LinkName where
destroyTypeNumber = const 17
{-# LINE 59 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Request LinkName where
requestTypeNumber = const 18
{-# LINE 61 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Reply LinkName where
type ReplyHeader LinkName = IfInfoMsg
replyTypeNumbers = const [16]
{-# LINE 64 "src/System/Linux/RTNetlink/Link.hsc" #-}
fromNLMessage m = do
a <- findAttribute [3] . nlmAttrs $ m
{-# LINE 66 "src/System/Linux/RTNetlink/Link.hsc" #-}
n <- S.takeWhile (/=0) <$> attributeData a
return $ LinkName n
data LinkEther = LinkEther Word8 Word8 Word8 Word8 Word8 Word8
deriving Eq
instance Show LinkEther where
show (LinkEther a b c d e f) = hex a <:> hex b <:> hex c <:> hex d <:> hex e <:> hex f
where
hex w = hexdig (w `div` 0x10) : hexdig (w `rem` 0x10) : []
hexdig = (!!) "0123456789abcdef" . fromIntegral
s <:> t = s ++ ":" ++ t :: String
instance Serialize LinkEther where
put (LinkEther a b c d e f) = put a >> put b >> put c >> put d >> put e >> put f
get = LinkEther <$> get <*> get <*> get <*> get <*> get <*> get
instance Message LinkEther where
type MessageHeader LinkEther = IfInfoMsg
messageAttrs e = AttributeList [Attribute 1 $ encode e]
{-# LINE 84 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Reply LinkEther where
type ReplyHeader LinkEther = IfInfoMsg
replyTypeNumbers = const [16]
{-# LINE 87 "src/System/Linux/RTNetlink/Link.hsc" #-}
fromNLMessage m = do
a <- findAttribute [1] . nlmAttrs $ m
{-# LINE 89 "src/System/Linux/RTNetlink/Link.hsc" #-}
d <- attributeData a
decodeMaybe d
data AnyLink = AnyLink
deriving (Show, Eq)
instance Message AnyLink where
type MessageHeader AnyLink = IfInfoMsg
instance Request AnyLink where
requestTypeNumber = const 18
{-# LINE 99 "src/System/Linux/RTNetlink/Link.hsc" #-}
requestNLFlags = const dumpNLFlags
newtype Dummy = Dummy LinkName
deriving (Show, Eq)
instance Message Dummy where
type MessageHeader Dummy = IfInfoMsg
messageHeader (Dummy name) = messageHeader name
messageAttrs (Dummy name) = messageAttrs name <> AttributeList
[ AttributeNest 18
{-# LINE 109 "src/System/Linux/RTNetlink/Link.hsc" #-}
[ cStringAttr 1 "dummy" ]
{-# LINE 110 "src/System/Linux/RTNetlink/Link.hsc" #-}
]
instance Create Dummy where
createTypeNumber = const 16
{-# LINE 113 "src/System/Linux/RTNetlink/Link.hsc" #-}
newtype Bridge = Bridge LinkName
deriving (Show, Eq)
instance Message Bridge where
type MessageHeader Bridge = IfInfoMsg
messageAttrs (Bridge name) = messageAttrs name <> AttributeList
[ AttributeNest 18
{-# LINE 121 "src/System/Linux/RTNetlink/Link.hsc" #-}
[ cStringAttr 1 "bridge" ]
{-# LINE 122 "src/System/Linux/RTNetlink/Link.hsc" #-}
]
instance Create Bridge where
createTypeNumber = const 16
{-# LINE 125 "src/System/Linux/RTNetlink/Link.hsc" #-}
data LinkState = Up | Down
deriving (Show, Eq)
instance Reply LinkState where
type ReplyHeader LinkState = IfInfoMsg
replyTypeNumbers = const [16]
{-# LINE 132 "src/System/Linux/RTNetlink/Link.hsc" #-}
fromNLMessage m = Just $ if flag == 0 then Down else Up
where flag = ifFlags (nlmHeader m) .&. 1
{-# LINE 134 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Change LinkName LinkState where
changeTypeNumber _ _ = 19
{-# LINE 136 "src/System/Linux/RTNetlink/Link.hsc" #-}
changeAttrs n _ = messageAttrs n
changeHeader n s = IfInfoMsg ix flag 1
{-# LINE 138 "src/System/Linux/RTNetlink/Link.hsc" #-}
where
ix = ifIndex $ messageHeader n
flag = if s == Up then 1 else 0
{-# LINE 141 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Change LinkIndex LinkState where
changeTypeNumber _ _ = 19
{-# LINE 143 "src/System/Linux/RTNetlink/Link.hsc" #-}
changeAttrs n _ = messageAttrs n
changeHeader n s = IfInfoMsg ix flag 1
{-# LINE 145 "src/System/Linux/RTNetlink/Link.hsc" #-}
where
ix = ifIndex $ messageHeader n
flag = if s == Up then 1 else 0
{-# LINE 148 "src/System/Linux/RTNetlink/Link.hsc" #-}
data IfInfoMsg = IfInfoMsg
{ ifIndex :: Int32
, ifFlags :: Word32
, ifChange :: Word32
} deriving (Show, Eq)
instance Sized IfInfoMsg where
size = const 16
{-# LINE 158 "src/System/Linux/RTNetlink/Link.hsc" #-}
instance Serialize IfInfoMsg where
put IfInfoMsg {..} = do
putWord8 0
{-# LINE 161 "src/System/Linux/RTNetlink/Link.hsc" #-}
putWord8 0
putWord16host 0
putInt32host ifIndex
putWord32host ifFlags
putWord32host ifChange
get = do
skip 4
ifIndex <- getInt32le
ifFlags <- getWord32host
ifChange <- getWord32host
return $ IfInfoMsg {..}
instance Header IfInfoMsg where
emptyHeader = IfInfoMsg 0 0 0