{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE QuasiQuotes      #-}
{-# LANGUAGE RecordWildCards  #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE TupleSections    #-}
{-# LANGUAGE TypeApplications #-}
module Handler.Apps where

import           Startlude               hiding ( Reader
                                                , asks
                                                , catchError
                                                , empty
                                                , execState
                                                , forkFinally
                                                , modify
                                                , runReader
                                                )

import           Control.Carrier.Error.Church
import           Control.Carrier.Lift
import           Control.Carrier.Reader
import qualified Control.Concurrent.Async.Lifted
                                               as LAsync
import qualified Control.Concurrent.Lifted     as Lifted
import           Control.Concurrent.STM.TVar
import           Control.Effect.Empty    hiding ( guard )
import           Control.Effect.Labelled        ( HasLabelled
                                                , Labelled
                                                , runLabelled
                                                )
import qualified Control.Exception.Lifted      as Lifted
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 qualified Data.HashMap.Lazy             as HML
import qualified Data.HashMap.Strict           as HM
import           Data.IORef
import qualified Data.List.NonEmpty            as NE
import           Data.Singletons
import           Data.Singletons.Prelude.Bool   ( If
                                                , SBool(..)
                                                )
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.Handler      hiding ( cached )
import           Yesod.Core.Json
import           Yesod.Core.Types               ( JSONResponse(..) )
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
import           Lib.Algebra.State.RegistryUrl
import           Lib.Background
import           Lib.Error
import qualified Lib.External.AppManifest      as AppManifest
import qualified Lib.External.AppMgr           as AppMgr
import qualified Lib.External.Registry         as Reg
import           Lib.IconCache
import qualified Lib.Notifications             as Notifications
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

pureLog :: Show a => a -> Handler a
pureLog = liftA2 (*>) ($logInfo . show) pure

logRet :: ToJSON a => Handler a -> Handler a
logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . LBS.toStrict . encode) pure)

mkAppStatus :: HM.HashMap AppId (BackupJobType, a) -> AppId -> AppContainerStatus -> AppStatus
mkAppStatus hm appId status = case HM.lookup appId hm of
    Nothing                 -> AppStatusAppMgr status
    Just (CreateBackup , _) -> AppStatusTmp CreatingBackup
    Just (RestoreBackup, _) -> AppStatusTmp RestoringBackup


type AllEffects m
    = AppMgr2.AppMgrCliC
          ( RegistryUrlIOC
                ( Labelled
                      "iconTagCache"
                      (ReaderT (TVar (HM.HashMap AppId (Digest MD5))))
                      ( Labelled
                            "filesystemBase"
                            (ReaderT Text)
                            ( Labelled
                                  "databaseConnection"
                                  (ReaderT ConnectionPool)
                                  ( Labelled
                                        "lanThread"
                                        (ReaderT (MVar ThreadId))
                                        (ReaderT AgentCtx (ErrorC S9Error (LiftC m)))
                                  )
                            )
                      )
                )
          )

intoHandler :: AllEffects Handler x -> Handler x
intoHandler m = do
    ctx <- getYesod
    let fsbase = appFilesystemBase . appSettings $ ctx
    runM
        . handleS9ErrC
        . flip runReaderT ctx
        . flip runReaderT (appLanThread ctx)
        . runLabelled @"lanThread"
        . flip runReaderT (appConnPool ctx)
        . runLabelled @"databaseConnection"
        . flip runReaderT fsbase
        . runLabelled @"filesystemBase"
        . flip runReaderT (appIconTags ctx)
        . runLabelled @"iconTagCache"
        . runRegistryUrlIOC
        . AppMgr2.runAppMgrCliC
        $ m
{-# INLINE intoHandler #-}

-- TODO nasty. Also, note that if AppMgr.getInstalledApp fails for any app we will not return available apps res.
getAvailableAppsR :: Handler (JSONResponse [AppAvailablePreview])
getAvailableAppsR = disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getAvailableAppsLogic

getAvailableAppsLogic :: ( Has (Reader AgentCtx) sig m
                         , Has (Error S9Error) sig m
                         , Has RegistryUrl sig m
                         , Has AppMgr2.AppMgr sig m
                         , MonadIO m
                         , MonadBaseControl IO m
                         )
                      => m [AppAvailablePreview]
getAvailableAppsLogic = do
    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
    let installCache = inspect SInstalling jobCache
    (Reg.AppIndexRes apps, serverApps) <- LAsync.concurrently Reg.getAppIndex (AppMgr2.list [AppMgr2.flags|-s -d|])
    let remapped = remapAppMgrInfo jobCache serverApps
    pure $ foreach apps $ \app@StoreApp { storeAppId } ->
        let installing =
                (   (storeAppVersionInfoVersion . snd . installInfo &&& const (AppStatusTmp Installing))
                .   fst
                <$> HM.lookup storeAppId installCache
                )
            installed = ((view _2 &&& view _1) <$> HM.lookup storeAppId remapped)
        in  storeAppToAvailablePreview app $ installing <|> installed

getAvailableAppByIdR :: AppId -> Handler (JSONResponse AppAvailableFull)
getAvailableAppByIdR appId =
    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getAvailableAppByIdLogic appId

getAvailableAppByIdLogic :: ( Has (Reader AgentCtx) sig m
                            , Has (Error S9Error) sig m
                            , Has RegistryUrl sig m
                            , Has AppMgr2.AppMgr sig m
                            , MonadIO m
                            , MonadBaseControl IO m
                            )
                         => AppId
                         -> m AppAvailableFull
getAvailableAppByIdLogic appId = do
    let storeAppId' = storeAppId
    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
    let installCache = inspect SInstalling jobCache
    ((Reg.AppIndexRes storeApps, serverApps), AppManifest.AppManifest { appManifestLicenseName, appManifestLicenseLink }) <-
        LAsync.concurrently (LAsync.concurrently Reg.getAppIndex (AppMgr2.list [AppMgr2.flags|-s -d|]))
                            (Reg.getAppManifest appId)
    StoreApp {..} <- pure (find ((== appId) . storeAppId) storeApps) `orThrowM` NotFoundE "appId" (show appId)
    let remapped = remapAppMgrInfo jobCache serverApps
    let installingInfo =
            (   (storeAppVersionInfoVersion . snd . installInfo &&& const (AppStatusTmp Installing))
                .   fst
                <$> HM.lookup appId installCache
                )
                <|> ((view _2 &&& view _1) <$> HM.lookup appId remapped)
    let latest = extract storeAppVersions
    dependencies <- AppMgr2.checkDependencies (AppMgr2.LocalOnly False)
                                              appId
                                              (Just . exactly $ storeAppVersionInfoVersion latest)
    enrichedDeps <- maybe (throwError (NotFoundE "dependencyId for" (show appId))) pure $ flip
        HML.traverseWithKey
        dependencies
        \depId depInfo ->
            let
                base = storeAppToAppBase <$> find ((== depId) . storeAppId') storeApps
                status =
                    (HM.lookup depId installCache $> AppStatusTmp Installing) <|> (view _1 <$> HM.lookup depId remapped)
            in
                (, status, depInfo) <$> base
    let dependencyRequirements = fmap (dependencyInfoToDependencyRequirement (AsInstalled SFalse)) enrichedDeps
    pure AppAvailableFull
        { appAvailableFullBase                   = AppBase
                                                       appId
                                                       storeAppTitle
                                                       (storeIconUrl appId (storeAppVersionInfoVersion $ extract storeAppVersions))
        , appAvailableFullLicenseName            = appManifestLicenseName
        , appAvailableFullLicenseLink            = appManifestLicenseLink
        , appAvailableFullInstallInfo            = installingInfo
        , appAvailableFullVersionLatest          = storeAppVersionInfoVersion latest
        , appAvailableFullDescriptionShort       = storeAppDescriptionShort
        , appAvailableFullDescriptionLong        = storeAppDescriptionLong
        , appAvailableFullReleaseNotes           = storeAppVersionInfoReleaseNotes latest
        , appAvailableFullDependencyRequirements = HM.elems dependencyRequirements
        , appAvailableFullVersions               = storeAppVersionInfoVersion <$> storeAppVersions
        , appAvailableFullInstallAlert           = storeAppVersionInfoInstallAlert latest
        }

getAppLogsByIdR :: AppId -> Handler (JSONResponse [Text])
getAppLogsByIdR appId = disableEndpointOnFailedUpdate $ handleS9ErrT $ do
    logs <- AppMgr.getAppLogs appId
    pure . JSONResponse . lines $ logs

getInstalledAppsR :: Handler (JSONResponse [AppInstalledPreview])
getInstalledAppsR = disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getInstalledAppsLogic

cached :: MonadIO m => m a -> m (m a)
cached action = do
    ref <- liftIO $ newIORef Nothing
    pure $ liftIO (readIORef ref) >>= \case
        Nothing -> action >>= liftA2 (*>) (liftIO . writeIORef ref . Just) pure
        Just x  -> pure x

getInstalledAppsLogic :: (Has (Reader AgentCtx) sig m, Has AppMgr2.AppMgr sig m, MonadIO m) => m [AppInstalledPreview]
getInstalledAppsLogic = do
    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
    let installCache = installInfo . fst <$> inspect SInstalling jobCache
    serverApps <- AppMgr2.list [AppMgr2.flags|-s -d -m|]
    let remapped           = remapAppMgrInfo jobCache serverApps
        installingPreviews = flip
            HM.mapWithKey
            installCache
            \installingId (StoreApp {..}, StoreAppVersionInfo {..}) -> AppInstalledPreview
                { appInstalledPreviewBase             = AppBase installingId
                                                                storeAppTitle
                                                                (iconUrl installingId storeAppVersionInfoVersion)
                , appInstalledPreviewStatus           = AppStatusTmp Installing
                , appInstalledPreviewVersionInstalled = storeAppVersionInfoVersion
                , appInstalledPreviewTorAddress       = Nothing
                , appInstalledPreviewLanAddress       = Nothing
                , appInstalledPreviewTorUi            = False
                , appInstalledPreviewLanUi            = False
                }
        installedPreviews = flip
            HML.mapWithKey
            remapped
            \appId (s, v, AppMgr2.InfoRes {..}) ->
                let
                    mLanAddress = do -- Maybe
                        addrBase <- infoResTorAddress
                        let
                            lanConfs = mapMaybe AppManifest.portMapEntryLan
                                $ AppManifest.appManifestPortMapping infoResManifest
                        guard (not . null $ lanConfs)
                        pure $ LanAddress . (".onion" `Text.replace` ".local") . unTorAddress $ addrBase
                in  AppInstalledPreview { appInstalledPreviewBase = AppBase appId infoResTitle (iconUrl appId v)
                                        , appInstalledPreviewStatus = s
                                        , appInstalledPreviewVersionInstalled = v
                                        , appInstalledPreviewTorAddress = infoResTorAddress
                                        , appInstalledPreviewLanAddress = mLanAddress
                                        , appInstalledPreviewTorUi = AppManifest.torUiAvailable infoResManifest
                                        , appInstalledPreviewLanUi = AppManifest.lanUiAvailable infoResManifest
                                        }

    pure $ HML.elems $ HML.union installingPreviews installedPreviews

getInstalledAppByIdR :: AppId -> Handler (JSONResponse AppInstalledFull)
getInstalledAppByIdR appId =
    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getInstalledAppByIdLogic appId

getInstalledAppByIdLogic :: ( Has (Reader AgentCtx) sig m
                            , Has RegistryUrl sig m
                            , Has (Error S9Error) sig m
                            , Has AppMgr2.AppMgr sig m
                            , MonadIO m
                            , MonadBaseControl IO m
                            )
                         => AppId
                         -> m AppInstalledFull
getInstalledAppByIdLogic appId = do
    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
    let installCache = installInfo . fst <$> inspect SInstalling jobCache
    db          <- asks appConnPool
    backupTime' <- LAsync.async $ liftIO $ flip runSqlPool db $ getLastSuccessfulBackup appId
    let installing = do
            backupTime <- lift $ LAsync.wait backupTime'
            hoistMaybe $ HM.lookup appId installCache <&> \(StoreApp {..}, StoreAppVersionInfo {..}) -> AppInstalledFull
                { appInstalledFullBase = AppBase appId storeAppTitle (iconUrl appId storeAppVersionInfoVersion)
                , appInstalledFullLicenseName            = Nothing
                , appInstalledFullLicenseLink            = Nothing
                , appInstalledFullStatus                 = AppStatusTmp Installing
                , appInstalledFullVersionInstalled       = storeAppVersionInfoVersion
                , appInstalledFullInstructions           = Nothing
                , appInstalledFullLastBackup             = backupTime
                , appInstalledFullTorAddress             = Nothing
                , appInstalledFullLanAddress             = Nothing
                , appInstalledFullTorUi                  = False
                , appInstalledFullLanUi                  = False
                , appInstalledFullConfiguredRequirements = []
                , appInstalledFullUninstallAlert         = Nothing
                , appInstalledFullRestoreAlert           = Nothing
                , appInstalledFullStartAlert             = Nothing
                , appInstalledFullActions                = []
                }
    serverApps <- AppMgr2.list [AppMgr2.flags|-s -d|]
    let remapped = remapAppMgrInfo jobCache serverApps
    appManifestFetchCached <- cached Reg.getAppIndex
    let
        installed = do
            (status, version, AppMgr2.InfoRes {..}) <- hoistMaybe (HM.lookup appId remapped)
            manifest' <- lift $ LAsync.async $ AppMgr2.infoResManifest <<$>> AppMgr2.info [AppMgr2.flags|-M|] appId
            instructions'                           <- lift $ LAsync.async $ AppMgr2.instructions appId
            requirements                            <- LAsync.runConcurrently $ flip
                HML.traverseWithKey
                (HML.filter AppMgr2.dependencyInfoRequired infoResDependencies)
                \depId depInfo -> LAsync.Concurrently $ do
                    let
                        fromInstalled = (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion)
                            <$> hoistMaybe (HM.lookup depId serverApps)
                    let fromStore = do
                            Reg.AppIndexRes res <- lift appManifestFetchCached
                            (storeAppTitle &&& storeAppVersionInfoVersion . extract . storeAppVersions)
                                <$> hoistMaybe (find ((== depId) . storeAppId) res)
                    (title, v) <- fromInstalled <|> fromStore
                    let base = AppBase depId title (iconUrl depId v)
                    let
                        depStatus =
                            (HM.lookup depId installCache $> AppStatusTmp Installing)
                                <|> (view _1 <$> HM.lookup depId remapped)
                    pure $ dependencyInfoToDependencyRequirement (AsInstalled STrue) (base, depStatus, depInfo)
            manifest <- (lift $ LAsync.wait manifest') >>= \case
                Nothing -> throwError $ NotFoundE "manifest" (show appId)
                Just x  -> pure x
            instructions <- lift $ LAsync.wait instructions'
            backupTime   <- lift $ LAsync.wait backupTime'
            let lanAddress = do
                    addrBase <- infoResTorAddress
                    let lanConfs = mapMaybe AppManifest.portMapEntryLan $ AppManifest.appManifestPortMapping manifest
                    guard (not . null $ lanConfs)
                    pure $ LanAddress . (".onion" `Text.replace` ".local") . unTorAddress $ addrBase
            pure AppInstalledFull { appInstalledFullBase = AppBase appId infoResTitle (iconUrl appId version)
                                  , appInstalledFullLicenseName            = AppManifest.appManifestLicenseName manifest
                                  , appInstalledFullLicenseLink            = AppManifest.appManifestLicenseLink manifest
                                  , appInstalledFullStatus                 = status
                                  , appInstalledFullVersionInstalled       = version
                                  , appInstalledFullInstructions           = instructions
                                  , appInstalledFullLastBackup             = backupTime
                                  , appInstalledFullTorAddress             = infoResTorAddress
                                  , appInstalledFullLanAddress             = lanAddress
                                  , appInstalledFullTorUi                  = AppManifest.torUiAvailable manifest
                                  , appInstalledFullLanUi                  = AppManifest.lanUiAvailable manifest
                                  , appInstalledFullConfiguredRequirements = HM.elems requirements
                                  , appInstalledFullUninstallAlert = AppManifest.appManifestUninstallAlert manifest
                                  , appInstalledFullRestoreAlert = AppManifest.appManifestRestoreAlert manifest
                                  , appInstalledFullStartAlert             = AppManifest.appManifestStartAlert manifest
                                  , appInstalledFullActions                = AppManifest.appManifestActions manifest
                                  }
    runMaybeT (installing <|> installed) `orThrowM` NotFoundE "appId" (show appId)

postUninstallAppR :: AppId -> Handler (JSONResponse (WithBreakages ()))
postUninstallAppR appId = do
    dry <- AppMgr2.DryRun . isJust <$> lookupGetParam "dryrun"
    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> postUninstallAppLogic appId dry

postUninstallAppLogic :: ( HasFilesystemBase sig m
                         , Has (Reader AgentCtx) sig m
                         , Has (Error S9Error) sig m
                         , Has AppMgr2.AppMgr sig m
                         , MonadIO m
                         , HasLabelled "databaseConnection" (Reader ConnectionPool) sig m
                         , HasLabelled "iconTagCache" (Reader (TVar (HM.HashMap AppId (Digest MD5)))) sig m
                         , HasLabelled "lanThread" (Reader (MVar ThreadId)) sig m
                         )
                      => AppId
                      -> AppMgr2.DryRun
                      -> m (WithBreakages ())
postUninstallAppLogic appId dryrun = do
    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
    let tmpStatuses = statuses jobCache
    serverApps <- AppMgr2.list [AppMgr2.flags| |]
    when (not $ HM.member appId serverApps) $ throwError (AppNotInstalledE appId)
    case HM.lookup appId tmpStatuses of
        Just Installing      -> throwError (TemporarilyForbiddenE appId "uninstall" (show Installing))
        Just CreatingBackup  -> throwError (TemporarilyForbiddenE appId "uninstall" (show CreatingBackup))
        Just RestoringBackup -> throwError (TemporarilyForbiddenE appId "uninstall" (show RestoringBackup))
        _                    -> pure ()
    let flags = if coerce dryrun then Left dryrun else Right (AppMgr2.Purge True)
    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) $ do
        clearIcon appId
        postResetLanLogic
    pure $ WithBreakages bs ()

type InstallResponse :: Bool -> Type
data InstallResponse a = InstallResponse (If a (WithBreakages ()) AppInstalledFull)
instance ToJSON (Some1 InstallResponse) where
    toJSON (Some1 STrue  (InstallResponse a)) = toJSON a
    toJSON (Some1 SFalse (InstallResponse a)) = toJSON a
postInstallNewAppR :: AppId -> Handler (JSONResponse (Some1 InstallResponse))
postInstallNewAppR appId = do
    dryrun <- isJust <$> lookupGetParam "dryrun"
    InstallNewAppReq { installNewAppVersion } <- requireCheckJsonBody
    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> do
        withSomeSing dryrun $ \sb -> Some1 sb . InstallResponse <$> postInstallNewAppLogic appId installNewAppVersion sb

postInstallNewAppLogic :: forall sig m a
                        . ( Has (Reader AgentCtx) sig m
                          , HasLabelled "lanThread" (Reader (MVar ThreadId)) sig m
                          , HasLabelled "databaseConnection" (Reader ConnectionPool) sig m
                          , HasLabelled "iconTagCache" (Reader (TVar (HM.HashMap AppId (Digest MD5)))) sig m
                          , Has (Error S9Error) sig m
                          , Has RegistryUrl sig m
                          , Has AppMgr2.AppMgr sig m
                          , HasFilesystemBase sig m
                          , MonadIO m
                          , MonadBaseControl IO m
                          )
                       => AppId
                       -> Version
                       -> SBool a
                       -> m (If a (WithBreakages ()) AppInstalledFull)
postInstallNewAppLogic appId appVersion dryrun = do
    db   <- asks appConnPool
    full <- (Just <$> getInstalledAppByIdLogic appId) `catchError` \case
        NotFoundE "appId" appId' ->
            if AppId appId' == appId then pure Nothing else throwError (NotFoundE "appId" appId')
        other -> throwError other
    case full of
        Just aif@AppInstalledFull{} -> if appInstalledFullVersionInstalled aif == appVersion
            then pure $ case dryrun of
                STrue  -> WithBreakages [] ()
                SFalse -> aif
            else installIt db True
        Nothing -> installIt db False
    where
        installIt :: ConnectionPool -> Bool -> m (If a (WithBreakages ()) AppInstalledFull)
        installIt db isUpdate = do
            jobCacheTVar                <- asks appBackgroundJobs
            store@StoreApp {..}         <- Reg.getStoreAppInfo appId `orThrowM` NotFoundE "appId" (show appId)
            vinfo@StoreAppVersionInfo{} <-
                find ((== appVersion) . storeAppVersionInfoVersion) storeAppVersions
                    `orThrowPure` NotFoundE "version" (show appVersion)
            -- if it is a dry run of an update we don't want to modify the cache
            case dryrun of
                STrue -> if not isUpdate
                    then pure $ WithBreakages [] ()
                    else do
                        serverApps' <- LAsync.async $ AppMgr2.list [AppMgr2.flags| |]
                        hm          <- AppMgr2.update (AppMgr2.DryRun True) appId (Just $ exactly appVersion)
                        (serverApps :: HM.HashMap AppId (AppMgr2.InfoRes ( 'Right '[]))) <- LAsync.wait serverApps'
                        breakages   <-
                            traverse (hydrate ((AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> serverApps))
                                     (HM.keys $ AppMgr2.unBreakageMap hm)
                                `orThrowPure` InternalE
                                                  "Breakage reported for app that isn't installed, contact support"
                        pure $ WithBreakages breakages ()
                SFalse -> do
                    let
                        action = do
                            iconAction <- LAsync.async $ saveIcon (toS storeAppIconUrl)
                            let install = if isUpdate
                                    then void $ AppMgr2.update (AppMgr2.DryRun False) appId (Just $ exactly appVersion)
                                    else AppMgr2.install (AppMgr2.NoCache True) appId (Just $ exactly appVersion)
                            let
                                success = liftIO $ void $ flip runSqlPool db $ Notifications.emit
                                    appId
                                    appVersion
                                    Notifications.InstallSuccess
                            let failure e = liftIO $ do
                                    let notif = case e of
                                            AppMgrE _ ec -> Notifications.InstallFailedAppMgrExitCode ec
                                            _            -> Notifications.InstallFailedS9Error e
                                    void $ flip runSqlPool db $ Notifications.emit appId appVersion notif
                                    putStrLn @Text (show e)
                            let todo = do
                                    install
                                    () <- LAsync.wait iconAction
                                    success
                            todo `catchError` failure
                    tid <- action `Lifted.forkFinally` const postInstall
                    liftIO $ atomically $ modifyTVar' jobCacheTVar (insertJob appId (Install store vinfo) tid)
                    getInstalledAppByIdLogic appId
        postInstall :: m ()
        postInstall = do
            jobCache <- asks appBackgroundJobs
            pool     <- asks appConnPool
            liftIO . atomically $ modifyTVar jobCache (deleteJob appId)
            ls <- AppMgr2.list [AppMgr2.flags| |]
            LAsync.forConcurrently_ (HM.toList ls) $ \(k, AppMgr2.InfoRes {..}) -> when
                infoResNeedsRestart
                (            postRestartServerAppLogic k
                `catchError` \e -> liftIO $ runSqlPool
                                 (void $ Notifications.emit k infoResVersion (Notifications.RestartFailed e))
                                 pool
                )
            postResetLanLogic


postStartServerAppR :: AppId -> Handler ()
postStartServerAppR appId = disableEndpointOnFailedUpdate . intoHandler $ postStartServerAppLogic appId

postStartServerAppLogic :: (Has (Error S9Error) sig m, Has AppMgr2.AppMgr sig m, Has (Reader AgentCtx) sig m, MonadIO m)
                        => AppId
                        -> m ()
postStartServerAppLogic appId = do
    jobCache       <- asks appBackgroundJobs >>= liftIO . readTVarIO
    info           <- AppMgr2.info [AppMgr2.flags|-s -d|] appId `orThrowM` AppNotInstalledE appId
    (status, _, _) <- (HM.lookup appId $ remapAppMgrInfo jobCache (HM.singleton appId info))
        `orThrowPure` InternalE "Remapping magically deleted keys between source and target structures"
    case status of
        AppStatusAppMgr Stopped -> AppMgr2.start appId
        other                   -> throwError $ AppStateActionIncompatibleE appId other Start

postRestartServerAppR :: AppId -> Handler ()
postRestartServerAppR appId = disableEndpointOnFailedUpdate . intoHandler $ postRestartServerAppLogic appId

postRestartServerAppLogic :: ( Has (Reader AgentCtx) sig m
                             , Has AppMgr2.AppMgr sig m
                             , Has (Error S9Error) sig m
                             , MonadBaseControl IO m
                             , MonadIO m
                             )
                          => AppId
                          -> m ()
postRestartServerAppLogic appId = do
    jobCache <- asks appBackgroundJobs
    answer   <- Lifted.newEmptyMVar
    void . Lifted.fork $ do
        tid     <- Lifted.myThreadId
        problem <- liftIO . atomically $ do
            JobCache jobs <- readTVar jobCache
            case HM.lookup appId jobs of
                Just (Some1 s _, _) -> pure (Just . throwError $ TemporarilyForbiddenE appId "restart" (show s))
                Nothing             -> do
                    modifyTVar jobCache (insertJob appId RestartApp tid)
                    pure Nothing
        case problem of
            Nothing -> do
                AppMgr2.restart appId `Lifted.finally` (liftIO . atomically) (modifyTVar jobCache (deleteJob appId))
                Lifted.putMVar answer Nothing
            Just p -> Lifted.putMVar answer (Just p)
    Lifted.takeMVar answer >>= \case
        Nothing -> pure ()
        Just p  -> p


postStopServerAppR :: AppId -> Handler (JSONResponse (WithBreakages ()))
postStopServerAppR appId = disableEndpointOnFailedUpdate do
    dryrun <- isJust <$> lookupGetParam "dryrun"
    mRes   <- intoHandler $ runMaybeT (JSONResponse <$> postStopServerAppLogic appId (AppMgr2.DryRun dryrun))
    case mRes of
        Nothing -> sendResponseStatus status200 ()
        Just x  -> pure x

postStopServerAppLogic :: ( Has Empty sig m
                          , Has (Reader AgentCtx) sig m
                          , Has (Error S9Error) sig m
                          , Has AppMgr2.AppMgr sig m
                          , MonadIO m
                          , MonadBaseControl IO m
                          )
                       => AppId
                       -> AppMgr2.DryRun
                       -> m (WithBreakages ())
postStopServerAppLogic appId dryrun = do
    jobCache <- asks appBackgroundJobs
    titles   <- (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <<$>> AppMgr2.list [AppMgr2.flags| |]
    let stopIt = do
            breakages <- AppMgr2.stop dryrun appId
            bases     <- traverse (hydrate titles) (HM.keys $ AppMgr2.unBreakageMap breakages)
                `orThrowPure` InternalE "Breakages reported for app that isn't installed, contact support"
            pure $ WithBreakages bases ()
    status <- AppMgr2.infoResStatus <<$>> AppMgr2.info [AppMgr2.flags|-S|] appId
    case (dryrun, status) of
        (_                   , Nothing     ) -> throwError $ NotFoundE "appId" (show appId)
        (AppMgr2.DryRun False, Just Running) -> do
            tid <- (void stopIt)
                `Lifted.forkFinally` const ((liftIO . atomically) (modifyTVar jobCache (deleteJob appId)))
            liftIO . atomically $ modifyTVar jobCache (insertJob appId StopApp tid)
            empty
        (AppMgr2.DryRun True , Just Running   ) -> stopIt
        (AppMgr2.DryRun False, Just Restarting) -> do
            tid <- (void stopIt)
                `Lifted.forkFinally` const ((liftIO . atomically) (modifyTVar jobCache (deleteJob appId)))
            liftIO . atomically $ modifyTVar jobCache (insertJob appId StopApp tid)
            empty
        (AppMgr2.DryRun True, Just Restarting) -> stopIt
        (_, Just other) -> throwError $ AppStateActionIncompatibleE appId (AppStatusAppMgr other) Stop

getAppConfigR :: AppId -> Handler TypedContent
getAppConfigR =
    disableEndpointOnFailedUpdate
        . handleS9ErrT
        . fmap (TypedContent typeJson . toContent)
        . AppMgr.getConfigurationAndSpec

patchAppConfigR :: AppId -> Handler (JSONResponse (WithBreakages ()))
patchAppConfigR appId = disableEndpointOnFailedUpdate $ do
    dryrun  <- isJust <$> lookupGetParam "dryrun"
    value   <- requireCheckJsonBody @_ @Value
    realVal <-
        runM . handleS9ErrC $ ((value ^? key "config") `orThrowPure` (InvalidRequestE value "Missing 'config' key"))
    intoHandler $ JSONResponse <$> patchAppConfigLogic appId (AppMgr2.DryRun dryrun) realVal

patchAppConfigLogic :: ( Has (Reader AgentCtx) sig m
                       , Has (Error S9Error) sig m
                       , Has AppMgr2.AppMgr sig m
                       , MonadBaseControl IO m
                       , MonadIO m
                       )
                    => AppId
                    -> AppMgr2.DryRun
                    -> Value
                    -> m (WithBreakages ())
patchAppConfigLogic appId dryrun cfg = do
    serverApps                <- AppMgr2.list [AppMgr2.flags| |]
    AppMgr2.ConfigureRes {..} <- AppMgr2.configure dryrun appId (Just cfg)
    when (not $ coerce dryrun) $ for_ configureResNeedsRestart postRestartServerAppLogic
    breakages <-
        traverse (hydrate ((AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> serverApps))
                 (HM.keys configureResStopped)
            `orThrowPure` InternalE "Breakage reported for app that is not installed, contact support"
    pure $ WithBreakages breakages ()


getAppNotificationsR :: AppId -> Handler (JSONResponse [Entity Notification])
getAppNotificationsR appId = disableEndpointOnFailedUpdate $ runDB $ do
    page     <- lookupGetParam "page" `orDefaultTo` 1
    pageSize <- lookupGetParam "perPage" `orDefaultTo` 20
    evs      <- selectList [NotificationAppId ==. appId]
                           [Desc NotificationCreatedAt, LimitTo pageSize, OffsetBy ((page - 1) * pageSize)]
    let toArchive = fmap entityKey $ filter ((== Nothing) . notificationArchivedAt . entityVal) evs
    void $ Notifications.archive toArchive
    pure $ JSONResponse evs
    where
        orDefaultTo :: (Monad m, Read a) => m (Maybe Text) -> a -> m a
        orDefaultTo m a = do
            m' <- m
            case m' >>= readMaybe . toS of
                Nothing -> pure a
                Just x  -> pure x

getAppMetricsR :: AppId -> Handler TypedContent
getAppMetricsR appId =
    disableEndpointOnFailedUpdate . handleS9ErrT $ fmap (TypedContent typeJson . toContent) $ AppMgr.stats appId

getAvailableAppVersionInfoR :: AppId -> VersionRange -> Handler (JSONResponse AppVersionInfo)
getAvailableAppVersionInfoR appId version =
    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getAvailableAppVersionInfoLogic appId version

getAvailableAppVersionInfoLogic :: ( Has (Reader AgentCtx) sig m
                                   , Has (Error S9Error) sig m
                                   , Has RegistryUrl sig m
                                   , Has AppMgr2.AppMgr sig m
                                   , MonadIO m
                                   , MonadBaseControl IO m
                                   )
                                => AppId
                                -> VersionRange
                                -> m AppVersionInfo
getAvailableAppVersionInfoLogic appId appVersionSpec = do
    jobCache                  <- asks appBackgroundJobs >>= liftIO . readTVarIO
    Reg.AppIndexRes storeApps <- Reg.getAppIndex
    let titles =
            (storeAppTitle &&& storeAppVersionInfoVersion . extract . storeAppVersions) <$> indexBy storeAppId storeApps
    StoreApp {..} <- find ((== appId) . storeAppId) storeApps `orThrowPure` NotFoundE "appId" (show appId)
    serverApps    <- AppMgr2.list [AppMgr2.flags|-s -d|]
    let remapped = remapAppMgrInfo jobCache serverApps
    StoreAppVersionInfo {..} <-
        maximumMay (NE.filter ((<|| appVersionSpec) . storeAppVersionInfoVersion) storeAppVersions)
            `orThrowPure` NotFoundE "version spec " (show appVersionSpec)
    dependencies <- AppMgr2.checkDependencies (AppMgr2.LocalOnly False)
                                              appId
                                              (Just $ exactly storeAppVersionInfoVersion)
    requirements <- flip HML.traverseWithKey dependencies $ \depId depInfo -> do
        base <- hydrate titles depId `orThrowPure` NotFoundE "metadata for" (show depId)
        let status =
                (HM.lookup depId (inspect SInstalling jobCache) $> AppStatusTmp Installing)
                    <|> (view _1 <$> HM.lookup depId remapped)
        pure $ dependencyInfoToDependencyRequirement (AsInstalled SFalse) (base, status, depInfo)
    pure AppVersionInfo { appVersionInfoVersion                = storeAppVersionInfoVersion
                        , appVersionInfoReleaseNotes           = storeAppVersionInfoReleaseNotes
                        , appVersionInfoDependencyRequirements = HM.elems requirements
                        , appVersionInfoInstallAlert           = storeAppVersionInfoInstallAlert
                        }

postAutoconfigureR :: AppId -> AppId -> Handler (JSONResponse (WithBreakages AutoconfigureChangesRes))
postAutoconfigureR dependency dependent = do
    dry <- AppMgr2.DryRun . isJust <$> lookupGetParam "dryrun"
    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> postAutoconfigureLogic dependency dependent dry

postAutoconfigureLogic :: ( Has (Reader AgentCtx) sig m
                          , Has AppMgr2.AppMgr sig m
                          , Has (Error S9Error) sig m
                          , MonadBaseControl IO m
                          , MonadIO m
                          )
                       => AppId
                       -> AppId
                       -> AppMgr2.DryRun
                       -> m (WithBreakages AutoconfigureChangesRes)
postAutoconfigureLogic dependency dependent dry = do
    -- IMPORTANT! AppMgr reverses arguments from the endpoint
    appData <- AppMgr2.list [AppMgr2.flags| |]
    let apps = HM.keys appData
    case (dependency `elem` apps, dependent `elem` apps) of
        (False, _    ) -> throwError $ NotFoundE "appId" (show dependency)
        (_    , False) -> throwError $ NotFoundE "appId" (show dependent)
        _              -> pure ()
    AppMgr2.AutoconfigureRes {..} <- AppMgr2.autoconfigure dry dependent dependency
    when (not $ coerce dry) $ for_ (AppMgr2.configureResNeedsRestart autoconfigureConfigRes) postRestartServerAppLogic
    let titles = (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> appData
    bases <- traverse (hydrate titles) (HM.keys (AppMgr2.configureResStopped autoconfigureConfigRes))
        `orThrowPure` InternalE "Breakages reported for app that isn't installed, contact support"
    pure $ WithBreakages bases (AutoconfigureChangesRes $ HM.lookup dependency autoconfigureChanged)

indexBy :: (Eq k, Hashable k) => (v -> k) -> [v] -> HM.HashMap k v
indexBy = flip foldr HM.empty . (>>= HM.insertWith const)
{-# INLINE indexBy #-}

hydrate :: HM.HashMap AppId (Text, Version) -> AppId -> Maybe AppBase
hydrate titles appId = HM.lookup appId titles <&> \(t, v) -> AppBase appId t (iconUrl appId v)

remapAppMgrInfo :: (Elem 'AppMgr2.IncludeDependencies ls ~ 'True, Elem 'AppMgr2.IncludeStatus ls ~ 'True)
                => JobCache
                -> HM.HashMap AppId (AppMgr2.InfoRes ( 'Right ls)) -- ^ AppMgr response
                -> HM.HashMap AppId (AppStatus, Version, AppMgr2.InfoRes ( 'Right ls))
remapAppMgrInfo jobCache serverApps = flip
    HML.mapWithKey
    serverApps
    \appId infoRes@AppMgr2.InfoRes {..} ->
        let refinedDepInfo = flip
                HML.mapWithKey
                infoResDependencies
                \depId depInfo ->
                    case
                            ( HM.lookup depId tmpStatuses
                            , AppMgr2.infoResStatus <$> HM.lookup depId serverApps
                            , AppMgr2.dependencyInfoError depInfo
                            )
                        of
                            -- mute all of the not-running violations that are currently backing up and container is paused
                            (Just CreatingBackup, Just Paused, Just AppMgr2.NotRunning) ->
                                depInfo { AppMgr2.dependencyInfoError = Nothing }
                            (_, _, _) -> depInfo
            realViolations =
                any (isJust . AppMgr2.dependencyInfoError <&&> AppMgr2.dependencyInfoRequired) refinedDepInfo
            (status, version) =
                maybe (AppStatusAppMgr infoResStatus, infoResVersion) (first AppStatusTmp)
                    $   ((, infoResVersion) <$> HM.lookup appId tmpStatuses)
                    <|> (guard (not infoResIsConfigured || infoResIsRecoverable) $> (NeedsConfig, infoResVersion))
                    <|> (guard realViolations $> (BrokenDependencies, infoResVersion))
        in  ( status
            , version
            , infoRes
                { AppMgr2.infoResDependencies = case status of
                                                    AppStatusTmp NeedsConfig -> HM.empty
                                                    _                        -> refinedDepInfo
                }
            )
    where tmpStatuses = statuses jobCache

storeAppToAppBase :: StoreApp -> AppBase
storeAppToAppBase StoreApp {..} =
    AppBase storeAppId storeAppTitle (storeIconUrl storeAppId (storeAppVersionInfoVersion $ extract storeAppVersions))

storeAppToAvailablePreview :: StoreApp -> Maybe (Version, AppStatus) -> AppAvailablePreview
storeAppToAvailablePreview s@StoreApp {..} installed = AppAvailablePreview
    (storeAppToAppBase s)
    (storeAppVersionInfoVersion $ extract storeAppVersions)
    storeAppDescriptionShort
    installed
    storeAppTimestamp

type AsInstalled :: Bool -> Type
newtype AsInstalled a = AsInstalled { unAsInstalled :: SBool a }
dependencyInfoToDependencyRequirement :: AsInstalled a
                                      -> (AppBase, Maybe AppStatus, AppMgr2.DependencyInfo)
                                      -> (AppDependencyRequirement (If a Strip Keep))
dependencyInfoToDependencyRequirement asInstalled (base, status, AppMgr2.DependencyInfo {..}) = do
    let appDependencyRequirementBase        = base
    let appDependencyRequirementDescription = dependencyInfoDescription
    let appDependencyRequirementVersionSpec = dependencyInfoVersionSpec
    let appDependencyRequirementViolation = case (status, dependencyInfoError) of
            (Just s@(AppStatusTmp Installing), _) -> Just $ IncompatibleStatus s
            (Nothing, _                        ) -> Just Missing
            (_      , Just AppMgr2.NotInstalled) -> Just Missing
            (_, Just (AppMgr2.InvalidVersion _ _)) -> Just IncompatibleVersion
            (_, Just (AppMgr2.UnsatisfiedConfig reasons)) -> Just . IncompatibleConfig $ reasons
            (Just s , Just AppMgr2.NotRunning  ) -> Just $ IncompatibleStatus s
            (_      , Nothing                  ) -> Nothing
    case asInstalled of
        AsInstalled STrue ->
            let appDependencyRequirementReasonOptional = ()
                appDependencyRequirementDefault        = ()
            in  AppDependencyRequirement { .. }
        AsInstalled SFalse ->
            let appDependencyRequirementReasonOptional = dependencyInfoReasonOptional
                appDependencyRequirementDefault        = dependencyInfoRequired
            in  AppDependencyRequirement { .. }

postActionR :: AppId -> Handler (JSONResponse JSONRPC.Response)
postActionR appId = do
    req <- requireCheckJsonBody
    fmap JSONResponse . intoHandler $ postActionLogic appId req

postActionLogic :: (Has (Error S9Error) sig m, Has AppMgr2.AppMgr sig m)
                => AppId
                -> JSONRPC.Request
                -> m JSONRPC.Response
postActionLogic appId (JSONRPC.Request { getReqMethod, getReqId }) = do
    hm <- AppMgr2.action appId getReqMethod
    case (HM.lookup "result" hm, HM.lookup "error" hm >>= parseMaybe parseJSON) of
        (Just v , _      ) -> pure (JSONRPC.Response JSONRPC.V2 v getReqId)
        (_      , Just e ) -> pure (JSONRPC.ResponseError JSONRPC.V2 e getReqId)
        (Nothing, Nothing) -> throwError
            $ AppMgrParseE "action" (decodeUtf8 . LBS.toStrict $ encode (Object hm)) "Invalid JSONRPC Response"
postActionLogic _ r = throwError $ InvalidRequestE (toJSON r) "Invalid JSONRPC Request"
