mirror of
https://github.com/Start9Labs/start-os.git
synced 2026-03-30 12:11:56 +00:00
103 lines
4.7 KiB
Haskell
103 lines
4.7 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
module Lib.External.WpaSupplicant where
|
|
|
|
import Startlude
|
|
|
|
import Data.Bitraversable
|
|
import qualified Data.HashMap.Strict as HM
|
|
import Data.String.Interpolate.IsString
|
|
import qualified Data.Text as T
|
|
import System.Process
|
|
import Control.Concurrent.Async.Lifted
|
|
as LAsync
|
|
import Control.Monad.Trans.Control ( MonadBaseControl )
|
|
|
|
runWlan0 :: ReaderT Text m a -> m a
|
|
runWlan0 = flip runReaderT "wlan0"
|
|
|
|
isConnectedToEthernet :: MonadIO m => m Bool
|
|
isConnectedToEthernet = do
|
|
liftIO $ not . null . filter (T.isInfixOf "inet ") . lines . toS <$> readProcess "ifconfig" ["eth0"] ""
|
|
|
|
-- There be bug here: if you're in the US, and add a network in Sweden, you'll set your wpa supplicant to be looking for networks in Sweden.
|
|
-- so you won't be autoconnecting to anything in the US till you add another US guy.
|
|
addNetwork :: MonadIO m => Text -> Text -> Text -> ReaderT Interface m ()
|
|
addNetwork ssid psk country = do
|
|
interface <- ask
|
|
networkId <- checkNetwork ssid >>= \case
|
|
-- If the network already exists, we will update its password.
|
|
Just nId -> do
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "new_password", toS nId, [i|"#{psk}"|]] ""
|
|
pure nId
|
|
|
|
-- Otherwise we create the network in the wpa_supplicant
|
|
Nothing -> do
|
|
nId <- liftIO $ T.strip . toS <$> readProcess "wpa_cli" ["-i", toS interface, "add_network"] ""
|
|
void . liftIO $ readProcess "wpa_cli"
|
|
["-i", toS interface, "set_network", toS nId, "ssid", [i|"#{ssid}"|]]
|
|
""
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "set_network", toS nId, "psk", [i|"#{psk}"|]] ""
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "set_network", toS nId, "scan_ssid", "1"] ""
|
|
pure nId
|
|
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "set", "country", toS country] ""
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "enable_network", toS networkId] ""
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "save_config"] ""
|
|
|
|
removeNetwork :: MonadIO m => Text -> ReaderT Interface m ()
|
|
removeNetwork ssid = do
|
|
interface <- ask
|
|
checkNetwork ssid >>= \case
|
|
Nothing -> pure ()
|
|
Just x -> liftIO $ do
|
|
void $ readProcess "wpa_cli" ["-i", toS interface, "remove_network", [i|#{x}|]] ""
|
|
void $ readProcess "wpa_cli" ["-i", toS interface, "save_config"] ""
|
|
void $ readProcess "wpa_cli" ["-i", toS interface, "reconfigure"] ""
|
|
|
|
listNetworks :: MonadIO m => ReaderT Interface m [Text]
|
|
listNetworks = do
|
|
interface <- ask
|
|
liftIO $ mapMaybe (`atMay` 1) . drop 1 . fmap (T.splitOn "\t") . lines . toS <$> readProcess
|
|
"wpa_cli"
|
|
["-i", toS interface, "list_networks"]
|
|
""
|
|
|
|
type Interface = Text
|
|
getCurrentNetwork :: (MonadBaseControl IO m, MonadIO m) => ReaderT Interface m (Maybe Text)
|
|
getCurrentNetwork = do
|
|
interface <- ask @Text
|
|
liftIO $ guarded (/= "") . T.init . toS <$> readProcess "iwgetid" [toS interface, "--raw"] ""
|
|
|
|
selectNetwork :: (MonadBaseControl IO m, MonadIO m) => Text -> Text -> ReaderT Interface m Bool
|
|
selectNetwork ssid country = checkNetwork ssid >>= \case
|
|
Nothing -> putStrLn @Text "SSID Not Found" *> pure False
|
|
Just nId -> do
|
|
interface <- ask
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "select_network", toS nId] ""
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "set", "country", toS country] ""
|
|
void . liftIO $ readProcess "wpa_cli" ["-i", toS interface, "save_config"] ""
|
|
mNew <- join . hush <$> LAsync.race (liftIO $ threadDelay 20_000_000)
|
|
(runMaybeT . asum $ repeat (MaybeT getCurrentNetwork))
|
|
listNetworks >>= \nets ->
|
|
for_ nets $ \net -> liftIO $ readProcess "wpa_cli" ["-i", toS interface, "enable_network", toS net] ""
|
|
pure $ case mNew of
|
|
Nothing -> False
|
|
Just newCurrent -> newCurrent == ssid
|
|
|
|
type NetworkId = Text
|
|
checkNetwork :: MonadIO m => Text -> ReaderT Interface m (Maybe NetworkId)
|
|
checkNetwork ssid = do
|
|
interface <- ask
|
|
HM.lookup ssid
|
|
. HM.fromList
|
|
. mapMaybe (bisequenceA . ((`atMay` 1) &&& (`atMay` 0)))
|
|
. drop 1
|
|
. fmap (T.splitOn "\t")
|
|
. lines
|
|
. toS
|
|
<$> liftIO (readProcess "wpa_cli" ["-i", toS interface, "list_networks"] "")
|
|
|
|
-- TODO: Live Testing in GHCI
|
|
runWpa :: ReaderT Interface m a -> m a
|
|
runWpa = flip runReaderT "wlp5s0"
|