{-|
Module      : System.Linux.Netlink.GeNetlink
Description : The base module for genetlink implementations
Maintainer  : ongy
Stability   : testing
Portability : Linux

GeNetlink is used as multiplexer since netlink only supports 32 families.

This module provides the basic datatypes used by genetlink.
-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module System.Linux.Netlink.GeNetlink
where

import Data.List (intersperse)
import Data.Serialize.Get
import Data.Serialize.Put
import Data.Word (Word8)

-- Hide makeSocket since we will defien our own
import System.Linux.Netlink hiding (makeSocket)

{- |The static data used by genetlink

For more information about genetlink look into /usr/include/linux/genetlink.h
-}
data GenlHeader = GenlHeader
    {
      GenlHeader -> Word8
genlCmd     :: Word8
    , GenlHeader -> Word8
genlVersion :: Word8
    } deriving (GenlHeader -> GenlHeader -> Bool
(GenlHeader -> GenlHeader -> Bool)
-> (GenlHeader -> GenlHeader -> Bool) -> Eq GenlHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenlHeader -> GenlHeader -> Bool
$c/= :: GenlHeader -> GenlHeader -> Bool
== :: GenlHeader -> GenlHeader -> Bool
$c== :: GenlHeader -> GenlHeader -> Bool
Eq)

-- |The 'Convertable' instance for 'GenlHeader'
instance Convertable GenlHeader where
  getPut :: GenlHeader -> Put
getPut = GenlHeader -> Put
putGeHeader
  getGet :: MessageType -> Get GenlHeader
getGet MessageType
_ = Get GenlHeader
getGenlHeader

{- |A wrapper around 'GenlHeader'

This may be used by actual implementations to handle additional static data
placed after the genl header by the protocol they implement.
-}
data GenlData a = GenlData 
    {
      GenlData a -> GenlHeader
genlDataHeader :: GenlHeader
    , GenlData a -> a
genlDataData   :: a
    } deriving (GenlData a -> GenlData a -> Bool
(GenlData a -> GenlData a -> Bool)
-> (GenlData a -> GenlData a -> Bool) -> Eq (GenlData a)
forall a. Eq a => GenlData a -> GenlData a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenlData a -> GenlData a -> Bool
$c/= :: forall a. Eq a => GenlData a -> GenlData a -> Bool
== :: GenlData a -> GenlData a -> Bool
$c== :: forall a. Eq a => GenlData a -> GenlData a -> Bool
Eq)

-- |The 'Convertable' instance for 'GenlData'
instance Convertable a => Convertable (GenlData a) where
  getPut :: GenlData a -> Put
getPut (GenlData GenlHeader
h a
a) = GenlHeader -> Put
putGeHeader GenlHeader
h Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall a. Convertable a => a -> Put
getPut a
a
  getGet :: MessageType -> Get (GenlData a)
getGet MessageType
t = do
    GenlHeader
hdr <- Get GenlHeader
getGenlHeader
    a
dat <- MessageType -> Get a
forall a. Convertable a => MessageType -> Get a
getGet MessageType
t
    GenlData a -> Get (GenlData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenlData a -> Get (GenlData a)) -> GenlData a -> Get (GenlData a)
forall a b. (a -> b) -> a -> b
$GenlHeader -> a -> GenlData a
forall a. GenlHeader -> a -> GenlData a
GenlData GenlHeader
hdr a
dat

-- |Type declaration for genetlink packets
type GenlPacket a = Packet (GenlData a)

-- |Show isntance of GenlHeader
instance Show GenlHeader where
  show :: GenlHeader -> String
show (GenlHeader Word8
cmd Word8
ver) =
    String
"Header: Cmd = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", Version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
ver String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- |Show instance of GenlData
instance {-# OVERLAPPABLE #-} Show a => Show (GenlData a) where
  show :: GenlData a -> String
show (GenlData GenlHeader
hdr a
content) =
    GenlHeader -> String
forall a. Show a => a -> String
show GenlHeader
hdr String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
content

-- |Show instance of GenlData for NoData
instance Show (GenlData NoData) where
  show :: GenlData NoData -> String
show (GenlData GenlHeader
hdr NoData
_) =
    GenlHeader -> String
forall a. Show a => a -> String
show GenlHeader
hdr

-- |Show Instance for GenlPacket
instance {-# OVERLAPPABLE #-} Show a => Show (GenlPacket a) where
  showList :: [GenlPacket a] -> ShowS
showList [GenlPacket a]
xs = (([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([GenlPacket a] -> [String]) -> [GenlPacket a] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
"===\n" ([String] -> [String])
-> ([GenlPacket a] -> [String]) -> [GenlPacket a] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenlPacket a -> String) -> [GenlPacket a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map GenlPacket a -> String
forall a. Show a => a -> String
show ([GenlPacket a] -> String) -> [GenlPacket a] -> String
forall a b. (a -> b) -> a -> b
$[GenlPacket a]
xs) String -> ShowS
forall a. [a] -> [a] -> [a]
++)
  show :: GenlPacket a -> String
show (Packet Header
_ GenlData a
cus Attributes
attrs) =
    String
"GenlPacket: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ GenlData a -> String
forall a. Show a => a -> String
show GenlData a
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]
++ Attributes -> String
showNLAttrs Attributes
attrs
  show GenlPacket a
p = GenlPacket a -> String
forall a. Show a => Packet a -> String
showPacket GenlPacket a
p

-- |'Get' function for 'GenlHeader'
getGenlHeader :: Get GenlHeader
getGenlHeader :: Get GenlHeader
getGenlHeader = do
    Word8
cmd <- Get Word8
getWord8
    Word8
version <- Get Word8
getWord8
    Word16
_ <- Get Word16
getWord16host
    GenlHeader -> Get GenlHeader
forall (m :: * -> *) a. Monad m => a -> m a
return (GenlHeader -> Get GenlHeader) -> GenlHeader -> Get GenlHeader
forall a b. (a -> b) -> a -> b
$Word8 -> Word8 -> GenlHeader
GenlHeader Word8
cmd Word8
version

-- |'Put' function for 'GenlHeader'
putGeHeader :: GenlHeader -> Put
putGeHeader :: GenlHeader -> Put
putGeHeader GenlHeader
gehdr = do
  Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ GenlHeader -> Word8
genlCmd GenlHeader
gehdr
  Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ GenlHeader -> Word8
genlVersion GenlHeader
gehdr
  Putter Word16
putWord16host Word16
0

-- |'makeSocketGeneric' preapplied for genetlink family
makeSocket :: IO NetlinkSocket
makeSocket :: IO NetlinkSocket
makeSocket = Int -> IO NetlinkSocket
makeSocketGeneric Int
16