{-# LINE 1 "src/System/Linux/RTNetlink/Address.hsc" #-}
{-|
{-# LINE 2 "src/System/Linux/RTNetlink/Address.hsc" #-}
Module      : System.Linux.RTNetlink.Address
Description : ADTs for creating, destroying, modifying, and getting info
              about layer-3 addresses.
Copyright   : (c) Formaltech Inc. 2017
License     : BSD3
Maintainer  : protob3n@gmail.com
Stability   : experimental
Portability : Linux
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module System.Linux.RTNetlink.Address
    ( IfInetAddress(..)
    , IfInet6Address(..)
    , IfIndex(..)
    , IfPrefix(..)
    , AnyInterface(..)
    , IfAddrMsg(..)
    -- * Re-exports
    , InetAddress
    , Inet6Address
    ) where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (guard)
import Data.Monoid (mempty)
import Data.Serialize (Serialize, Get, Putter, get, put, runPut)
import Data.Serialize (getWord32host, putWord32host, getWord8)
import Data.Serialize (putWord8, getWord16be, putWord16be)
import Data.Word (Word8, Word32)
import System.Socket.Family.Inet (InetAddress, inetAddressToTuple)
import System.Socket.Family.Inet (inetAddressFromTuple)
import System.Socket.Family.Inet6 (Inet6Address, inet6AddressToTuple)
import System.Socket.Family.Inet6 (inet6AddressFromTuple)

import System.Linux.RTNetlink.Message
import System.Linux.RTNetlink.Packet


{-# LINE 45 "src/System/Linux/RTNetlink/Address.hsc" #-}

{-# LINE 46 "src/System/Linux/RTNetlink/Address.hsc" #-}

{-# LINE 47 "src/System/Linux/RTNetlink/Address.hsc" #-}

-- | Construct a network-byte-order representation of an 'InetAddress'.
putInetAddress :: Putter InetAddress
putInetAddress i = putWord8 a >> putWord8 b >> putWord8 c >> putWord8 d
    where (a,b,c,d) = inetAddressToTuple i

-- | Parse a network-byte-order representation of an 'InetAddress'.
getInetAddress :: Get InetAddress
getInetAddress = inetAddressFromTuple <$> getTuple
    where getTuple = (,,,) <$> getWord8 <*> getWord8 <*> getWord8 <*> getWord8

instance Message InetAddress where
    type MessageHeader InetAddress = IfAddrMsg
    messageAttrs address = AttributeList
        [ Attribute 2 ipv4
{-# LINE 62 "src/System/Linux/RTNetlink/Address.hsc" #-}
        , Attribute 1 ipv4
{-# LINE 63 "src/System/Linux/RTNetlink/Address.hsc" #-}
        ] where ipv4 = runPut $ putInetAddress address
instance Reply InetAddress where
    type ReplyHeader InetAddress = IfAddrMsg
    replyTypeNumbers _           = [20]
{-# LINE 67 "src/System/Linux/RTNetlink/Address.hsc" #-}
    fromNLMessage NLMessage {..} = do
        let IfAddrMsg {..} = nlmHeader
        guard $ addrFamily == 2
{-# LINE 70 "src/System/Linux/RTNetlink/Address.hsc" #-}
        attr <- findAttribute [1] nlmAttrs
{-# LINE 71 "src/System/Linux/RTNetlink/Address.hsc" #-}
        bs   <- attributeData attr
        runGetMaybe getInetAddress bs

-- | Construct a network-byte-order representation of an 'InetAddress'.
putInet6Address :: Putter Inet6Address
putInet6Address i = mapM_ putWord16be [a,b,c,d,e,f,g,h]
    where (a,b,c,d,e,f,g,h) = inet6AddressToTuple i

-- | Parse a network-byte-order representation of an 'Inet6Address'.
getInet6Address :: Get Inet6Address
getInet6Address = inet6AddressFromTuple <$> getTuple
    where
    getTuple = (,,,,,,,)
        <$> getWord16be
        <*> getWord16be
        <*> getWord16be
        <*> getWord16be
        <*> getWord16be
        <*> getWord16be
        <*> getWord16be
        <*> getWord16be

instance Message Inet6Address where
    type MessageHeader Inet6Address = IfAddrMsg
    messageAttrs address = AttributeList
        [ Attribute 2 ipv6
{-# LINE 97 "src/System/Linux/RTNetlink/Address.hsc" #-}
        , Attribute 1 ipv6
{-# LINE 98 "src/System/Linux/RTNetlink/Address.hsc" #-}
        ] where ipv6 = runPut $ putInet6Address address
instance Reply Inet6Address where
    type ReplyHeader Inet6Address = IfAddrMsg
    replyTypeNumbers _           = [20]
{-# LINE 102 "src/System/Linux/RTNetlink/Address.hsc" #-}
    fromNLMessage NLMessage {..} = do
        let IfAddrMsg {..} = nlmHeader
        guard $ addrFamily == 10
{-# LINE 105 "src/System/Linux/RTNetlink/Address.hsc" #-}
        attr <- findAttribute [1] nlmAttrs
{-# LINE 106 "src/System/Linux/RTNetlink/Address.hsc" #-}
        bs   <- attributeData attr
        runGetMaybe getInet6Address bs

-- | Interface wildcard. Use this to get information about all layer-3
-- interfaces.
data AnyInterface = AnyInterface
    deriving (Show, Eq)
instance Message AnyInterface where
    type MessageHeader AnyInterface = IfAddrMsg
    messageAttrs       AnyInterface = mempty
instance Request AnyInterface where
    requestTypeNumber = const 22
{-# LINE 118 "src/System/Linux/RTNetlink/Address.hsc" #-}
    requestNLFlags    = const dumpNLFlags

-- | The index of a layer-3 interface.
newtype IfIndex = IfIndex {ifIndex :: Int}
    deriving (Show, Eq, Num, Ord)
instance Message IfIndex where
    type MessageHeader IfIndex = IfAddrMsg
    messageHeader (IfIndex ix) = IfAddrMsg 0 0 0 0 (fromIntegral ix)
instance Reply IfIndex where
    type ReplyHeader IfIndex = IfAddrMsg
    replyTypeNumbers _       = [20]
{-# LINE 129 "src/System/Linux/RTNetlink/Address.hsc" #-}
    fromNLMessage            = Just . IfIndex . fromIntegral . addrIndex . nlmHeader

-- | A netmask in CIDR notation.
newtype IfPrefix = IfPrefix {ifPrefix :: Word8}
    deriving (Show, Eq, Num, Ord)
instance Message IfPrefix where
    type MessageHeader IfPrefix = IfAddrMsg
    messageHeader (IfPrefix p)  = IfAddrMsg 0 p 0 0 0
instance Reply IfPrefix where
    type ReplyHeader IfPrefix = IfAddrMsg
    replyTypeNumbers _        = [20]
{-# LINE 140 "src/System/Linux/RTNetlink/Address.hsc" #-}
    fromNLMessage             = Just . IfPrefix . addrPrefix . nlmHeader

-- | An ipv4 address and netmask associated with an interface.
data IfInetAddress = IfInetAddress
    { ifInetAddress :: InetAddress -- ^ The ip4v address itself.
    , ifInetPrefix  :: IfPrefix    -- ^ The netmask in CIDR notation.
    , ifInetIfIndex :: IfIndex     -- ^ Index of the associated interface.
    } deriving (Show, Eq)
instance Message IfInetAddress where
    type MessageHeader IfInetAddress = IfAddrMsg
    messageAttrs  IfInetAddress {..} = messageAttrs ifInetAddress
    messageHeader IfInetAddress {..} = IfAddrMsg
        { addrFamily = 2
{-# LINE 153 "src/System/Linux/RTNetlink/Address.hsc" #-}
        , addrPrefix = ifPrefix ifInetPrefix
        , addrFlags  = 0
        , addrScope  = 0
        , addrIndex  = fromIntegral $ ifIndex ifInetIfIndex
        }
instance Create IfInetAddress where
    createTypeNumber = const 20
{-# LINE 160 "src/System/Linux/RTNetlink/Address.hsc" #-}
instance Destroy IfInetAddress where
    destroyTypeNumber = const 21
{-# LINE 162 "src/System/Linux/RTNetlink/Address.hsc" #-}
instance Reply IfInetAddress where
    type ReplyHeader IfInetAddress = IfAddrMsg
    replyTypeNumbers _             = [20]
{-# LINE 165 "src/System/Linux/RTNetlink/Address.hsc" #-}
    fromNLMessage    m             =
        IfInetAddress <$> fromNLMessage m <*> fromNLMessage m <*> fromNLMessage m

-- | An ipv6 address and netmask associated with an interface.
data IfInet6Address = IfInet6Address
    { ifInet6Address :: Inet6Address -- ^ The ip4v address itself.
    , ifInet6Prefix  :: IfPrefix     -- ^ The netmask in CIDR notation.
    , ifInet6IfIndex :: IfIndex      -- ^ Index of the associated interface.
    } deriving (Show, Eq)
instance Message IfInet6Address where
    type MessageHeader IfInet6Address = IfAddrMsg
    messageAttrs  IfInet6Address {..} = messageAttrs ifInet6Address
    messageHeader IfInet6Address {..} = IfAddrMsg
        { addrFamily = 10
{-# LINE 179 "src/System/Linux/RTNetlink/Address.hsc" #-}
        , addrPrefix = ifPrefix ifInet6Prefix
        , addrFlags  = 0
        , addrScope  = 0
        , addrIndex  = fromIntegral $ ifIndex ifInet6IfIndex
        }
instance Create IfInet6Address where
    createTypeNumber = const 20
{-# LINE 186 "src/System/Linux/RTNetlink/Address.hsc" #-}
instance Destroy IfInet6Address where
    destroyTypeNumber = const 21
{-# LINE 188 "src/System/Linux/RTNetlink/Address.hsc" #-}
instance Reply IfInet6Address where
    type ReplyHeader IfInet6Address = IfAddrMsg
    replyTypeNumbers _             = [20]
{-# LINE 191 "src/System/Linux/RTNetlink/Address.hsc" #-}
    fromNLMessage    m             =
        IfInet6Address <$> fromNLMessage m <*> fromNLMessage m <*> fromNLMessage m

-- | The header corresponding to address messages, based on 'struct ifaddrmsg'
-- from 'linux/if_addr.h'.
data IfAddrMsg = IfAddrMsg
    { addrFamily :: Word8  -- ^ Address family (AF_* from @sys/socket.h@)
    , addrPrefix :: Word8  -- ^ CIDR netmask for this address.
    , addrFlags  :: Word8  -- ^ Operational flags for this address.
    , addrScope  :: Word8  -- ^ Address scope.
    , addrIndex  :: Word32 -- ^ Index of the associated interface.
    } deriving (Show, Eq)
instance Sized IfAddrMsg where
    size = const 8
{-# LINE 205 "src/System/Linux/RTNetlink/Address.hsc" #-}
instance Serialize IfAddrMsg where
    put IfAddrMsg {..} = do
        putWord8      addrFamily
        putWord8      addrPrefix
        putWord8      addrFlags
        putWord8      addrScope
        putWord32host addrIndex
    get = IfAddrMsg
        <$> getWord8
        <*> getWord8
        <*> getWord8
        <*> getWord8
        <*> getWord32host
instance Header IfAddrMsg where
    emptyHeader = IfAddrMsg 0 0 0 0 0