{-# LANGUAGE CPP #-}

#include "HsNetDef.h"

module Network.Socket.If (
    ifNameToIndex
  , ifIndexToName
  ) where

import Foreign.Marshal.Alloc (allocaBytes)

import Network.Socket.Imports

-- | Returns the index corresponding to the interface name.
--
--   Since 2.7.0.0.
ifNameToIndex :: String -> IO (Maybe Int)
ifNameToIndex :: String -> IO (Maybe Int)
ifNameToIndex String
ifname = do
  CUInt
index <- String -> (CString -> IO CUInt) -> IO CUInt
forall a. String -> (CString -> IO a) -> IO a
withCString String
ifname CString -> IO CUInt
c_if_nametoindex
  -- On failure zero is returned. We'll return Nothing.
  Maybe Int -> IO (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
forall a b. (a -> b) -> a -> b
$ if CUInt
index CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
0 then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
index

-- | Returns the interface name corresponding to the index.
--
--   Since 2.7.0.0.
ifIndexToName :: Int -> IO (Maybe String)
ifIndexToName :: Int -> IO (Maybe String)
ifIndexToName Int
ifn = Int -> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((CString -> IO (Maybe String)) -> IO (Maybe String))
-> (CString -> IO (Maybe String)) -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ \CString
ptr -> do -- 16 == IFNAMSIZ
    CString
r <- CUInt -> CString -> IO CString
c_if_indextoname (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ifn) CString
ptr
    if CString
r CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr then
        Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      else
        String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO String
peekCString CString
ptr

foreign import CALLCONV safe "if_nametoindex"
   c_if_nametoindex :: CString -> IO CUInt

foreign import CALLCONV safe "if_indextoname"
   c_if_indextoname :: CUInt -> CString -> IO CString