{-# LANGUAGE QuasiQuotes #-}

-- | This module provides functionality for retrieving network connection
-- information using nmcli.
--
-- @since 0.1
module Pythia.Services.NetInterface.NmCli
  ( -- * Query
    netInterfaceShellApp,
    supported,

    -- * Misc
    NmCliParseError (..),
    parseInterfaces,
  )
where

import Data.Char qualified as Char
import Data.Set qualified as Set
import Data.Text qualified as T
import Pythia.Internal.ShellApp (SimpleShell (MkSimpleShell))
import Pythia.Internal.ShellApp qualified as ShellApp
import Pythia.Prelude
import Pythia.Services.NetInterface.Types
  ( NetInterface (MkNetInterface, device, ipv4s, ipv6s, name, ntype, state),
    NetInterfaceState (NetStateDown, NetStateUnknown, NetStateUp),
    NetInterfaceType (Ethernet, Loopback, Tun, Wifi, Wifi_P2P),
    NetInterfaces (MkNetInterfaces),
  )
import Pythia.Services.Types.Network
  ( Device (MkDevice),
    IpAddress (MkIpAddress),
    IpAddresses (MkIpAddresses),
    IpType (Ipv4, Ipv6),
  )
import Pythia.Utils qualified as U
import Refined (Predicate, Refined)
import Refined qualified as R
import Text.Megaparsec (ErrorFancy (ErrorFail), Parsec, (<?>))
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Char qualified as MPC

-- $setup
-- >>> import Control.Exception (displayException)
-- >>> import Pythia.Prelude

-- | Error parsing nmcli output.
--
-- ==== __Examples__
--
-- >>> displayException $ MkNmCliParseError "parse error"
-- "NmCli parse error: parse error"
--
-- @since 0.1
type NmCliParseError :: Type
newtype NmCliParseError = MkNmCliParseError Text
  deriving stock
    ( -- | @since 0.1
      NmCliParseError -> NmCliParseError -> Bool
(NmCliParseError -> NmCliParseError -> Bool)
-> (NmCliParseError -> NmCliParseError -> Bool)
-> Eq NmCliParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NmCliParseError -> NmCliParseError -> Bool
== :: NmCliParseError -> NmCliParseError -> Bool
$c/= :: NmCliParseError -> NmCliParseError -> Bool
/= :: NmCliParseError -> NmCliParseError -> Bool
Eq,
      -- | @since 0.1
      Int -> NmCliParseError -> ShowS
[NmCliParseError] -> ShowS
NmCliParseError -> String
(Int -> NmCliParseError -> ShowS)
-> (NmCliParseError -> String)
-> ([NmCliParseError] -> ShowS)
-> Show NmCliParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NmCliParseError -> ShowS
showsPrec :: Int -> NmCliParseError -> ShowS
$cshow :: NmCliParseError -> String
show :: NmCliParseError -> String
$cshowList :: [NmCliParseError] -> ShowS
showList :: [NmCliParseError] -> ShowS
Show
    )

-- | @since 0.1
instance Exception NmCliParseError where
  displayException :: NmCliParseError -> String
displayException (MkNmCliParseError Text
e) =
    (String
"NmCli parse error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>)
      ShowS -> (Text -> String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
      (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
e

-- | NmCli query for 'NetInterfaces'.
--
-- @since 0.1
netInterfaceShellApp ::
  ( MonadPathReader m,
    MonadThrow m,
    MonadTypedProcess m
  ) =>
  m NetInterfaces
netInterfaceShellApp :: forall (m :: Type -> Type).
(MonadPathReader m, MonadThrow m, MonadTypedProcess m) =>
m NetInterfaces
netInterfaceShellApp = SimpleShell m NmCliParseError NetInterfaces -> m NetInterfaces
forall (m :: Type -> Type) err result.
(Exception err, MonadThrow m, MonadTypedProcess m) =>
SimpleShell m err result -> m result
ShellApp.runSimple SimpleShell m NmCliParseError NetInterfaces
shell
  where
    shell :: SimpleShell m NmCliParseError NetInterfaces
shell =
      MkSimpleShell
        { $sel:command:MkSimpleShell :: Command
command = Command
"nmcli -t -m multiline device show",
          $sel:isSupported:MkSimpleShell :: m Bool
isSupported = m Bool
forall (m :: Type -> Type). MonadPathReader m => m Bool
supported,
          $sel:parser:MkSimpleShell :: Text -> Either NmCliParseError NetInterfaces
parser = Text -> Either NmCliParseError NetInterfaces
parseInterfaces
        }
{-# INLINEABLE netInterfaceShellApp #-}

-- | Returns a boolean determining if this program is supported on the
-- current system.
--
-- @since 0.1
supported :: (MonadPathReader m) => m Bool
supported :: forall (m :: Type -> Type). MonadPathReader m => m Bool
supported = OsPath -> m Bool
forall (m :: Type -> Type). MonadPathReader m => OsPath -> m Bool
U.exeSupported [osp|nmcli|]
{-# INLINEABLE supported #-}

type MParser :: Type -> Type
type MParser = Parsec Void Text

-- | Attemps to parse the output of nmcli.
--
-- @since 0.1
parseInterfaces :: Text -> Either NmCliParseError NetInterfaces
parseInterfaces :: Text -> Either NmCliParseError NetInterfaces
parseInterfaces Text
txt = case Parsec Void Text NetInterfaces
-> String
-> Text
-> Either (ParseErrorBundle Text Void) NetInterfaces
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text NetInterfaces
mparseInterfaces String
"Pythia.Services.NetInterface.NmCli" Text
txt of
  Left ParseErrorBundle Text Void
ex ->
    let prettyErr :: String
prettyErr = ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty ParseErrorBundle Text Void
ex
     in NmCliParseError -> Either NmCliParseError NetInterfaces
forall a b. a -> Either a b
Left (NmCliParseError -> Either NmCliParseError NetInterfaces)
-> NmCliParseError -> Either NmCliParseError NetInterfaces
forall a b. (a -> b) -> a -> b
$ Text -> NmCliParseError
MkNmCliParseError (Text -> NmCliParseError) -> Text -> NmCliParseError
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
prettyErr
  Right NetInterfaces
ifs -> NetInterfaces -> Either NmCliParseError NetInterfaces
forall a b. b -> Either a b
Right NetInterfaces
ifs
{-# INLINEABLE parseInterfaces #-}

mparseInterfaces :: MParser NetInterfaces
mparseInterfaces :: Parsec Void Text NetInterfaces
mparseInterfaces = [NetInterface] -> NetInterfaces
MkNetInterfaces ([NetInterface] -> NetInterfaces)
-> ParsecT Void Text Identity [NetInterface]
-> Parsec Void Text NetInterfaces
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity NetInterface
-> ParsecT Void Text Identity [NetInterface]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void Text Identity NetInterface
parseInterface
{-# INLINEABLE mparseInterfaces #-}

parseInterface :: MParser NetInterface
parseInterface :: ParsecT Void Text Identity NetInterface
parseInterface = do
  Device
device' <- MParser Device
parseDevice
  NetInterfaceType
type' <- MParser NetInterfaceType
parseNetInterfaceType
  MParser ()
parseHwaddr
  MParser ()
parseMTU
  NetInterfaceState
state' <- MParser NetInterfaceState
parseNetInterfaceState
  Maybe Text
name' <- MParser (Maybe Text)
parseName
  MParser ()
parseConPath
  MParser () -> ParsecT Void Text Identity (Maybe ())
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
MP.optional MParser ()
parseWiredProp
  [IpAddress 'Ipv4]
ipv4s' <- Maybe [IpAddress 'Ipv4] -> [IpAddress 'Ipv4]
forall (f :: Type -> Type) a. Alternative f => Maybe (f a) -> f a
U.mAlt (Maybe [IpAddress 'Ipv4] -> [IpAddress 'Ipv4])
-> ParsecT Void Text Identity (Maybe [IpAddress 'Ipv4])
-> ParsecT Void Text Identity [IpAddress 'Ipv4]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [IpAddress 'Ipv4]
-> ParsecT Void Text Identity (Maybe [IpAddress 'Ipv4])
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
MP.optional ParsecT Void Text Identity [IpAddress 'Ipv4]
parseIpv4s
  [IpAddress 'Ipv6]
ipv6s' <- Maybe [IpAddress 'Ipv6] -> [IpAddress 'Ipv6]
forall (f :: Type -> Type) a. Alternative f => Maybe (f a) -> f a
U.mAlt (Maybe [IpAddress 'Ipv6] -> [IpAddress 'Ipv6])
-> ParsecT Void Text Identity (Maybe [IpAddress 'Ipv6])
-> ParsecT Void Text Identity [IpAddress 'Ipv6]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity [IpAddress 'Ipv6]
-> ParsecT Void Text Identity (Maybe [IpAddress 'Ipv6])
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
MP.optional ParsecT Void Text Identity [IpAddress 'Ipv6]
parseIpv6s
  ParsecT Void Text Identity (Tokens Text)
-> ParsecT Void Text Identity [Tokens Text]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
MP.many ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
MPC.eol
  pure
    $ MkNetInterface
      { $sel:device:MkNetInterface :: Device
device = Device
device',
        $sel:ntype:MkNetInterface :: Maybe NetInterfaceType
ntype = NetInterfaceType -> Maybe NetInterfaceType
forall a. a -> Maybe a
Just NetInterfaceType
type',
        $sel:state:MkNetInterface :: NetInterfaceState
state = NetInterfaceState
state',
        $sel:name:MkNetInterface :: Maybe Text
name = Maybe Text
name',
        $sel:ipv4s:MkNetInterface :: IpAddresses 'Ipv4
ipv4s = [IpAddress 'Ipv4] -> IpAddresses 'Ipv4
forall (a :: IpType). [IpAddress a] -> IpAddresses a
MkIpAddresses [IpAddress 'Ipv4]
ipv4s',
        $sel:ipv6s:MkNetInterface :: IpAddresses 'Ipv6
ipv6s = [IpAddress 'Ipv6] -> IpAddresses 'Ipv6
forall (a :: IpType). [IpAddress a] -> IpAddresses a
MkIpAddresses [IpAddress 'Ipv6]
ipv6s'
      }
{-# INLINEABLE parseInterface #-}

parseDevice :: MParser Device
parseDevice :: MParser Device
parseDevice = do
  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.DEVICE:"
  Text
device' <- Maybe String -> ParsecT Void Text Identity (Tokens Text)
forall e s.
(Ord e, Stream s, Token s ~ Char) =>
Maybe String -> Parsec e s (Tokens s)
U.takeLineLabel (String -> Maybe String
forall a. a -> Maybe a
Just String
"device")
  pure $ Text -> Device
MkDevice Text
device'
{-# INLINEABLE parseDevice #-}

parseNetInterfaceType :: MParser NetInterfaceType
parseNetInterfaceType :: MParser NetInterfaceType
parseNetInterfaceType = do
  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.TYPE:"
  NetInterfaceType
type' <-
    MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceType
wifiP2p
      MParser NetInterfaceType
-> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceType
wifi
      MParser NetInterfaceType
-> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceType
ethernet
      MParser NetInterfaceType
-> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceType
loopback
      MParser NetInterfaceType
-> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceType
tun
      MParser NetInterfaceType
-> MParser NetInterfaceType -> MParser NetInterfaceType
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> Set (ErrorFancy Void) -> MParser NetInterfaceType
forall e s (m :: Type -> Type) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
MP.fancyFailure ([ErrorFancy Void] -> Set (ErrorFancy Void)
forall a. Ord a => [a] -> Set a
Set.fromList [String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
"Unknown type"])
      MParser NetInterfaceType -> String -> MParser NetInterfaceType
forall e s (m :: Type -> Type) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"type"
  ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
MPC.eol
  pure NetInterfaceType
type'
  where
    wifi :: MParser NetInterfaceType
wifi = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"wifi" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceType -> MParser NetInterfaceType
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceType
Wifi
    wifiP2p :: MParser NetInterfaceType
wifiP2p = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"wifi-p2p" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceType -> MParser NetInterfaceType
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceType
Wifi_P2P
    ethernet :: MParser NetInterfaceType
ethernet = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"ethernet" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceType -> MParser NetInterfaceType
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceType
Ethernet
    loopback :: MParser NetInterfaceType
loopback = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"loopback" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceType -> MParser NetInterfaceType
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceType
Loopback
    tun :: MParser NetInterfaceType
tun = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"tun" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceType -> MParser NetInterfaceType
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceType
Tun
{-# INLINEABLE parseNetInterfaceType #-}

parseHwaddr :: MParser ()
parseHwaddr :: MParser ()
parseHwaddr = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.HWADDR:" ParsecT Void Text Identity (Tokens Text)
-> MParser () -> MParser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> MParser ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseHwaddr #-}

parseMTU :: MParser ()
parseMTU :: MParser ()
parseMTU = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.MTU:" ParsecT Void Text Identity (Tokens Text)
-> MParser () -> MParser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> MParser ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseMTU #-}

parseNetInterfaceState :: MParser NetInterfaceState
parseNetInterfaceState :: MParser NetInterfaceState
parseNetInterfaceState = do
  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.STATE:"
  Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"state int code") Char -> Bool
Token Text -> Bool
Char.isDigit
  MParser ()
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  NetInterfaceState
state' <-
    MParser NetInterfaceState -> MParser NetInterfaceState
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceState
up
      MParser NetInterfaceState
-> MParser NetInterfaceState -> MParser NetInterfaceState
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceState -> MParser NetInterfaceState
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceState
down
      MParser NetInterfaceState
-> MParser NetInterfaceState -> MParser NetInterfaceState
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceState -> MParser NetInterfaceState
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: Type -> Type) a. MonadParsec e s m => m a -> m a
MP.try MParser NetInterfaceState
unavail
      MParser NetInterfaceState
-> MParser NetInterfaceState -> MParser NetInterfaceState
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> MParser NetInterfaceState
unknown
      MParser NetInterfaceState -> String -> MParser NetInterfaceState
forall e s (m :: Type -> Type) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"state"
  MParser ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
  pure NetInterfaceState
state'
  where
    up :: MParser NetInterfaceState
up = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"(connected)" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceState -> MParser NetInterfaceState
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceState
NetStateUp
    down :: MParser NetInterfaceState
down = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"(disconnected)" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceState -> MParser NetInterfaceState
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceState
NetStateDown
    unavail :: MParser NetInterfaceState
unavail = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"(unavailable)" ParsecT Void Text Identity (Tokens Text)
-> NetInterfaceState -> MParser NetInterfaceState
forall (f :: Type -> Type) a b. Functor f => f a -> b -> f b
$> NetInterfaceState
NetStateDown
    unknown :: MParser NetInterfaceState
unknown = Text -> NetInterfaceState
NetStateUnknown (Text -> NetInterfaceState)
-> ParsecT Void Text Identity Text -> MParser NetInterfaceState
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"type") (Token Text -> Token Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token Text
'\n')
{-# INLINEABLE parseNetInterfaceState #-}

parseName :: MParser (Maybe Text)
parseName :: MParser (Maybe Text)
parseName = do
  Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.CONNECTION:"
  Text
name' <- Maybe String -> ParsecT Void Text Identity (Tokens Text)
forall e s.
(Ord e, Stream s, Token s ~ Char) =>
Maybe String -> Parsec e s (Tokens s)
U.takeLineLabel (String -> Maybe String
forall a. a -> Maybe a
Just String
"name")
  pure
    $ if Text -> Bool
T.null Text
name'
      then Maybe Text
forall a. Maybe a
Nothing
      else Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name'
{-# INLINEABLE parseName #-}

parseConPath :: MParser ()
parseConPath :: MParser ()
parseConPath = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"GENERAL.CON-PATH:" ParsecT Void Text Identity (Tokens Text)
-> MParser () -> MParser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> MParser ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseConPath #-}

parseWiredProp :: MParser ()
parseWiredProp :: MParser ()
parseWiredProp = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens Text
"WIRED-PROPERTIES" ParsecT Void Text Identity (Tokens Text)
-> MParser () -> MParser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> MParser ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseWiredProp #-}

parseIpv4s :: MParser [IpAddress Ipv4]
parseIpv4s :: ParsecT Void Text Identity [IpAddress 'Ipv4]
parseIpv4s = Text
-> (Refined Ipv4Refinement Text -> IpAddress 'Ipv4)
-> ParsecT Void Text Identity [IpAddress 'Ipv4]
forall p a.
Predicate p Text =>
Text -> (Refined p Text -> a) -> MParser [a]
parseAllIpInfo Text
"4" Refined Ipv4Refinement Text -> IpAddress 'Ipv4
Refined (IpRefinement 'Ipv4) Text -> IpAddress 'Ipv4
forall (a :: IpType). Refined (IpRefinement a) Text -> IpAddress a
MkIpAddress
{-# INLINEABLE parseIpv4s #-}

parseIpv6s :: MParser [IpAddress Ipv6]
parseIpv6s :: ParsecT Void Text Identity [IpAddress 'Ipv6]
parseIpv6s = Text
-> (Refined Ipv6Refinement Text -> IpAddress 'Ipv6)
-> ParsecT Void Text Identity [IpAddress 'Ipv6]
forall p a.
Predicate p Text =>
Text -> (Refined p Text -> a) -> MParser [a]
parseAllIpInfo Text
"6" Refined Ipv6Refinement Text -> IpAddress 'Ipv6
Refined (IpRefinement 'Ipv6) Text -> IpAddress 'Ipv6
forall (a :: IpType). Refined (IpRefinement a) Text -> IpAddress a
MkIpAddress
{-# INLINEABLE parseIpv6s #-}

parseAllIpInfo :: (Predicate p Text) => Text -> (Refined p Text -> a) -> MParser [a]
parseAllIpInfo :: forall p a.
Predicate p Text =>
Text -> (Refined p Text -> a) -> MParser [a]
parseAllIpInfo Text
p Refined p Text -> a
cons = do
  [a]
ipvs <- Text -> (Refined p Text -> a) -> MParser [a]
forall p a.
Predicate p Text =>
Text -> (Refined p Text -> a) -> MParser [a]
parseIps Text
p Refined p Text -> a
cons
  Text -> MParser ()
parseGateway Text
p
  Text -> MParser ()
parseRoutes Text
p
  Text -> MParser ()
parseDns Text
p
  Text -> MParser ()
parseDomain Text
p
  pure [a]
ipvs
{-# INLINEABLE parseAllIpInfo #-}

parseIps :: (Predicate p Text) => Text -> (Refined p Text -> a) -> MParser [a]
parseIps :: forall p a.
Predicate p Text =>
Text -> (Refined p Text -> a) -> MParser [a]
parseIps Text
p Refined p Text -> a
cons = do
  [Text]
addrs <- Text -> MParser [Text]
parseAddresses Text
p
  let xs :: Either RefineException [Refined p Text]
xs = (Text -> Either RefineException (Refined p Text))
-> [Text] -> Either RefineException [Refined p Text]
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Text -> Either RefineException (Refined p Text)
forall {k} (p :: k) x.
Predicate p x =>
x -> Either RefineException (Refined p x)
R.refine [Text]
addrs
  case Either RefineException [Refined p Text]
xs of
    Left RefineException
ex ->
      let errMsg :: String
          errMsg :: String
errMsg =
            Text -> String
T.unpack
              (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Malformed ipv"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" address found: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Show a => a -> Text
showt [Text]
addrs
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Error: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RefineException -> Text
forall a. Show a => a -> Text
showt RefineException
ex
       in Set (ErrorFancy Void) -> MParser [a]
forall e s (m :: Type -> Type) a.
MonadParsec e s m =>
Set (ErrorFancy e) -> m a
MP.fancyFailure (Set (ErrorFancy Void) -> MParser [a])
-> Set (ErrorFancy Void) -> MParser [a]
forall a b. (a -> b) -> a -> b
$ [ErrorFancy Void] -> Set (ErrorFancy Void)
forall a. Ord a => [a] -> Set a
Set.fromList [String -> ErrorFancy Void
forall e. String -> ErrorFancy e
ErrorFail String
errMsg]
    Right [Refined p Text]
xss -> [a] -> MParser [a]
forall a. a -> ParsecT Void Text Identity a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Refined p Text -> a
cons (Refined p Text -> a) -> [Refined p Text] -> [a]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Refined p Text]
xss)
{-# INLINEABLE parseIps #-}

parseAddresses :: Text -> MParser [Text]
parseAddresses :: Text -> MParser [Text]
parseAddresses = ParsecT Void Text Identity Text -> MParser [Text]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
MP.many (ParsecT Void Text Identity Text -> MParser [Text])
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> MParser [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall {s} {e}.
(Token s ~ Char, Stream s, Semigroup (Tokens s),
 IsString (Tokens s), Ord e) =>
Tokens s -> ParsecT e s Identity (Tokens s)
address
  where
    address :: Tokens s -> ParsecT e s Identity (Tokens s)
address Tokens s
p = do
      Tokens s -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string (Tokens s -> ParsecT e s Identity (Tokens s))
-> Tokens s -> ParsecT e s Identity (Tokens s)
forall a b. (a -> b) -> a -> b
$ Tokens s
"IP" Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
p Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
".ADDRESS["
      Maybe String
-> (Token s -> Bool) -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"address num") Char -> Bool
Token s -> Bool
Char.isDigit
      Tokens s -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string Tokens s
"]:"
      Tokens s
addr <- Maybe String
-> (Token s -> Bool) -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"address") (Token s -> Token s -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
Token s
'/')
      Token s -> ParsecT e s Identity (Token s)
forall e s (m :: Type -> Type).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
MPC.char Char
Token s
'/'
      ParsecT e s Identity (Tokens s)
forall e s.
(Ord e, Stream s, Token s ~ Char) =>
Parsec e s (Tokens s)
U.takeLine
      pure Tokens s
addr
{-# INLINEABLE parseAddresses #-}

parseGateway :: Text -> MParser ()
parseGateway :: Text -> MParser ()
parseGateway Text
p = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string (Text
"IP" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".GATEWAY:") ParsecT Void Text Identity (Tokens Text)
-> MParser () -> MParser ()
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> MParser ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseGateway #-}

parseRoutes :: Text -> MParser ()
parseRoutes :: Text -> MParser ()
parseRoutes = ParsecT Void Text Identity [()] -> MParser ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> MParser ())
-> (Text -> ParsecT Void Text Identity [()]) -> Text -> MParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MParser () -> ParsecT Void Text Identity [()]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
MP.many (MParser () -> ParsecT Void Text Identity [()])
-> (Text -> MParser ()) -> Text -> ParsecT Void Text Identity [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MParser ()
Tokens Text -> MParser ()
forall {s} {e}.
(Token s ~ Char, Stream s, Semigroup (Tokens s),
 IsString (Tokens s), Ord e) =>
Tokens s -> ParsecT e s Identity ()
route
  where
    route :: Tokens s -> ParsecT e s Identity ()
route Tokens s
p =
      Tokens s -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string (Tokens s
"IP" Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
p Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
".ROUTE[") ParsecT e s Identity (Tokens s)
-> ParsecT e s Identity () -> ParsecT e s Identity ()
forall a b.
ParsecT e s Identity a
-> ParsecT e s Identity b -> ParsecT e s Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT e s Identity ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseRoutes #-}

parseDns :: Text -> MParser ()
parseDns :: Text -> MParser ()
parseDns = ParsecT Void Text Identity [()] -> MParser ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> MParser ())
-> (Text -> ParsecT Void Text Identity [()]) -> Text -> MParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MParser () -> ParsecT Void Text Identity [()]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
MP.many (MParser () -> ParsecT Void Text Identity [()])
-> (Text -> MParser ()) -> Text -> ParsecT Void Text Identity [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MParser ()
Tokens Text -> MParser ()
forall {s} {e}.
(Token s ~ Char, Stream s, Semigroup (Tokens s),
 IsString (Tokens s), Ord e) =>
Tokens s -> ParsecT e s Identity ()
dns
  where
    dns :: Tokens s -> ParsecT e s Identity ()
dns Tokens s
p = Tokens s -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string (Tokens s
"IP" Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
p Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
".DNS[") ParsecT e s Identity (Tokens s)
-> ParsecT e s Identity () -> ParsecT e s Identity ()
forall a b.
ParsecT e s Identity a
-> ParsecT e s Identity b -> ParsecT e s Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT e s Identity ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseDns #-}

parseDomain :: Text -> MParser ()
parseDomain :: Text -> MParser ()
parseDomain = ParsecT Void Text Identity [()] -> MParser ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity [()] -> MParser ())
-> (Text -> ParsecT Void Text Identity [()]) -> Text -> MParser ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MParser () -> ParsecT Void Text Identity [()]
forall (m :: Type -> Type) a. MonadPlus m => m a -> m [a]
MP.many (MParser () -> ParsecT Void Text Identity [()])
-> (Text -> MParser ()) -> Text -> ParsecT Void Text Identity [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MParser ()
Tokens Text -> MParser ()
forall {s} {e}.
(Token s ~ Char, Stream s, Semigroup (Tokens s),
 IsString (Tokens s), Ord e) =>
Tokens s -> ParsecT e s Identity ()
dns
  where
    dns :: Tokens s -> ParsecT e s Identity ()
dns Tokens s
p = Tokens s -> ParsecT e s Identity (Tokens s)
forall e s (m :: Type -> Type).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MPC.string (Tokens s
"IP" Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
p Tokens s -> Tokens s -> Tokens s
forall a. Semigroup a => a -> a -> a
<> Tokens s
".DOMAIN[") ParsecT e s Identity (Tokens s)
-> ParsecT e s Identity () -> ParsecT e s Identity ()
forall a b.
ParsecT e s Identity a
-> ParsecT e s Identity b -> ParsecT e s Identity b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> ParsecT e s Identity ()
forall e s. (Ord e, Stream s, Token s ~ Char) => Parsec e s ()
U.takeLine_
{-# INLINEABLE parseDomain #-}