{-# LINE 1 "src/System/Linux/RTNetlink/Link.hsc" #-}
{-|
{-# LINE 2 "src/System/Linux/RTNetlink/Link.hsc" #-}
Module      : System.Linux.RTNetlink.Link
Description : ADTs for creating, destroying, modifying, and getting info
              about links.
Copyright   : (c) Formaltech Inc. 2017
License     : BSD3
Maintainer  : protob3n@gmail.com
Stability   : experimental
Portability : Linux
-}
{-# 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" #-}

-- | A link identified by its index.
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

-- | A link identified by its name.
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

-- | An ethernet address.
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

-- | Link wildcard.
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

-- | A dummy interface.
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" #-}

-- | A bridge interface.
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" #-}

-- | The state of a link.
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" #-}

-- | The header corresponding to link messages, based on 'struct ifinfomsg'
-- from 'linux/if_link.h'.
data IfInfoMsg = IfInfoMsg
    { ifIndex  :: Int32  -- ^ The index of the link.
    , ifFlags  :: Word32 -- ^ Operational flags of the link.
    , ifChange :: Word32 -- ^ Change mask for link flags.
    } 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