{-# LINE 1 "src/Network/Info.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Network.Info (
    getNetworkInterfaces,
    NetworkInterface (..),
    IPv4 (..),
    IPv6 (..),
    MAC (..),
) where

import Data.Bits ((.&.), shiftR, shiftL)
import Data.List (intersperse)
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Numeric (showHex)
import Text.Printf


----------------------------------------------------------------------
-- FFI
----------------------------------------------------------------------



foreign import ccall unsafe "c_get_network_interfaces"
        c_get_network_interfaces :: Ptr NetworkInterface -> CInt -> IO CInt


----------------------------------------------------------------------
-- Network interfaces
----------------------------------------------------------------------

-- | Describes the basic configuration of a network interface. /This/
--   /definition is currently limited to just one address per family./
data NetworkInterface = NetworkInterface
    { NetworkInterface -> String
name :: String -- ^ Interface name (e.g. \"eth0\", \"lo\", \"Local Area Connection\")
    , NetworkInterface -> IPv4
ipv4 :: IPv4   -- ^ IPv4 address
    , NetworkInterface -> IPv6
ipv6 :: IPv6   -- ^ IPv6 address
    , NetworkInterface -> MAC
mac  :: MAC    -- ^ MAC address
    } deriving (Int -> NetworkInterface -> ShowS
[NetworkInterface] -> ShowS
NetworkInterface -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NetworkInterface] -> ShowS
$cshowList :: [NetworkInterface] -> ShowS
show :: NetworkInterface -> String
$cshow :: NetworkInterface -> String
showsPrec :: Int -> NetworkInterface -> ShowS
$cshowsPrec :: Int -> NetworkInterface -> ShowS
Show)

instance Storable NetworkInterface where
    alignment :: NetworkInterface -> Int
alignment NetworkInterface
_ = Int
4
{-# LINE 48 "src/Network/Info.hsc" #-}
    sizeOf _    = (556)
{-# LINE 49 "src/Network/Info.hsc" #-}
    peek ptr    = do
        name <- peekCWString $ ((\hsc_ptr -> hsc_ptr `plusPtr` 0)) ptr
{-# LINE 51 "src/Network/Info.hsc" #-}
        ipv4 <- ((\hsc_ptr -> peekByteOff hsc_ptr 528)) ptr
{-# LINE 52 "src/Network/Info.hsc" #-}
        ipv6 <- ((\hsc_ptr -> peekByteOff hsc_ptr 532)) ptr
{-# LINE 53 "src/Network/Info.hsc" #-}
        mac  <- ((\hsc_ptr -> peekByteOff hsc_ptr 548)) ptr
{-# LINE 54 "src/Network/Info.hsc" #-}
        return $ NetworkInterface name ipv4 ipv6 mac


-- | Gets the address information for each of the network interfaces on
--   the local computer.
getNetworkInterfaces :: IO [NetworkInterface]
getNetworkInterfaces :: IO [NetworkInterface]
getNetworkInterfaces =
    forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
128 forall a b. (a -> b) -> a -> b
$ \Ptr NetworkInterface
ptr -> do
    CInt
count <- Ptr NetworkInterface -> CInt -> IO CInt
c_get_network_interfaces Ptr NetworkInterface
ptr CInt
128
    forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
count) Ptr NetworkInterface
ptr


----------------------------------------------------------------------
-- IPv4 addresses
----------------------------------------------------------------------

-- | Represents an IPv4 address (e.g. @172.23.21.1@, @127.0.0.1@)
data IPv4 = IPv4
    {-# UNPACK #-} !Word32
    deriving (IPv4 -> IPv4 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv4 -> IPv4 -> Bool
$c/= :: IPv4 -> IPv4 -> Bool
== :: IPv4 -> IPv4 -> Bool
$c== :: IPv4 -> IPv4 -> Bool
Eq, Eq IPv4
IPv4 -> IPv4 -> Bool
IPv4 -> IPv4 -> Ordering
IPv4 -> IPv4 -> IPv4
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IPv4 -> IPv4 -> IPv4
$cmin :: IPv4 -> IPv4 -> IPv4
max :: IPv4 -> IPv4 -> IPv4
$cmax :: IPv4 -> IPv4 -> IPv4
>= :: IPv4 -> IPv4 -> Bool
$c>= :: IPv4 -> IPv4 -> Bool
> :: IPv4 -> IPv4 -> Bool
$c> :: IPv4 -> IPv4 -> Bool
<= :: IPv4 -> IPv4 -> Bool
$c<= :: IPv4 -> IPv4 -> Bool
< :: IPv4 -> IPv4 -> Bool
$c< :: IPv4 -> IPv4 -> Bool
compare :: IPv4 -> IPv4 -> Ordering
$ccompare :: IPv4 -> IPv4 -> Ordering
Ord, IPv4
forall a. a -> a -> Bounded a
maxBound :: IPv4
$cmaxBound :: IPv4
minBound :: IPv4
$cminBound :: IPv4
Bounded)

instance Show IPv4 where
    show :: IPv4 -> String
show = IPv4 -> String
showIPv4

instance Storable IPv4 where
    alignment :: IPv4 -> Int
alignment IPv4
_ = Int
1
    sizeOf :: IPv4 -> Int
sizeOf IPv4
_    = Int
4
    peek :: Ptr IPv4 -> IO IPv4
peek Ptr IPv4
p      = do
        Word32
ip <- forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr Ptr IPv4
p)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> IPv4
IPv4 Word32
ip)
    poke :: Ptr IPv4 -> IPv4 -> IO ()
poke Ptr IPv4
p (IPv4 Word32
ip) =
        forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr IPv4
p) Word32
ip


----------------------------------------------------------------------
-- IPv6 addresses
----------------------------------------------------------------------

-- | Represents an IPv6 address (e.g. @2001:db8:85a3::8a2e:370:7334@, @::1@)
data IPv6 = IPv6
    {-# UNPACK #-} !Word32
    {-# UNPACK #-} !Word32
    {-# UNPACK #-} !Word32
    {-# UNPACK #-} !Word32
    deriving (IPv6 -> IPv6 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPv6 -> IPv6 -> Bool
$c/= :: IPv6 -> IPv6 -> Bool
== :: IPv6 -> IPv6 -> Bool
$c== :: IPv6 -> IPv6 -> Bool
Eq, Eq IPv6
IPv6 -> IPv6 -> Bool
IPv6 -> IPv6 -> Ordering
IPv6 -> IPv6 -> IPv6
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IPv6 -> IPv6 -> IPv6
$cmin :: IPv6 -> IPv6 -> IPv6
max :: IPv6 -> IPv6 -> IPv6
$cmax :: IPv6 -> IPv6 -> IPv6
>= :: IPv6 -> IPv6 -> Bool
$c>= :: IPv6 -> IPv6 -> Bool
> :: IPv6 -> IPv6 -> Bool
$c> :: IPv6 -> IPv6 -> Bool
<= :: IPv6 -> IPv6 -> Bool
$c<= :: IPv6 -> IPv6 -> Bool
< :: IPv6 -> IPv6 -> Bool
$c< :: IPv6 -> IPv6 -> Bool
compare :: IPv6 -> IPv6 -> Ordering
$ccompare :: IPv6 -> IPv6 -> Ordering
Ord, IPv6
forall a. a -> a -> Bounded a
maxBound :: IPv6
$cmaxBound :: IPv6
minBound :: IPv6
$cminBound :: IPv6
Bounded)

-- | Not yet capable of collapsing groups of zeros, will still
--   generate valid addresses however.
instance Show IPv6 where
    show :: IPv6 -> String
show = IPv6 -> String
showIPv6

instance Storable IPv6 where
    alignment :: IPv6 -> Int
alignment IPv6
_ = Int
1
    sizeOf :: IPv6 -> Int
sizeOf IPv6
_    = Int
16
    peek :: Ptr IPv6 -> IO IPv6
peek Ptr IPv6
p      = do
        let ptr :: Ptr b
ptr = forall a b. Ptr a -> Ptr b
castPtr Ptr IPv6
p
        Word32
a <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff forall {b}. Ptr b
ptr Int
0
        Word32
b <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff forall {b}. Ptr b
ptr Int
1
        Word32
c <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff forall {b}. Ptr b
ptr Int
2
        Word32
d <- forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff forall {b}. Ptr b
ptr Int
3
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32 -> Word32 -> IPv6
IPv6 Word32
a Word32
b Word32
c Word32
d
    poke :: Ptr IPv6 -> IPv6 -> IO ()
poke Ptr IPv6
p (IPv6 Word32
a Word32
b Word32
c Word32
d) = do
        let ptr :: Ptr b
ptr = forall a b. Ptr a -> Ptr b
castPtr Ptr IPv6
p
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff forall {b}. Ptr b
ptr Int
0 Word32
a
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff forall {b}. Ptr b
ptr Int
1 Word32
b
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff forall {b}. Ptr b
ptr Int
2 Word32
c
        forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff forall {b}. Ptr b
ptr Int
3 Word32
d


----------------------------------------------------------------------
-- MAC addresses
----------------------------------------------------------------------

-- | Represents a MAC address (e.g. @01:23:45:67:89:ab@)
data MAC = MAC
    {-# UNPACK #-} !Word8
    {-# UNPACK #-} !Word8
    {-# UNPACK #-} !Word8
    {-# UNPACK #-} !Word8
    {-# UNPACK #-} !Word8
    {-# UNPACK #-} !Word8
    deriving (MAC -> MAC -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MAC -> MAC -> Bool
$c/= :: MAC -> MAC -> Bool
== :: MAC -> MAC -> Bool
$c== :: MAC -> MAC -> Bool
Eq, Eq MAC
MAC -> MAC -> Bool
MAC -> MAC -> Ordering
MAC -> MAC -> MAC
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MAC -> MAC -> MAC
$cmin :: MAC -> MAC -> MAC
max :: MAC -> MAC -> MAC
$cmax :: MAC -> MAC -> MAC
>= :: MAC -> MAC -> Bool
$c>= :: MAC -> MAC -> Bool
> :: MAC -> MAC -> Bool
$c> :: MAC -> MAC -> Bool
<= :: MAC -> MAC -> Bool
$c<= :: MAC -> MAC -> Bool
< :: MAC -> MAC -> Bool
$c< :: MAC -> MAC -> Bool
compare :: MAC -> MAC -> Ordering
$ccompare :: MAC -> MAC -> Ordering
Ord, MAC
forall a. a -> a -> Bounded a
maxBound :: MAC
$cmaxBound :: MAC
minBound :: MAC
$cminBound :: MAC
Bounded)

instance Show MAC where
    show :: MAC -> String
show (MAC Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f) = forall r. PrintfType r => String -> r
printf String
"%02x:%02x:%02x:%02x:%02x:%02x" Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f

instance Storable MAC where
    alignment :: MAC -> Int
alignment MAC
_ = Int
1
    sizeOf :: MAC -> Int
sizeOf MAC
_    = Int
6
    peek :: Ptr MAC -> IO MAC
peek Ptr MAC
p      = do
        Word8
a <- forall a. Storable a => Ptr a -> IO a
peek forall a b. (a -> b) -> a -> b
$ forall a b. Ptr a -> Ptr b
castPtr Ptr MAC
p
        Word8
b <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MAC
p Int
1
        Word8
c <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MAC
p Int
2
        Word8
d <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MAC
p Int
3
        Word8
e <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MAC
p Int
4
        Word8
f <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MAC
p Int
5
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> MAC
MAC Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f
    poke :: Ptr MAC -> MAC -> IO ()
poke Ptr MAC
p (MAC Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f) = do
        forall a. Storable a => Ptr a -> a -> IO ()
poke (forall a b. Ptr a -> Ptr b
castPtr Ptr MAC
p) Word8
a
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MAC
p Int
1 Word8
b
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MAC
p Int
2 Word8
c
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MAC
p Int
3 Word8
d
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MAC
p Int
4 Word8
e
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MAC
p Int
5 Word8
f


----------------------------------------------------------------------
-- Helper functions
----------------------------------------------------------------------

showIPv4 :: IPv4 -> String
showIPv4 :: IPv4 -> String
showIPv4 (IPv4 Word32
ip) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
"." forall a b. (a -> b) -> a -> b
$ [String]
showOctets
  where
    showOctets :: [String]
showOctets = forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Word32 -> [Word8]
word8s Word32
ip

-- TODO: drop out consecutive zeros
showIPv6 :: IPv6 -> String
showIPv6 :: IPv6 -> String
showIPv6 (IPv6 Word32
a Word32
b Word32
c Word32
d) = (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse String
":") [String]
groups
  where
    groups :: [String]
groups = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Integral a, Show a) => a -> ShowS
showHex String
"")  forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Word8] -> [Word16]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Word8]
word8s) [Word32
a,Word32
b,Word32
c,Word32
d]

word8s :: Word32 -> [Word8]
word8s :: Word32 -> [Word8]
word8s Word32
x = [ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
x
           , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
x forall a. Bits a => a -> Int -> a
`shiftR` Int
8
           , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
x forall a. Bits a => a -> Int -> a
`shiftR` Int
16
           , forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word32
x forall a. Bits a => a -> Int -> a
`shiftR` Int
24 ]

group :: [Word8] -> [Word16]
group :: [Word8] -> [Word16]
group = forall a b. (a -> a -> b) -> [a] -> [b]
map2 forall a b. (a -> b) -> a -> b
$ \Word8
x Word8
y -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) forall a. Bits a => a -> Int -> a
`shiftL` Int
8 forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
y)

map2 :: (a -> a -> b) -> [a] -> [b]
map2 :: forall a b. (a -> a -> b) -> [a] -> [b]
map2 a -> a -> b
_ [] = []
map2 a -> a -> b
f (a
x:a
y:[a]
zs) = a -> a -> b
f a
x a
y forall a. a -> [a] -> [a]
: forall a b. (a -> a -> b) -> [a] -> [b]
map2 a -> a -> b
f [a]
zs