-- | This module exports interface related services.
--
-- @since 0.1
module Pythia.Services.NetInterface
  ( -- * Queries
    queryNetInterfaces,
    queryNetInterface,

    -- * Functions
    findUp,

    -- * Types
    NetInterfaces (..),
    NetInterface (..),
    NetInterfaceState (..),
    NetInterfaceType (..),
    Device (..),
    IpType (..),
    IpAddress (..),

    -- ** Configuration
    NetInterfaceApp (..),
  )
where

import GHC.OldList qualified as OL
import Pythia.Prelude
import Pythia.Services.NetInterface.Ip qualified as Ip
import Pythia.Services.NetInterface.NmCli qualified as NmCli
import Pythia.Services.NetInterface.Types
import Pythia.Services.Types.Network

-- $setup
-- >>> import Control.Exception (displayException)
-- >>> import Pythia.Prelude
-- >>> import Pythia.Services.NetInterface.Types (DeviceNotFound)

-- | Queries for all network interface data.
--
-- @since 0.1
queryNetInterfaces ::
  ( MonadPathReader m,
    MonadThrow m,
    MonadTypedProcess m
  ) =>
  NetInterfaceApp ->
  m NetInterfaces
queryNetInterfaces :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
NetInterfaceApp -> m NetInterfaces
queryNetInterfaces NetInterfaceApp
NetInterfaceAppNmCli = m NetInterfaces
forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
m NetInterfaces
NmCli.netInterfaceShellApp
queryNetInterfaces NetInterfaceApp
NetInterfaceAppIp = m NetInterfaces
forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
m NetInterfaces
Ip.netInterfaceShellApp
{-# INLINEABLE queryNetInterfaces #-}

-- | Like 'queryNetInterfaces' but returns data for a single device.
--
-- @since 0.1
queryNetInterface ::
  ( MonadPathReader m,
    MonadThrow m,
    MonadTypedProcess m
  ) =>
  Device ->
  NetInterfaceApp ->
  m NetInterface
queryNetInterface :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
Device -> NetInterfaceApp -> m NetInterface
queryNetInterface Device
d = NetInterfaceApp -> m NetInterfaces
forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
NetInterfaceApp -> m NetInterfaces
queryNetInterfaces (NetInterfaceApp -> m NetInterfaces)
-> (NetInterfaces -> m NetInterface)
-> NetInterfaceApp
-> m NetInterface
forall (m :: Type -> Type) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Device -> NetInterfaces -> m NetInterface
forall (m :: Type -> Type).
MonadThrow m =>
Device -> NetInterfaces -> m NetInterface
findDevice Device
d
{-# INLINEABLE queryNetInterface #-}

findDevice :: (MonadThrow m) => Device -> NetInterfaces -> m NetInterface
findDevice :: forall (m :: Type -> Type).
MonadThrow m =>
Device -> NetInterfaces -> m NetInterface
findDevice Device
device = DeviceNotFound -> Maybe NetInterface -> m NetInterface
forall (m :: Type -> Type) e a.
(Exception e, MonadThrow m) =>
e -> Maybe a -> m a
throwMaybe DeviceNotFound
e (Maybe NetInterface -> m NetInterface)
-> (NetInterfaces -> Maybe NetInterface)
-> NetInterfaces
-> m NetInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NetInterface] -> Maybe NetInterface
forall a. [a] -> Maybe a
headMaybe ([NetInterface] -> Maybe NetInterface)
-> (NetInterfaces -> [NetInterface])
-> NetInterfaces
-> Maybe NetInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx NetInterfaces [NetInterface]
-> NetInterfaces -> [NetInterface]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx NetInterfaces [NetInterface]
#unNetInterfaces (NetInterfaces -> [NetInterface])
-> (NetInterfaces -> NetInterfaces)
-> NetInterfaces
-> [NetInterface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Device -> NetInterfaces -> NetInterfaces
filterDevice Device
device
  where
    e :: DeviceNotFound
e = Device -> DeviceNotFound
MkDeviceNotFound Device
device
{-# INLINEABLE findDevice #-}

-- | Takes the first 'NetInterface' that has state 'NetStateUp', according to
-- 'NetInterfaceState'\'s 'Ord':
--
-- @
-- 'Ethernet' < 'Wifi' < 'Wifi_P2P' < 'Loopback' < 'Tun'
-- @
--
-- __Examples__
--
-- >>> findUp $ MkNetInterfaces []
-- Nothing
--
-- >>> :{
--   let wifiUp = MkNetInterface "" (Just Wifi) NetStateUp (Just "WifiUp") mempty mempty
--       wifiNetStateDown = MkNetInterface "" (Just Wifi) NetStateDown (Just "WifiNetStateDown") mempty mempty
--       loopUp = MkNetInterface "" (Just Loopback) NetStateUp (Just "LoopUp") mempty mempty
--    in findUp $ MkNetInterfaces [loopUp, wifiNetStateDown, wifiUp]
-- :}
-- Just (MkNetInterface {device = MkDevice {unDevice = ""}, ntype = Just Wifi, state = NetStateUp, name = Just "WifiUp", ipv4s = MkIpAddresses {unIpAddresses = []}, ipv6s = MkIpAddresses {unIpAddresses = []}})
--
-- @since 0.1
findUp :: NetInterfaces -> Maybe NetInterface
findUp :: NetInterfaces -> Maybe NetInterface
findUp = [NetInterface] -> Maybe NetInterface
forall a. [a] -> Maybe a
headMaybe ([NetInterface] -> Maybe NetInterface)
-> (NetInterfaces -> [NetInterface])
-> NetInterfaces
-> Maybe NetInterface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NetInterface] -> [NetInterface]
sortType ([NetInterface] -> [NetInterface])
-> ([NetInterface] -> [NetInterface])
-> [NetInterface]
-> [NetInterface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NetInterface] -> [NetInterface]
filterUp) ([NetInterface] -> [NetInterface])
-> (NetInterfaces -> [NetInterface])
-> NetInterfaces
-> [NetInterface]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx NetInterfaces [NetInterface]
-> NetInterfaces -> [NetInterface]
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx NetInterfaces [NetInterface]
#unNetInterfaces
  where
    sortType :: [NetInterface] -> [NetInterface]
sortType = (NetInterface -> Maybe NetInterfaceType)
-> [NetInterface] -> [NetInterface]
forall b a. Ord b => (a -> b) -> [a] -> [a]
OL.sortOn (Optic' A_Lens NoIx NetInterface (Maybe NetInterfaceType)
-> NetInterface -> Maybe NetInterfaceType
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx NetInterface (Maybe NetInterfaceType)
#ntype)
    filterUp :: [NetInterface] -> [NetInterface]
filterUp = (NetInterface -> Bool) -> [NetInterface] -> [NetInterface]
forall a. (a -> Bool) -> [a] -> [a]
filter ((NetInterfaceState -> NetInterfaceState -> Bool
forall a. Eq a => a -> a -> Bool
== NetInterfaceState
NetStateUp) (NetInterfaceState -> Bool)
-> (NetInterface -> NetInterfaceState) -> NetInterface -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx NetInterface NetInterfaceState
-> NetInterface -> NetInterfaceState
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx NetInterface NetInterfaceState
#state)
{-# INLINEABLE findUp #-}

filterDevice :: Device -> NetInterfaces -> NetInterfaces
filterDevice :: Device -> NetInterfaces -> NetInterfaces
filterDevice Device
device (MkNetInterfaces [NetInterface]
ifs) =
  [NetInterface] -> NetInterfaces
MkNetInterfaces
    ([NetInterface] -> NetInterfaces)
-> [NetInterface] -> NetInterfaces
forall a b. (a -> b) -> a -> b
$ (NetInterface -> Bool) -> [NetInterface] -> [NetInterface]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Device -> Device -> Bool
forall a. Eq a => a -> a -> Bool
== Device
device) (Device -> Bool)
-> (NetInterface -> Device) -> NetInterface -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic' A_Lens NoIx NetInterface Device -> NetInterface -> Device
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Lens NoIx NetInterface Device
#device) [NetInterface]
ifs
{-# INLINEABLE filterDevice #-}