{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module System.Linux.Netlink.Route
(
Packet
, RoutePacket
, getRoutePackets
, Message(..)
, getLinkAddress
, getLinkBroadcast
, getLinkName
, getLinkMTU
, getLinkQDisc
, getLinkTXQLen
, getIFAddr
, getLLAddr
, getDstAddr
, putLinkAddress
, putLinkBroadcast
, putLinkName
, putLinkMTU
, putLinkQDisc
, putLinkTXQLen
) where
import Prelude hiding (length, lookup, init)
#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative ((<$>), (<*>))
#endif
import qualified Data.ByteString as BS (length)
import Data.ByteString.Char8 (ByteString, append, init, pack, unpack)
import Data.Char (chr, ord)
import Data.List (intersperse)
import Data.Map (insert, lookup, toList)
import Data.Serialize.Get
import Data.Serialize.Put
import Data.Word (Word8, Word16, Word32)
import Data.Int (Int32)
import System.Linux.Netlink.Constants
import System.Linux.Netlink
import System.Linux.Netlink.Helpers
import System.Linux.Netlink.Route.LinkStat
data Message = NLinkMsg
{
Message -> LinkType
interfaceType :: LinkType
, Message -> Word32
interfaceIndex :: Word32
, Message -> Word32
interfaceFlags :: Word32
}
| NAddrMsg
{
Message -> AddressFamily
addrFamily :: AddressFamily
, Message -> Word8
addrMaskLength :: Word8
, Message -> Word8
addrFlags :: Word8
, Message -> Word8
addrScope :: Word8
, Message -> Word32
addrInterfaceIndex :: Word32
}
| NNeighMsg
{ Message -> Word8
neighFamily :: Word8
, Message -> Int32
neighIfindex :: Int32
, Message -> Word16
neighState :: Word16
, Message -> Word8
neighFlags :: Word8
, Message -> Word8
neighType :: Word8
} deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: Message -> Message -> Bool
Eq)
instance Show Message where
show :: Message -> [Char]
show (NLinkMsg LinkType
t Word32
i Word32
f) =
[Char]
"LinkMessage. Type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ LinkType -> [Char]
forall a. (Num a, Show a, Eq a) => a -> [Char]
showLinkType LinkType
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Index: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
f
show (NAddrMsg AddressFamily
f Word8
l Word8
fl Word8
s Word32
i) =
[Char]
"AddrMessage. Family: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ AddressFamily -> [Char]
forall a. Show a => a -> [Char]
show AddressFamily
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", MLength: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
l [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
fl [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Scope: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Index: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
i
show (NNeighMsg Word8
f Int32
i Word16
s Word8
fl Word8
t) =
[Char]
"NeighMessage. Family: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
f [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Index: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> [Char]
forall a. Show a => a -> [Char]
show Int32
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", State: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
fl [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> [Char]
forall a. Show a => a -> [Char]
show Word8
t
instance Convertable Message where
getGet :: MessageType -> Get Message
getGet = MessageType -> Get Message
getMessage
getPut :: Message -> Put
getPut = Message -> Put
putMessage
type RoutePacket = Packet Message
showRouteHeader :: Header -> String
(Header MessageType
t Word16
f Word32
s Word32
p) =
[Char]
"Type: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ MessageType -> [Char]
forall a. (Num a, Show a, Eq a) => a -> [Char]
showMessageType MessageType
t [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Flags: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word16 -> [Char]
forall a. Show a => a -> [Char]
show Word16
f) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Seq: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
", Pid: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
p
instance Show RoutePacket where
showList :: [RoutePacket] -> ShowS
showList [RoutePacket]
xs = (([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([RoutePacket] -> [[Char]]) -> [RoutePacket] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
"===\n" ([[Char]] -> [[Char]])
-> ([RoutePacket] -> [[Char]]) -> [RoutePacket] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RoutePacket -> [Char]) -> [RoutePacket] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map RoutePacket -> [Char]
forall a. Show a => a -> [Char]
show ([RoutePacket] -> [Char]) -> [RoutePacket] -> [Char]
forall a b. (a -> b) -> a -> b
$[RoutePacket]
xs) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++)
show :: RoutePacket -> [Char]
show (Packet Header
hdr Message
cus Attributes
attrs) =
[Char]
"RoutePacket: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Header -> [Char]
showRouteHeader Header
hdr [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
Message -> [Char]
forall a. Show a => a -> [Char]
show Message
cus [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++
[Char]
"Attrs: \n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Int, ByteString) -> [Char]) -> [(Int, ByteString)] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MessageType -> (Int, ByteString) -> [Char]
showMsgAttr (Header -> MessageType
messageType Header
hdr)) (Attributes -> [(Int, ByteString)]
forall k a. Map k a -> [(k, a)]
toList Attributes
attrs) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
show RoutePacket
p = RoutePacket -> [Char]
forall a. Show a => Packet a -> [Char]
showPacket RoutePacket
p
showMsgAttr :: MessageType -> (Int, ByteString) -> String
showMsgAttr :: MessageType -> (Int, ByteString) -> [Char]
showMsgAttr MessageType
msgType
| MessageType
msgType MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_NEWNEIGH = (Int, ByteString) -> [Char]
showNeighAttr
| MessageType
msgType MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_DELNEIGH = (Int, ByteString) -> [Char]
showNeighAttr
| MessageType
msgType MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_GETNEIGH = (Int, ByteString) -> [Char]
showNeighAttr
| Bool
otherwise = (Int, ByteString) -> [Char]
showLinkAttr
showNeighAttr :: (Int, ByteString) -> String
showNeighAttr :: (Int, ByteString) -> [Char]
showNeighAttr = (Int -> [Char]) -> (Int, ByteString) -> [Char]
showAttr Int -> [Char]
forall a. (Num a, Show a, Eq a) => a -> [Char]
showNeighAttrType
showLinkAttr :: (Int, ByteString) -> String
showLinkAttr :: (Int, ByteString) -> [Char]
showLinkAttr (Int
i, ByteString
v)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
eIFLA_STATS64 = [Char]
"IFLA_STATS64:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
showStats64 ByteString
v
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
eIFLA_STATS = [Char]
"IFLA_STATS:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
showStats32 ByteString
v
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
eIFLA_AF_SPEC =
[Char]
"eIFLA_AF_SPEC: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
v) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
indent (ByteString -> [Char]
showAfSpec ByteString
v)
| Bool
otherwise = (Int -> [Char]) -> (Int, ByteString) -> [Char]
showAttr Int -> [Char]
forall a. (Num a, Show a, Eq a) => a -> [Char]
showLinkAttrType (Int
i, ByteString
v)
showStats64 :: ByteString -> String
showStats64 :: ByteString -> [Char]
showStats64 ByteString
bs = case Get LinkStat -> ByteString -> Either [Char] LinkStat
forall a. Get a -> ByteString -> Either [Char] a
runGet Get LinkStat
getLinkStat64 ByteString
bs of
(Left [Char]
x) -> ShowS
forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall LinkStat64: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x)
(Right LinkStat
x) -> LinkStat -> [Char]
forall a. Show a => a -> [Char]
show LinkStat
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
showStats32 :: ByteString -> String
showStats32 :: ByteString -> [Char]
showStats32 ByteString
bs = case Get LinkStat -> ByteString -> Either [Char] LinkStat
forall a. Get a -> ByteString -> Either [Char] a
runGet Get LinkStat
getLinkStat32 ByteString
bs of
(Left [Char]
x) -> ShowS
forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall LinkStat32: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x)
(Right LinkStat
x) -> LinkStat -> [Char]
forall a. Show a => a -> [Char]
show LinkStat
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
showAfSpec :: ByteString -> String
showAfSpec :: ByteString -> [Char]
showAfSpec ByteString
bs = case Get Attributes -> ByteString -> Either [Char] Attributes
forall a. Get a -> ByteString -> Either [Char] a
runGet Get Attributes
getAttributes ByteString
bs of
(Left [Char]
x) -> ShowS
forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall AfSpec: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x)
(Right Attributes
attrs) ->
((Int, ByteString) -> [Char]) -> [(Int, ByteString)] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
i, ByteString
v) -> Int -> [Char]
forall a. (Num a, Show a, Eq a) => a -> [Char]
showAddressFamily Int
i [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
indent (ByteString -> [Char]
showAfSpec' ByteString
v)) (Attributes -> [(Int, ByteString)]
forall k a. Map k a -> [(k, a)]
toList Attributes
attrs)
showAfSpec' :: ByteString -> String
showAfSpec' :: ByteString -> [Char]
showAfSpec' ByteString
bs = case Get Attributes -> ByteString -> Either [Char] Attributes
forall a. Get a -> ByteString -> Either [Char] a
runGet Get Attributes
getAttributes ByteString
bs of
(Left [Char]
x) -> ShowS
forall a. HasCallStack => [Char] -> a
error ([Char]
"Could not marshall AfSpec': " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
x)
(Right Attributes
attrs) -> Attributes -> [Char]
showNLAttrs Attributes
attrs
getMessage :: MessageType -> Get Message
getMessage :: MessageType -> Get Message
getMessage MessageType
msgtype | MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_NEWLINK = Get Message
getMessageLink
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_GETLINK = Get Message
getMessageLink
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_DELLINK = Get Message
getMessageLink
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_NEWADDR = Get Message
getMessageAddr
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_GETADDR = Get Message
getMessageAddr
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_DELADDR = Get Message
getMessageAddr
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_GETNEIGH = Get Message
getMessageNeigh
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_NEWNEIGH = Get Message
getMessageNeigh
| MessageType
msgtype MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_DELNEIGH = Get Message
getMessageNeigh
| Bool
otherwise =
[Char] -> Get Message
forall a. HasCallStack => [Char] -> a
error ([Char] -> Get Message) -> [Char] -> Get Message
forall a b. (a -> b) -> a -> b
$ [Char]
"Can't decode message " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ MessageType -> [Char]
forall a. Show a => a -> [Char]
show MessageType
msgtype
getMessageLink :: Get Message
getMessageLink :: Get Message
getMessageLink = do
Int -> Get ()
skip Int
2
ty <- Word16 -> LinkType
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> LinkType) -> Get Word16 -> Get LinkType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
g16
idx <- g32
flags <- g32
skip 4
return $ NLinkMsg ty idx flags
getMessageAddr :: Get Message
getMessageAddr :: Get Message
getMessageAddr = do
fam <- Word8 -> AddressFamily
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> AddressFamily) -> Get Word8 -> Get AddressFamily
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8
maskLen <- g8
flags <- g8
scope <- fromIntegral <$> g8
idx <- g32
return $ NAddrMsg fam maskLen flags scope idx
getMessageNeigh :: Get Message
getMessageNeigh :: Get Message
getMessageNeigh = Word8 -> Int32 -> Word16 -> Word8 -> Word8 -> Message
NNeighMsg
(Word8 -> Int32 -> Word16 -> Word8 -> Word8 -> Message)
-> Get Word8 -> Get (Int32 -> Word16 -> Word8 -> Word8 -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8
Get (Int32 -> Word16 -> Word8 -> Word8 -> Message)
-> Get Int32 -> Get (Word16 -> Word8 -> Word8 -> Message)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Get ()
skip Int
3 Get () -> Get Int32 -> Get Int32
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
g32)
Get (Word16 -> Word8 -> Word8 -> Message)
-> Get Word16 -> Get (Word8 -> Word8 -> Message)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
g16
Get (Word8 -> Word8 -> Message)
-> Get Word8 -> Get (Word8 -> Message)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8
Get (Word8 -> Message) -> Get Word8 -> Get Message
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8
putMessage :: Message -> Put
putMessage :: Message -> Put
putMessage (NLinkMsg LinkType
ty Word32
idx Word32
flags) = do
Word8 -> Put
p8 Word8
forall a. Num a => a
eAF_UNSPEC Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0
Word16 -> Put
p16 (LinkType -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral LinkType
ty)
Word32 -> Put
p32 Word32
idx
Word32 -> Put
p32 Word32
flags
Word32 -> Put
p32 Word32
0xFFFFFFFF
putMessage (NAddrMsg AddressFamily
fam Word8
maskLen Word8
flags Word8
scope Word32
idx) = do
Word8 -> Put
p8 (AddressFamily -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral AddressFamily
fam)
Word8 -> Put
p8 Word8
maskLen
Word8 -> Put
p8 Word8
flags
Word8 -> Put
p8 (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
scope)
Word32 -> Put
p32 Word32
idx
putMessage (NNeighMsg Word8
f Int32
i Word16
s Word8
fl Word8
t) = do
Word8 -> Put
p8 Word8
f
Word8 -> Put
p8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0 Put -> Put -> Put
forall a b. PutM a -> PutM b -> PutM b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0
Word32 -> Put
p32 (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i)
Word16 -> Put
p16 Word16
s
Word8 -> Put
p8 Word8
fl
Word8 -> Put
p8 Word8
t
getRoutePackets :: ByteString -> Either String [RoutePacket]
getRoutePackets :: ByteString -> Either [Char] [RoutePacket]
getRoutePackets = ByteString -> Either [Char] [RoutePacket]
forall a.
(Convertable a, Eq a, Show a) =>
ByteString -> Either [Char] [Packet a]
getPackets
type AttributeReader a = Attributes -> Maybe a
type AttributeWriter a = a -> Attributes -> Attributes
type LinkAddress = (Word8, Word8, Word8, Word8, Word8, Word8)
getLinkAddress :: AttributeReader LinkAddress
getLinkAddress :: AttributeReader LinkAddress
getLinkAddress Attributes
attrs = ByteString -> LinkAddress
decodeMAC (ByteString -> LinkAddress)
-> Maybe ByteString -> Maybe LinkAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFLA_ADDRESS Attributes
attrs
putLinkAddress :: AttributeWriter LinkAddress
putLinkAddress :: AttributeWriter LinkAddress
putLinkAddress LinkAddress
addr = Int -> ByteString -> Attributes -> Attributes
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
forall a. Num a => a
eIFLA_ADDRESS (LinkAddress -> ByteString
encodeMAC LinkAddress
addr)
getLinkBroadcast :: AttributeReader LinkAddress
getLinkBroadcast :: AttributeReader LinkAddress
getLinkBroadcast Attributes
attrs = ByteString -> LinkAddress
decodeMAC (ByteString -> LinkAddress)
-> Maybe ByteString -> Maybe LinkAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFLA_BROADCAST Attributes
attrs
putLinkBroadcast :: AttributeWriter LinkAddress
putLinkBroadcast :: AttributeWriter LinkAddress
putLinkBroadcast LinkAddress
addr = Int -> ByteString -> Attributes -> Attributes
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
forall a. Num a => a
eIFLA_BROADCAST (LinkAddress -> ByteString
encodeMAC LinkAddress
addr)
getLinkName :: AttributeReader String
getLinkName :: AttributeReader [Char]
getLinkName Attributes
attrs = ByteString -> [Char]
getString (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFLA_IFNAME Attributes
attrs
putLinkName :: AttributeWriter String
putLinkName :: AttributeWriter [Char]
putLinkName [Char]
ifname = Int -> ByteString -> Attributes -> Attributes
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
forall a. Num a => a
eIFLA_IFNAME ([Char] -> ByteString
putString [Char]
ifname)
getLinkMTU :: AttributeReader Word32
getLinkMTU :: AttributeReader Word32
getLinkMTU Attributes
attrs = ByteString -> Maybe Word32
get32 (ByteString -> Maybe Word32) -> Maybe ByteString -> Maybe Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFLA_MTU Attributes
attrs
putLinkMTU :: AttributeWriter Word32
putLinkMTU :: AttributeWriter Word32
putLinkMTU Word32
mtu = Int -> ByteString -> Attributes -> Attributes
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
forall a. Num a => a
eIFLA_MTU (Word32 -> ByteString
put32 Word32
mtu)
getLinkQDisc :: AttributeReader String
getLinkQDisc :: AttributeReader [Char]
getLinkQDisc Attributes
attrs = ByteString -> [Char]
getString (ByteString -> [Char]) -> Maybe ByteString -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFLA_QDISC Attributes
attrs
putLinkQDisc :: AttributeWriter String
putLinkQDisc :: AttributeWriter [Char]
putLinkQDisc [Char]
disc = Int -> ByteString -> Attributes -> Attributes
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
forall a. Num a => a
eIFLA_QDISC ([Char] -> ByteString
putString [Char]
disc)
getLinkTXQLen :: AttributeReader Word32
getLinkTXQLen :: AttributeReader Word32
getLinkTXQLen Attributes
attrs = ByteString -> Maybe Word32
get32 (ByteString -> Maybe Word32) -> Maybe ByteString -> Maybe Word32
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFLA_TXQLEN Attributes
attrs
putLinkTXQLen :: AttributeWriter Word32
putLinkTXQLen :: AttributeWriter Word32
putLinkTXQLen Word32
len = Int -> ByteString -> Attributes -> Attributes
forall k a. Ord k => k -> a -> Map k a -> Map k a
insert Int
forall a. Num a => a
eIFLA_TXQLEN (Word32 -> ByteString
put32 Word32
len)
getIFAddr :: AttributeReader ByteString
getIFAddr :: Attributes -> Maybe ByteString
getIFAddr = Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eIFA_ADDRESS
getLLAddr :: AttributeReader LinkAddress
getLLAddr :: AttributeReader LinkAddress
getLLAddr Attributes
attrs = ByteString -> LinkAddress
decodeMAC (ByteString -> LinkAddress)
-> Maybe ByteString -> Maybe LinkAddress
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eNDA_LLADDR Attributes
attrs
getDstAddr :: AttributeReader ByteString
getDstAddr :: Attributes -> Maybe ByteString
getDstAddr = Int -> Attributes -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
lookup Int
forall a. Num a => a
eNDA_DST
decodeMAC :: ByteString -> LinkAddress
decodeMAC :: ByteString -> LinkAddress
decodeMAC = [Word8] -> LinkAddress
forall {f}. [f] -> (f, f, f, f, f, f)
tuplify ([Word8] -> LinkAddress)
-> (ByteString -> [Word8]) -> ByteString -> LinkAddress
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> [Char] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) ([Char] -> [Word8])
-> (ByteString -> [Char]) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
unpack
where tuplify :: [f] -> (f, f, f, f, f, f)
tuplify [f
a,f
b,f
c,f
d,f
e,f
f] = (f
a,f
b,f
c,f
d,f
e,f
f)
tuplify [f]
_ = [Char] -> (f, f, f, f, f, f)
forall a. HasCallStack => [Char] -> a
error [Char]
"Bad encoded MAC"
encodeMAC :: LinkAddress -> ByteString
encodeMAC :: LinkAddress -> ByteString
encodeMAC = [Char] -> ByteString
pack ([Char] -> ByteString)
-> (LinkAddress -> [Char]) -> LinkAddress -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> [Word8] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Word8] -> [Char])
-> (LinkAddress -> [Word8]) -> LinkAddress -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LinkAddress -> [Word8]
forall {a}. (a, a, a, a, a, a) -> [a]
listify
where listify :: (a, a, a, a, a, a) -> [a]
listify (a
a,a
b,a
c,a
d,a
e,a
f) = [a
a,a
b,a
c,a
d,a
e,a
f]
getString :: ByteString -> String
getString :: ByteString -> [Char]
getString ByteString
b = ByteString -> [Char]
unpack (HasCallStack => ByteString -> ByteString
ByteString -> ByteString
init ByteString
b)
putString :: String -> ByteString
putString :: [Char] -> ByteString
putString [Char]
s = ByteString -> ByteString -> ByteString
append ([Char] -> ByteString
pack [Char]
s) ByteString
"\0"
get32 :: ByteString -> Maybe Word32
get32 :: ByteString -> Maybe Word32
get32 ByteString
bs = case Get Word32 -> ByteString -> Either [Char] Word32
forall a. Get a -> ByteString -> Either [Char] a
runGet Get Word32
getWord32host ByteString
bs of
Left [Char]
_ -> Maybe Word32
forall a. Maybe a
Nothing
Right Word32
w -> Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
w
put32 :: Word32 -> ByteString
put32 :: Word32 -> ByteString
put32 Word32
w = Put -> ByteString
runPut (Word32 -> Put
putWord32host Word32
w)