batches all lan addresses together

removes dbg

fixes clap docs

use actual log

removes service level enabling and disabling of lan

adds reset endpoint

reset lan on install/uninstall

agent/config/routes

@@ -39,10 +39,10 @@
 /v0/apps/#AppId/backup/stop           StopBackupR              POST
 /v0/apps/#AppId/backup/restore        RestoreBackupR           POST
 /v0/apps/#AppId/autoconfig/#AppId     AutoconfigureR           POST
-/v0/apps/#AppId/lan/enable            EnableLanR               POST
-/v0/apps/#AppId/lan/disable           DisableLanR              POST
 /v0/apps/#AppId/actions               ActionR                  POST
 
+/v0/network/lan/reset                 ResetLanR                POST
+
 /v0/disks                             DisksR                   GET
 /v0/disks/eject                       EjectR                   POST
 

agent/src/Application.hs

@@ -25,6 +25,7 @@ where
 
 import           Startlude               hiding (runReader)
 
+import           Control.Carrier.Lift           ( runM )
 import           Control.Concurrent.STM.TVar    ( newTVarIO )
 import           Control.Monad.Logger
 import           Control.Effect.Labelled        ( Labelled, runLabelled )
@@ -54,21 +55,23 @@ import           Yesod.Persist.Core
 import           Constants
 import qualified Daemon.AppNotifications       as AppNotifications
 import           Daemon.RefreshProcDev
+import qualified Daemon.SslRenew as SSLRenew
+import           Daemon.TorHealth
 import           Daemon.ZeroConf
 import           Foundation
+import qualified Lib.Algebra.Domain.AppMgr as AppMgr2
 import           Lib.Algebra.State.RegistryUrl
+import           Lib.Background
 import           Lib.Database
+import           Lib.Error
 import           Lib.External.Metrics.ProcDev
 import           Lib.SelfUpdate
 import           Lib.Sound
 import           Lib.SystemPaths
+import           Lib.Tor                        ( newTorManager )
 import           Lib.WebServer
 import           Model
 import           Settings
-import Lib.Background
-import qualified Daemon.SslRenew as SSLRenew
-import Lib.Tor (newTorManager)
-import Daemon.TorHealth
 
 appMain :: IO ()
 appMain = do
@@ -118,7 +121,7 @@ makeFoundation appSettings = do
     def                         <- getDefaultProcDevMetrics
     appProcDevMomentCache       <- newIORef (now, mempty, def)
     appLastTorRestart           <- newIORef now
-    appLanThreads               <- newTVarIO HM.empty
+    appLanThread                <- forkIO (void . runM . runExceptT @S9Error . AppMgr2.runAppMgrCliC $ AppMgr2.lanEnable) >>= newMVar
 
     -- We need a log function to create a connection pool. We need a connection
     -- pool to create our foundation. And we need our foundation to get a

agent/src/Foundation.hs

@@ -75,7 +75,7 @@ data AgentCtx = AgentCtx
     , appBackgroundJobs           :: TVar JobCache
     , appIconTags                 :: TVar (HM.HashMap AppId (Digest MD5))
     , appLastTorRestart           :: IORef UTCTime
-    , appLanThreads               :: TVar (HM.HashMap AppId (Async ()))
+    , appLanThread                :: MVar ThreadId
     }
 
 setWebProcessThreadId :: ThreadId -> AgentCtx -> IO ()

agent/src/Handler/Apps.hs

@@ -33,8 +33,10 @@ import           Control.Effect.Labelled        ( HasLabelled
 import           Control.Lens            hiding ( (??) )
 import           Control.Monad.Logger
 import           Control.Monad.Trans.Control    ( MonadBaseControl )
+import           Crypto.Hash
 import           Data.Aeson
 import           Data.Aeson.Lens
+import           Data.Aeson.Types               ( parseMaybe )
 import qualified Data.ByteString.Lazy          as LBS
 import           Data.IORef
 import qualified Data.HashMap.Lazy             as HML
@@ -45,12 +47,13 @@ import           Data.Singletons.Prelude.Bool   ( SBool(..)
                                                 , If
                                                 )
 import           Data.Singletons.Prelude.List   ( Elem )
-
+import qualified Data.Text                     as Text
 import           Database.Persist
 import           Database.Persist.Sql           ( ConnectionPool )
 import           Database.Persist.Sqlite        ( runSqlPool )
 import           Exinst
 import           Network.HTTP.Types
+import qualified Network.JSONRPC               as JSONRPC
 import           Yesod.Core.Content
 import           Yesod.Core.Json
 import           Yesod.Core.Handler      hiding ( cached )
@@ -60,6 +63,7 @@ import           Yesod.Persist.Core
 import           Foundation
 import           Handler.Backups
 import           Handler.Icons
+import           Handler.Network
 import           Handler.Types.Apps
 import           Handler.Util
 import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
@@ -75,14 +79,10 @@ import           Lib.SystemPaths
 import           Lib.TyFam.ConditionalData
 import           Lib.Types.Core
 import           Lib.Types.Emver
+import           Lib.Types.NetAddress
 import           Lib.Types.ServerApp
 import           Model
 import           Settings
-import           Crypto.Hash
-import qualified Data.Text                     as Text
-import           Lib.Types.NetAddress
-import qualified Network.JSONRPC               as JSONRPC
-import           Data.Aeson.Types               ( parseMaybe )
 
 pureLog :: Show a => a -> Handler a
 pureLog = liftA2 (*>) ($logInfo . show) pure
@@ -235,7 +235,6 @@ cached action = do
 getInstalledAppsLogic :: (Has (Reader AgentCtx) sig m, Has AppMgr2.AppMgr sig m, MonadIO m) => m [AppInstalledPreview]
 getInstalledAppsLogic = do
     jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    lanCache <- asks appLanThreads >>= liftIO . readTVarIO
     let installCache = installInfo . fst <$> inspect SInstalling jobCache
     serverApps <- AppMgr2.list [AppMgr2.flags|-s -d -m|]
     let remapped           = remapAppMgrInfo jobCache serverApps
@@ -250,7 +249,6 @@ getInstalledAppsLogic = do
                 , appInstalledPreviewVersionInstalled = storeAppVersionInfoVersion
                 , appInstalledPreviewTorAddress       = Nothing
                 , appInstalledPreviewLanAddress       = Nothing
-                , appInstalledPreviewLanEnabled       = Nothing
                 , appInstalledPreviewUi               = False
                 }
         installedPreviews = flip
@@ -263,7 +261,6 @@ getInstalledAppsLogic = do
                                         , appInstalledPreviewVersionInstalled = v
                                         , appInstalledPreviewTorAddress       = infoResTorAddress
                                         , appInstalledPreviewLanAddress       = lanAddress
-                                        , appInstalledPreviewLanEnabled       = lanAddress $> HM.member appId lanCache
                                         , appInstalledPreviewUi               = AppManifest.uiAvailable infoResManifest
                                         }
 
@@ -297,7 +294,6 @@ getInstalledAppByIdLogic appId = do
                 , appInstalledFullLastBackup             = backupTime
                 , appInstalledFullTorAddress             = Nothing
                 , appInstalledFullLanAddress             = Nothing
-                , appInstalledFullLanEnabled             = Nothing
                 , appInstalledFullConfiguredRequirements = []
                 , appInstalledFullUninstallAlert         = Nothing
                 , appInstalledFullRestoreAlert           = Nothing
@@ -332,7 +328,6 @@ getInstalledAppByIdLogic appId = do
             manifest     <- lift $ LAsync.wait manifest'
             instructions <- lift $ LAsync.wait instructions'
             backupTime   <- lift $ LAsync.wait backupTime'
-            lanCache     <- asks appLanThreads >>= liftIO . readTVarIO
             let lanAddress = LanAddress . (".onion" `Text.replace` ".local") . unTorAddress <$> infoResTorAddress
             pure AppInstalledFull { appInstalledFullBase = AppBase appId infoResTitle (iconUrl appId version)
                                   , appInstalledFullStatus = status
@@ -341,7 +336,6 @@ getInstalledAppByIdLogic appId = do
                                   , appInstalledFullLastBackup = backupTime
                                   , appInstalledFullTorAddress = infoResTorAddress
                                   , appInstalledFullLanAddress = lanAddress
-                                  , appInstalledFullLanEnabled = lanAddress $> HM.member appId lanCache
                                   , appInstalledFullConfiguredRequirements = HM.elems requirements
                                   , appInstalledFullUninstallAlert = manifest >>= AppManifest.appManifestUninstallAlert
                                   , appInstalledFullRestoreAlert = manifest >>= AppManifest.appManifestRestoreAlert
@@ -379,7 +373,9 @@ postUninstallAppLogic appId dryrun = do
     breakageIds <- HM.keys . AppMgr2.unBreakageMap <$> AppMgr2.remove flags appId
     bs <- pure (traverse (hydrate $ (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> serverApps) breakageIds)
         `orThrowM` InternalE "Reported app breakage for app that isn't installed, contact support"
-    when (not $ coerce dryrun) $ clearIcon appId
+    when (not $ coerce dryrun) $ do
+        clearIcon appId
+        postResetLanLogic
     pure $ WithBreakages bs ()
 
 type InstallResponse :: Bool -> Type
@@ -483,6 +479,7 @@ postInstallNewAppLogic appId appVersion dryrun = do
                                  (void $ Notifications.emit k infoResVersion (Notifications.RestartFailed e))
                                  pool
                 )
+            postResetLanLogic
 
 
 postStartServerAppR :: AppId -> Handler ()
@@ -788,28 +785,6 @@ dependencyInfoToDependencyRequirement asInstalled (base, status, AppMgr2.Depende
                 appDependencyRequirementDefault        = dependencyInfoRequired
             in  AppDependencyRequirement { .. }
 
-postEnableLanR :: AppId -> Handler ()
-postEnableLanR = intoHandler . postEnableLanLogic
-
-postEnableLanLogic :: (Has (Reader AgentCtx) sig m, Has AppMgr2.AppMgr sig m, MonadBaseControl IO m, MonadIO m)
-                   => AppId
-                   -> m ()
-postEnableLanLogic appId = do
-    cache  <- asks appLanThreads
-
-    action <- const () <<$>> LAsync.async (AppMgr2.lanEnable appId) -- unconditionally drops monad state from the action
-    liftIO $ atomically $ modifyTVar' cache (HM.insert appId action)
-
-postDisableLanR :: AppId -> Handler ()
-postDisableLanR = intoHandler . postDisableLanLogic
-
-postDisableLanLogic :: (Has (Reader AgentCtx) sig m, MonadBaseControl IO m, MonadIO m) => AppId -> m ()
-postDisableLanLogic appId = do
-    cache  <- asks appLanThreads
-    action <- liftIO . atomically $ stateTVar cache $ \s -> (HM.lookup appId s, HM.delete appId s)
-    case action of
-        Nothing -> pure () -- Nothing to do here
-        Just x  -> LAsync.cancel x
 postActionR :: AppId -> Handler (JSONResponse JSONRPC.Response)
 postActionR appId = do
     req <- requireCheckJsonBody

agent/src/Handler/Network.hs

@@ -0,0 +1,32 @@
+module Handler.Network where
+
+import           Startlude               hiding ( Reader
+                                                , asks
+                                                , runReader
+                                                )
+
+import           Control.Carrier.Lift           ( runM )
+import           Control.Effect.Error
+import           Control.Carrier.Reader
+import           Lib.Error
+import           Yesod.Core                     ( getYesod )
+
+import           Foundation
+import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
+import           Lib.Types.Core
+
+postResetLanR :: Handler ()
+postResetLanR = do
+    ctx <- getYesod
+    runM . handleS9ErrC . runReader ctx $ postResetLanLogic
+
+postResetLanLogic :: (MonadIO m, Has (Reader AgentCtx) sig m, Has (Error S9Error) sig m) => m ()
+postResetLanLogic = do
+    threadVar <- asks appLanThread
+    mtid      <- liftIO . tryTakeMVar $ threadVar
+    case mtid of
+        Nothing  -> throwError $ TemporarilyForbiddenE (AppId "LAN") "reset" "being reset"
+        Just tid -> liftIO $ do
+            killThread tid
+            newTid <- forkIO (void . runM . runExceptT @S9Error . AppMgr2.runAppMgrCliC $ AppMgr2.lanEnable)
+            putMVar threadVar newTid

agent/src/Handler/Types/Apps.hs

@@ -47,7 +47,6 @@ data AppInstalledPreview = AppInstalledPreview
     , appInstalledPreviewVersionInstalled :: Version
     , appInstalledPreviewTorAddress       :: Maybe TorAddress
     , appInstalledPreviewLanAddress       :: Maybe LanAddress
-    , appInstalledPreviewLanEnabled       :: Maybe Bool
     , appInstalledPreviewUi               :: Bool
     }
     deriving (Eq, Show)
@@ -57,7 +56,6 @@ instance ToJSON AppInstalledPreview where
         , "versionInstalled" .= appInstalledPreviewVersionInstalled
         , "torAddress" .= (unTorAddress <$> appInstalledPreviewTorAddress)
         , "lanAddress" .= (unLanAddress <$> appInstalledPreviewLanAddress)
-        , "lanEnabled" .= appInstalledPreviewLanEnabled
         , "ui" .= appInstalledPreviewUi
         ]
 
@@ -135,7 +133,6 @@ data AppInstalledFull = AppInstalledFull
     , appInstalledFullVersionInstalled       :: Version
     , appInstalledFullTorAddress             :: Maybe TorAddress
     , appInstalledFullLanAddress             :: Maybe LanAddress
-    , appInstalledFullLanEnabled             :: Maybe Bool
     , appInstalledFullInstructions           :: Maybe Text
     , appInstalledFullLastBackup             :: Maybe UTCTime
     , appInstalledFullConfiguredRequirements :: [Stripped AppDependencyRequirement]
@@ -150,7 +147,6 @@ instance ToJSON AppInstalledFull where
         , "configuredRequirements" .= appInstalledFullConfiguredRequirements
         , "torAddress" .= (unTorAddress <$> appInstalledFullTorAddress)
         , "lanAddress" .= (unLanAddress <$> appInstalledFullLanAddress)
-        , "lanEnabled" .= appInstalledFullLanEnabled
         , "id" .= appBaseId appInstalledFullBase
         , "title" .= appBaseTitle appInstalledFullBase
         , "iconURL" .= appBaseIconUrl appInstalledFullBase

agent/src/Lib/Algebra/Domain/AppMgr.hs

@@ -50,6 +50,7 @@ import           Control.Monad.Trans.Control    ( defaultLiftBaseWith
                                                 , MonadBaseControl(..)
                                                 )
 import qualified Data.ByteString.Char8         as C8
+import           System.Process
 
 
 type InfoRes :: Either OnlyInfoFlag [IncludeInfoFlag] -> Type
@@ -270,7 +271,7 @@ data AppMgr (m :: Type -> Type) k where
     -- Tor ::_
     Update ::DryRun -> AppId -> Maybe VersionRange -> AppMgr m BreakageMap
     -- Verify ::_
-    LanEnable ::AppId -> AppMgr m ()
+    LanEnable ::AppMgr m ()
     Action ::AppId -> Text -> AppMgr m (HM.HashMap Text Value)
 makeSmartConstructors ''AppMgr
 
@@ -423,7 +424,7 @@ instance (Has (Error S9Error) sig m, Algebra sig m, MonadIO m) => Algebra (AppMg
                 ExitFailure 6 ->
                     throwError $ NotFoundE "appId@version" ([i|#{appId}#{maybe "" (('@':) . show) version}|])
                 ExitFailure n -> throwError $ AppMgrE (toS $ String.unwords args) n
-        (L (LanEnable appId    )) -> readProcessInheritStderr "appmgr" ["lan", "enable", show appId] "" $> ctx
+        (L LanEnable            ) -> liftIO $ callProcess "appmgr" ["lan", "enable"] $> ctx
         (L (Action appId action)) -> do
             let args = ["actions", show appId, toS action]
             (ec, out) <- readProcessInheritStderr "appmgr" args ""

agent/src/Lib/WebServer.hs

@@ -45,6 +45,7 @@ import           Handler.Backups
 import           Handler.Hosts
 import           Handler.Icons
 import           Handler.Login
+import           Handler.Network
 import           Handler.Notifications
 import           Handler.PasswordUpdate
 import           Handler.PowerOff