Start9/start-os
2
0
Fork 0
mirror of https://github.com/Start9Labs/start-os.git synced 2026-03-30 12:11:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

sledgehammer error catch, log and return nothing so that embassy remains live even if registry is unreachable

Browse Source
This commit is contained in:
Keagan McClelland
2021-01-18 20:53:34 -07:00
committed by Aiden McClelland
parent 408cc45688
commit d211de9782
1 changed files with 12 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
agent/src/Handler/V0.hs
View File

@@ -41,7 +41,7 @@ import Util.Function
getServerR :: Handler (JsonEncoding ServerRes) getServerR :: Handler (JsonEncoding ServerRes)
getServerR = handleS9ErrT $ do getServerR = handleS9ErrT $ do
agentCtx <- getYesod agentCtx <- getYesod
let settings = appSettings agentCtx let settings = appSettings agentCtx
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
isUpdating <- getsYesod appIsUpdating >>= liftIO . readIORef isUpdating <- getsYesod appIsUpdating >>= liftIO . readIORef
@@ -58,10 +58,12 @@ getServerR = handleS9ErrT $ do
alternativeRegistryUrl <- runM $ injectFilesystemBaseFromContext settings $ readSystemPath altRegistryUrlPath alternativeRegistryUrl <- runM $ injectFilesystemBaseFromContext settings $ readSystemPath altRegistryUrlPath
name <- runM $ injectFilesystemBaseFromContext settings $ readSystemPath serverNamePath name <- runM $ injectFilesystemBaseFromContext settings $ readSystemPath serverNamePath
ssh <- readFromPath settings sshKeysFilePath >>= parseSshKeys ssh <- readFromPath settings sshKeysFilePath >>= parseSshKeys
wifi <- WpaSupplicant.runWlan0 $ liftA2 WifiList WpaSupplicant.getCurrentNetwork WpaSupplicant.listNetworks wifi <- WpaSupplicant.runWlan0 $ liftA2 WifiList WpaSupplicant.getCurrentNetwork WpaSupplicant.listNetworks
specs <- getSpecs settings specs <- getSpecs settings
welcomeAck <- fmap isJust . lift . runDB . Persist.get $ WelcomeAckKey agentVersion welcomeAck <- fmap isJust . lift . runDB . Persist.get $ WelcomeAckKey agentVersion
versionLatest <- getOSVersionLatest agentCtx versionLatest <- liftIO $ (try @SomeException $ getOSVersionLatest agentCtx) >>= \case
Left e -> (putStrLn @Text $ "Error fetching latest OS Version: " <> show e) $> Nothing
Right a -> pure a
let sid = T.drop 7 $ specsNetworkId specs let sid = T.drop 7 $ specsNetworkId specs
@@ -76,7 +78,7 @@ getServerR = handleS9ErrT $ do
, serverAlternativeRegistryUrl = alternativeRegistryUrl , serverAlternativeRegistryUrl = alternativeRegistryUrl
, serverSpecs = specs , serverSpecs = specs
, serverWelcomeAck = welcomeAck , serverWelcomeAck = welcomeAck
, serverVersionLatest = versionLatest , serverVersionLatest = versionLatest
} }
where where
parseSshKeys :: Text -> S9ErrT Handler [SshKeyFingerprint] parseSshKeys :: Text -> S9ErrT Handler [SshKeyFingerprint]
@@ -118,18 +120,16 @@ instance FromJSON NullablePatchReq where
newtype BoolPatchReq = BoolPatchReq { bpatchValue :: Bool } deriving (Eq, Show) newtype BoolPatchReq = BoolPatchReq { bpatchValue :: Bool } deriving (Eq, Show)
instance FromJSON BoolPatchReq where instance FromJSON BoolPatchReq where
parseJSON = withObject "Patch Request" $ \o -> BoolPatchReq <$> o .: "value" parseJSON = withObject "Patch Request" $ \o -> BoolPatchReq <$> o .: "value"
patchNameR :: Handler () patchNameR :: Handler ()
patchNameR = patchFile serverNamePath patchNameR = patchFile serverNamePath
patchAutoCheckUpdatesR :: Handler () patchAutoCheckUpdatesR :: Handler ()
patchAutoCheckUpdatesR = do patchAutoCheckUpdatesR = do
settings <- getsYesod appSettings settings <- getsYesod appSettings
BoolPatchReq val <- requireCheckJsonBody BoolPatchReq val <- requireCheckJsonBody
runM $ runM $ injectFilesystemBaseFromContext settings $ if val
injectFilesystemBaseFromContext settings $
if val
then writeSystemPath autoCheckUpdatesPath "" then writeSystemPath autoCheckUpdatesPath ""
else deleteSystemPath autoCheckUpdatesPath else deleteSystemPath autoCheckUpdatesPath
@@ -157,7 +157,7 @@ getOSVersionLatest ctx = do
mCache <- liftIO . readIORef $ osVersionCache mCache <- liftIO . readIORef $ osVersionCache
case mCache of case mCache of
Nothing -> repopulateCache ctx Nothing -> repopulateCache ctx
Just cache -> if diffUTCTime now (lastChecked cache) >= expirationOsVersionLatest Just cache -> if diffUTCTime now (lastChecked cache) >= expirationOsVersionLatest
then repopulateCache ctx then repopulateCache ctx
else pure . Just $ osVersion cache else pure . Just $ osVersion cache
@@ -165,7 +165,7 @@ getOSVersionLatest ctx = do
repopulateCache :: MonadIO m => AgentCtx -> m (Maybe Version) repopulateCache :: MonadIO m => AgentCtx -> m (Maybe Version)
repopulateCache ctx = do repopulateCache ctx = do
let osVersionCache = appOSVersionLatest ctx let osVersionCache = appOSVersionLatest ctx
let s = appSettings ctx let s = appSettings ctx
eitherV <- interp s $ Reg.getLatestAgentVersion eitherV <- interp s $ Reg.getLatestAgentVersion
case eitherV of case eitherV of