agent: adds versionLatest to V0 resilient to reg failures

agent/src/Application.hs

@@ -113,6 +113,7 @@ makeFoundation appSettings = do
     appSelfUpdateSpecification  <- newEmptyMVar
     appIsUpdating               <- newIORef Nothing
     appIsUpdateFailed           <- newIORef Nothing
+    appOSVersionLatest          <- newIORef Nothing
     appBackgroundJobs           <- newTVarIO (JobCache HM.empty)
     def                         <- getDefaultProcDevMetrics
     appProcDevMomentCache       <- newIORef (now, mempty, def)

agent/src/Foundation.hs

@@ -58,6 +58,7 @@ import           Settings
 -- keep settings and values requiring initialization before your application
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
+data OsVersionCache = OsVersionCache { osVersion :: Version, lastChecked :: UTCTime }
 
 data AgentCtx = AgentCtx
     { appSettings                 :: AppSettings
@@ -68,6 +69,7 @@ data AgentCtx = AgentCtx
     , appWebServerThreadId        :: IORef (Maybe ThreadId)
     , appIsUpdating               :: IORef (Maybe Version)
     , appIsUpdateFailed           :: IORef (Maybe S9Error)
+    , appOSVersionLatest          :: IORef (Maybe OsVersionCache)
     , appProcDevMomentCache       :: IORef (UTCTime, ProcDevMomentStats, ProcDevMetrics)
     , appSelfUpdateSpecification  :: MVar VersionRange
     , appBackgroundJobs           :: TVar JobCache

agent/src/Handler/Types/V0/Base.hs

@@ -31,6 +31,7 @@ data ServerRes = ServerRes
     , serverStatus                 :: Maybe AppStatus
     , serverStatusAt               :: UTCTime
     , serverVersionInstalled       :: Version
+    , serverVersionLatest          :: Maybe Version
     , serverNotifications          :: [Entity Notification]
     , serverWifi                   :: WifiList
     , serverSsh                    :: [SshKeyFingerprint]
@@ -52,7 +53,7 @@ instance ToJSON ServerRes where
             Nothing   -> String "UPDATING"
             Just stat -> toJSON stat
         , "versionInstalled" .= serverVersionInstalled
-        , "versionLatest" .= Null
+        , "versionLatest" .= serverVersionLatest
         , "notifications" .= serverNotifications
         , "wifi" .= serverWifi
         , "ssh" .= serverSsh

agent/src/Handler/V0.hs

@@ -4,6 +4,7 @@ module Handler.V0 where
 
 import           Startlude               hiding ( runReader )
 
+import           Control.Carrier.Error.Either
 import           Control.Carrier.Lift           ( runM )
 import           Data.Aeson
 import           Data.IORef
@@ -20,8 +21,10 @@ import           Handler.Types.V0.Specs
 import           Handler.Types.V0.Ssh
 import           Handler.Types.V0.Base
 import           Handler.Types.V0.Wifi
+import           Lib.Algebra.State.RegistryUrl
 import           Lib.Error
 import           Lib.External.Metrics.Df
+import qualified Lib.External.Registry         as Reg
 import           Lib.External.Specs.CPU
 import           Lib.External.Specs.Memory
 import qualified Lib.External.WpaSupplicant    as WpaSupplicant
@@ -38,7 +41,8 @@ import           Util.Function
 
 getServerR :: Handler (JsonEncoding ServerRes)
 getServerR = handleS9ErrT $ do
-    settings   <- getsYesod appSettings
+    agentCtx   <- getYesod
+    let settings = appSettings agentCtx
     now        <- liftIO getCurrentTime
     isUpdating <- getsYesod appIsUpdating >>= liftIO . readIORef
 
@@ -57,6 +61,7 @@ getServerR = handleS9ErrT $ do
     wifi                   <- WpaSupplicant.runWlan0 $ liftA2 WifiList WpaSupplicant.getCurrentNetwork WpaSupplicant.listNetworks
     specs                  <- getSpecs settings
     welcomeAck             <- fmap isJust . lift . runDB . Persist.get $ WelcomeAckKey agentVersion
+    versionLatest          <- getOSVersionLatest agentCtx
 
     let sid = T.drop 7 $ specsNetworkId specs
 
@@ -71,6 +76,7 @@ getServerR = handleS9ErrT $ do
                          , serverAlternativeRegistryUrl = alternativeRegistryUrl
                          , serverSpecs                  = specs
                          , serverWelcomeAck             = welcomeAck
+                         , serverVersionLatest           = versionLatest
                          }
     where
         parseSshKeys :: Text -> S9ErrT Handler [SshKeyFingerprint]
@@ -140,3 +146,35 @@ patchNullableFile path = do
     runM $ injectFilesystemBaseFromContext settings $ case mVal of
         Just val -> writeSystemPath path $ T.strip val
         Nothing  -> deleteSystemPath path
+
+expirationOsVersionLatest :: Num a => a
+expirationOsVersionLatest = 60
+
+getOSVersionLatest :: MonadIO m => AgentCtx -> m (Maybe Version)
+getOSVersionLatest ctx = do
+    now <- liftIO getCurrentTime
+    let osVersionCache = appOSVersionLatest ctx
+    mCache <- liftIO . readIORef $ osVersionCache
+
+    case mCache of
+        Nothing -> repopulateCache ctx
+        Just cache -> if diffUTCTime now (lastChecked cache) >= expirationOsVersionLatest
+            then repopulateCache ctx
+            else pure . Just $ osVersion cache
+
+repopulateCache :: MonadIO m => AgentCtx -> m (Maybe Version)
+repopulateCache ctx = do
+    let osVersionCache = appOSVersionLatest ctx
+    let s = appSettings ctx
+    eitherV <- interp s $ Reg.getLatestAgentVersion
+
+    case eitherV of
+        Left error -> do
+            putStrLn $ "Repopulate OS Version Cache exception: " <> (show error :: Text)
+            fmap (fmap osVersion) . liftIO . readIORef $ osVersionCache
+        Right v -> do
+            res <- OsVersionCache v <$> liftIO getCurrentTime
+            liftIO $ writeIORef osVersionCache (Just res)
+            pure . Just $ osVersion res
+    where interp s = liftIO . runError @S9Error . injectFilesystemBaseFromContext s . runRegistryUrlIOC
+