finishes lan support for the agent

agent/config/routes

@@ -39,6 +39,8 @@
 /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/disks                             DisksR                   GET
 /v0/disks/eject                       EjectR                   POST

agent/src/Application.hs

@@ -118,6 +118,7 @@ makeFoundation appSettings = do
     def                         <- getDefaultProcDevMetrics
     appProcDevMomentCache       <- newIORef (now, mempty, def)
     appLastTorRestart           <- newIORef now
+    appLanThreads               <- newTVarIO HM.empty
 
     -- 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,6 +75,7 @@ data AgentCtx = AgentCtx
     , appBackgroundJobs           :: TVar JobCache
     , appIconTags                 :: TVar (HM.HashMap AppId (Digest MD5))
     , appLastTorRestart           :: IORef UTCTime
+    , appLanThreads               :: TVar (HM.HashMap AppId (Async ()))
     }
 
 setWebProcessThreadId :: ThreadId -> AgentCtx -> IO ()

agent/src/Handler/Apps.hs

@@ -79,6 +79,8 @@ import           Lib.Types.ServerApp
 import           Model
 import           Settings
 import           Crypto.Hash
+import qualified Data.Text                     as Text
+import           Lib.Types.NetAddress
 
 pureLog :: Show a => a -> Handler a
 pureLog = liftA2 (*>) ($logInfo . show) pure
@@ -231,6 +233,7 @@ 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
@@ -244,6 +247,7 @@ getInstalledAppsLogic = do
                 , appInstalledPreviewStatus           = AppStatusTmp Installing
                 , appInstalledPreviewVersionInstalled = storeAppVersionInfoVersion
                 , appInstalledPreviewTorAddress       = Nothing
+                , appInstalledPreviewLanAddress       = Nothing
                 , appInstalledPreviewUi               = False
                 }
         installedPreviews = flip
@@ -254,6 +258,13 @@ getInstalledAppsLogic = do
                 , appInstalledPreviewStatus           = s
                 , appInstalledPreviewVersionInstalled = v
                 , appInstalledPreviewTorAddress       = infoResTorAddress
+                , appInstalledPreviewLanAddress       = if appId `HM.member` lanCache
+                                                            then
+                                                                LanAddress
+                                                                .   (".onion" `Text.replace` ".local")
+                                                                .   unTorAddress
+                                                                <$> infoResTorAddress
+                                                            else Nothing
                 , appInstalledPreviewUi               = AppManifest.uiAvailable infoResManifest
                 }
 
@@ -286,6 +297,7 @@ getInstalledAppByIdLogic appId = do
                 , appInstalledFullInstructions           = Nothing
                 , appInstalledFullLastBackup             = backupTime
                 , appInstalledFullTorAddress             = Nothing
+                , appInstalledFullLanAddress             = Nothing
                 , appInstalledFullConfiguredRequirements = []
                 , appInstalledFullUninstallAlert         = Nothing
                 , appInstalledFullRestoreAlert           = Nothing
@@ -319,15 +331,21 @@ getInstalledAppByIdLogic appId = do
             manifest     <- lift $ LAsync.wait manifest'
             instructions <- lift $ LAsync.wait instructions'
             backupTime   <- lift $ LAsync.wait backupTime'
+            lans         <- asks appLanThreads
+            lanEnabled   <- liftIO $ HM.member appId <$> readTVarIO lans
+            let lanAddress = if lanEnabled
+                    then LanAddress . (".onion" `Text.replace` ".local") . unTorAddress <$> infoResTorAddress
+                    else Nothing
             pure AppInstalledFull { appInstalledFullBase = AppBase appId infoResTitle (iconUrl appId version)
                                   , appInstalledFullStatus                 = status
                                   , appInstalledFullVersionInstalled       = version
                                   , appInstalledFullInstructions           = instructions
                                   , appInstalledFullLastBackup             = backupTime
                                   , appInstalledFullTorAddress             = infoResTorAddress
+                                  , appInstalledFullLanAddress             = lanAddress
                                   , appInstalledFullConfiguredRequirements = HM.elems requirements
-                                  , appInstalledFullUninstallAlert         = manifest >>= AppManifest.appManifestUninstallAlert
+                                  , appInstalledFullUninstallAlert = manifest >>= AppManifest.appManifestUninstallAlert
-                                  , appInstalledFullRestoreAlert           = manifest >>= AppManifest.appManifestRestoreAlert
+                                  , appInstalledFullRestoreAlert = manifest >>= AppManifest.appManifestRestoreAlert
                                   }
     runMaybeT (installing <|> installed) `orThrowM` NotFoundE "appId" (show appId)
 
@@ -769,3 +787,25 @@ dependencyInfoToDependencyRequirement asInstalled (base, status, AppMgr2.Depende
             let appDependencyRequirementReasonOptional = dependencyInfoReasonOptional
                 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

agent/src/Handler/Types/Apps.hs

@@ -45,6 +45,7 @@ data AppInstalledPreview = AppInstalledPreview
     , appInstalledPreviewStatus           :: AppStatus
     , appInstalledPreviewVersionInstalled :: Version
     , appInstalledPreviewTorAddress       :: Maybe TorAddress
+    , appInstalledPreviewLanAddress       :: Maybe LanAddress
     , appInstalledPreviewUi               :: Bool
     }
     deriving (Eq, Show)
@@ -129,6 +130,7 @@ data AppInstalledFull = AppInstalledFull
     , appInstalledFullStatus                 :: AppStatus
     , appInstalledFullVersionInstalled       :: Version
     , appInstalledFullTorAddress             :: Maybe TorAddress
+    , appInstalledFullLanAddress             :: Maybe LanAddress
     , appInstalledFullInstructions           :: Maybe Text
     , appInstalledFullLastBackup             :: Maybe UTCTime
     , appInstalledFullConfiguredRequirements :: [Stripped AppDependencyRequirement]

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

@@ -65,9 +65,8 @@ data InfoRes a = InfoRes
           :: Include
               (Either_ (DefaultEqSym1 'OnlyDependencies) (ElemSym1 'IncludeDependencies) a)
               (HM.HashMap AppId DependencyInfo)
-    , infoResManifest
+    , infoResManifest :: Include (Either_ (DefaultEqSym1 'OnlyManifest) (ElemSym1 'IncludeManifest) a) AppManifest
-          :: Include (Either_ (DefaultEqSym1 'OnlyManifest) (ElemSym1 'IncludeManifest) a) AppManifest
+    , infoResStatus   :: Include (Either_ (DefaultEqSym1 'OnlyStatus) (ElemSym1 'IncludeStatus) a) AppContainerStatus
-    , infoResStatus :: Include (Either_ (DefaultEqSym1 'OnlyStatus) (ElemSym1 'IncludeStatus) a) AppContainerStatus
     }
 instance SingI (a :: Either OnlyInfoFlag [IncludeInfoFlag]) => FromJSON (InfoRes a) where
     parseJSON = withObject "AppMgr Info/List Response" $ \o -> do
@@ -270,6 +269,7 @@ data AppMgr (m :: Type -> Type) k where
     -- Tor ::_
     Update ::DryRun -> AppId -> Maybe VersionRange -> AppMgr m BreakageMap
     -- Verify ::_
+    LanEnable ::AppId -> AppMgr m ()
 makeSmartConstructors ''AppMgr
 
 newtype AppMgrCliC m a = AppMgrCliC { runAppMgrCliC :: m a }
@@ -421,7 +421,8 @@ 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
-        R other -> AppMgrCliC $ alg (runAppMgrCliC . hdl) other ctx
+        (L (LanEnable appId)) -> readProcessInheritStderr "appmgr" ["lan", "enable", show appId] "" $> ctx
+        R other               -> AppMgrCliC $ alg (runAppMgrCliC . hdl) other ctx
         where
             versionSpec :: (IsString a, Semigroup a, ConvertText String a) => Maybe VersionRange -> a -> a
             versionSpec v = case v of

agent/src/Lib/Types/NetAddress.hs

@@ -7,6 +7,10 @@ newtype TorAddress = TorAddress { unTorAddress :: Text } deriving (Eq)
 instance Show TorAddress where
     show = toS . unTorAddress
 
+newtype LanAddress = LanAddress { unLanAddress :: Text } deriving (Eq)
+instance Show LanAddress where
+    show = toS . unLanAddress
+
 newtype LanIp = LanIp { unLanIp :: Text } deriving (Eq)
 instance Show LanIp where
     show = toS . unLanIp