{-# 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
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq)
instance Show Message where
show :: Message -> String
show (NLinkMsg LinkType
t Word32
i Word32
f) =
String
"LinkMessage. Type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LinkType -> String
forall a. (Num a, Show a, Eq a) => a -> String
showLinkType LinkType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Index: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Flags: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
f
show (NAddrMsg AddressFamily
f Word8
l Word8
fl Word8
s Word32
i) =
String
"AddrMessage. Family: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ AddressFamily -> String
forall a. Show a => a -> String
show AddressFamily
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", MLength: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Flags: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Word8 -> String
forall a. Show a => a -> String
show Word8
fl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Scope: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Index: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
i
show (NNeighMsg Word8
f Int32
i Word16
s Word8
fl Word8
t) =
String
"NeighMessage. Family: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Index: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int32 -> String
forall a. Show a => a -> String
show Int32
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", State: " String -> ShowS
forall a. [a] -> [a] -> [a]
++
Word16 -> String
forall a. Show a => a -> String
show Word16
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Flags: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
fl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
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) =
String
"Type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MessageType -> String
forall a. (Num a, Show a, Eq a) => a -> String
showMessageType MessageType
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Flags: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Word16 -> String
forall a. Show a => a -> String
show Word16
f) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Seq: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Pid: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
p
instance Show RoutePacket where
showList :: [RoutePacket] -> ShowS
showList [RoutePacket]
xs = (([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([RoutePacket] -> [String]) -> [RoutePacket] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"===\n" ([String] -> [String])
-> ([RoutePacket] -> [String]) -> [RoutePacket] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RoutePacket -> String) -> [RoutePacket] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map RoutePacket -> String
forall a. Show a => a -> String
show ([RoutePacket] -> String) -> [RoutePacket] -> String
forall a b. (a -> b) -> a -> b
$[RoutePacket]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++)
show :: RoutePacket -> String
show (Packet Header
hdr Message
cus Attributes
attrs) =
String
"RoutePacket: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Header -> String
showRouteHeader Header
hdr String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
Message -> String
forall a. Show a => a -> String
show Message
cus String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++
String
"Attrs: \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ((Int, ByteString) -> String) -> [(Int, ByteString)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MessageType -> (Int, ByteString) -> String
showMsgAttr (Header -> MessageType
messageType Header
hdr)) (Attributes -> [(Int, ByteString)]
forall k a. Map k a -> [(k, a)]
toList Attributes
attrs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
show RoutePacket
p = RoutePacket -> String
forall a. Show a => Packet a -> String
showPacket RoutePacket
p
showMsgAttr :: MessageType -> (Int, ByteString) -> String
showMsgAttr :: MessageType -> (Int, ByteString) -> String
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) -> String
showNeighAttr
| MessageType
msgType MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_DELNEIGH = (Int, ByteString) -> String
showNeighAttr
| MessageType
msgType MessageType -> MessageType -> Bool
forall a. Eq a => a -> a -> Bool
== MessageType
forall a. Num a => a
eRTM_GETNEIGH = (Int, ByteString) -> String
showNeighAttr
| Bool
otherwise = (Int, ByteString) -> String
showLinkAttr
showNeighAttr :: (Int, ByteString) -> String
showNeighAttr :: (Int, ByteString) -> String
showNeighAttr = (Int -> String) -> (Int, ByteString) -> String
showAttr Int -> String
forall a. (Num a, Show a, Eq a) => a -> String
showNeighAttrType
showLinkAttr :: (Int, ByteString) -> String
showLinkAttr :: (Int, ByteString) -> String
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 = String
"IFLA_STATS64:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
showStats64 ByteString
v
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
eIFLA_STATS = String
"IFLA_STATS:\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
showStats32 ByteString
v
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Num a => a
eIFLA_AF_SPEC =
String
"eIFLA_AF_SPEC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
v) String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
indent (ByteString -> String
showAfSpec ByteString
v)
| Bool
otherwise = (Int -> String) -> (Int, ByteString) -> String
showAttr Int -> String
forall a. (Num a, Show a, Eq a) => a -> String
showLinkAttrType (Int
i, ByteString
v)
showStats64 :: ByteString -> String
showStats64 :: ByteString -> String
showStats64 ByteString
bs = case Get LinkStat -> ByteString -> Either String LinkStat
forall a. Get a -> ByteString -> Either String a
runGet Get LinkStat
getLinkStat64 ByteString
bs of
(Left String
x) -> ShowS
forall a. HasCallStack => String -> a
error (String
"Could not marshall LinkStat64: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)
(Right LinkStat
x) -> LinkStat -> String
forall a. Show a => a -> String
show LinkStat
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
showStats32 :: ByteString -> String
showStats32 :: ByteString -> String
showStats32 ByteString
bs = case Get LinkStat -> ByteString -> Either String LinkStat
forall a. Get a -> ByteString -> Either String a
runGet Get LinkStat
getLinkStat32 ByteString
bs of
(Left String
x) -> ShowS
forall a. HasCallStack => String -> a
error (String
"Could not marshall LinkStat32: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)
(Right LinkStat
x) -> LinkStat -> String
forall a. Show a => a -> String
show LinkStat
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
showAfSpec :: ByteString -> String
showAfSpec :: ByteString -> String
showAfSpec ByteString
bs = case Get Attributes -> ByteString -> Either String Attributes
forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
bs of
(Left String
x) -> ShowS
forall a. HasCallStack => String -> a
error (String
"Could not marshall AfSpec: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)
(Right Attributes
attrs) ->
((Int, ByteString) -> String) -> [(Int, ByteString)] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Int
i, ByteString
v) -> Int -> String
forall a. (Num a, Show a, Eq a) => a -> String
showAddressFamily Int
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'\n'Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
indent (ByteString -> String
showAfSpec' ByteString
v)) (Attributes -> [(Int, ByteString)]
forall k a. Map k a -> [(k, a)]
toList Attributes
attrs)
showAfSpec' :: ByteString -> String
showAfSpec' :: ByteString -> String
showAfSpec' ByteString
bs = case Get Attributes -> ByteString -> Either String Attributes
forall a. Get a -> ByteString -> Either String a
runGet Get Attributes
getAttributes ByteString
bs of
(Left String
x) -> ShowS
forall a. HasCallStack => String -> a
error (String
"Could not marshall AfSpec': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x)
(Right Attributes
attrs) -> Attributes -> String
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 =
String -> Get Message
forall a. HasCallStack => String -> a
error (String -> Get Message) -> String -> Get Message
forall a b. (a -> b) -> a -> b
$ String
"Can't decode message " String -> ShowS
forall a. [a] -> [a] -> [a]
++ MessageType -> String
forall a. Show a => a -> String
show MessageType
msgtype
getMessageLink :: Get Message
getMessageLink :: Get Message
getMessageLink = do
Int -> Get ()
skip Int
2
LinkType
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
Word32
idx <- Get Word32
g32
Word32
flags <- Get Word32
g32
Int -> Get ()
skip Int
4
Message -> Get Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Get Message) -> Message -> Get Message
forall a b. (a -> b) -> a -> b
$ LinkType -> Word32 -> Word32 -> Message
NLinkMsg LinkType
ty Word32
idx Word32
flags
getMessageAddr :: Get Message
getMessageAddr :: Get Message
getMessageAddr = do
AddressFamily
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
Word8
maskLen <- Get Word8
g8
Word8
flags <- Get Word8
g8
Word8
scope <- Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8) -> Get Word8 -> Get Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
g8
Word32
idx <- Get Word32
g32
Message -> Get Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Get Message) -> Message -> Get Message
forall a b. (a -> b) -> a -> b
$ AddressFamily -> Word8 -> Word8 -> Word8 -> Word32 -> Message
NAddrMsg AddressFamily
fam Word8
maskLen Word8
flags Word8
scope Word32
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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Get ()
skip Int
3 Get () -> Get Int32 -> Get Int32
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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
g8
Get (Word8 -> Message) -> Get Word8 -> Get Message
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 (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
p8 Word8
0 Put -> Put -> Put
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 String [RoutePacket]
getRoutePackets = ByteString -> Either String [RoutePacket]
forall a.
(Convertable a, Eq a, Show a) =>
ByteString -> Either String [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 String
getLinkName Attributes
attrs = ByteString -> String
getString (ByteString -> String) -> Maybe ByteString -> Maybe String
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 String
putLinkName String
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 (String -> ByteString
putString String
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 String
getLinkQDisc Attributes
attrs = ByteString -> String
getString (ByteString -> String) -> Maybe ByteString -> Maybe String
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 String
putLinkQDisc String
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 (String -> ByteString
putString String
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) -> String -> [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) (String -> [Word8])
-> (ByteString -> String) -> ByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
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]
_ = String -> (f, f, f, f, f, f)
forall a. HasCallStack => String -> a
error String
"Bad encoded MAC"
encodeMAC :: LinkAddress -> ByteString
encodeMAC :: LinkAddress -> ByteString
encodeMAC = String -> ByteString
pack (String -> ByteString)
-> (LinkAddress -> String) -> LinkAddress -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Char) -> [Word8] -> String
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] -> String)
-> (LinkAddress -> [Word8]) -> LinkAddress -> String
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 -> String
getString ByteString
b = ByteString -> String
unpack (ByteString -> ByteString
init ByteString
b)
putString :: String -> ByteString
putString :: String -> ByteString
putString String
s = ByteString -> ByteString -> ByteString
append (String -> ByteString
pack String
s) ByteString
"\0"
get32 :: ByteString -> Maybe Word32
get32 :: ByteString -> Maybe Word32
get32 ByteString
bs = case Get Word32 -> ByteString -> Either String Word32
forall a. Get a -> ByteString -> Either String a
runGet Get Word32
getWord32host ByteString
bs of
Left String
_ -> 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)