graphql-engine/server/src-lib/Hasura/Server/CheckUpdates.hs
Vamshi Surabhi c52bfc540d
More robust forking, exception safety. Closes #3768 (#3860)
This is the result of a general audit of how we fork threads, with a
detour into how we're using mutable state especially in websocket
codepaths, making more robust to async exceptions and exceptions
resulting from bugs.

Some highlights:
- use a wrapper around 'immortal' so threads that die due to bugs are
  restarted, and log the error
- use 'withAsync' some places
- use bracket a few places where we might break invariants
- log some codepaths that represent bugs
- export UnstructuredLog for ad hoc logging (the alternative is we
  continue not logging useful stuff)

I had to timebox this. There are a few TODOs I didn't want to address.
And we'll wait until this is merged to attempt #3705 for
Control.Concurrent.Extended
2020-03-05 23:29:26 +05:30

66 lines
2.2 KiB
Haskell

module Hasura.Server.CheckUpdates
( checkForUpdates
) where
import Control.Exception (try)
import Control.Lens
import Control.Monad (forever)
import Data.Text.Conversions (toText)
import qualified CI
import qualified Control.Concurrent.Extended as C
import qualified Data.Aeson as A
import qualified Data.Aeson.Casing as A
import qualified Data.Aeson.TH as A
import qualified Data.Text as T
import qualified Network.HTTP.Client as H
import qualified Network.URI.Encode as URI
import qualified Network.Wreq as Wreq
import qualified System.Log.FastLogger as FL
import Hasura.HTTP
import Hasura.Logging (LoggerCtx (..))
import Hasura.Prelude
import Hasura.Server.Version (HasVersion, Version, currentVersion)
newtype UpdateInfo
= UpdateInfo
{ _uiLatest :: Version
} deriving (Show)
$(A.deriveJSON (A.aesonDrop 2 A.snakeCase) ''UpdateInfo)
checkForUpdates :: (HasVersion) => LoggerCtx a -> H.Manager -> IO void
checkForUpdates (LoggerCtx loggerSet _ _ _) manager = do
let options = wreqOptions manager []
url <- getUrl
forever $ do
resp <- try $ Wreq.getWith options $ T.unpack url
case resp of
Left ex -> ignoreHttpErr ex
Right bs -> do
UpdateInfo latestVersion <- decodeResp $ bs ^. Wreq.responseBody
when (latestVersion /= currentVersion) $
FL.pushLogStrLn loggerSet $ FL.toLogStr $ updateMsg latestVersion
C.sleep $ days 1
where
updateMsg v = "Update: A new version is available: " <> toText v
getUrl = do
let buildUrl agent = "https://releases.hasura.io/graphql-engine?agent=" <>
agent <> "&version=" <> URI.encodeText (toText currentVersion)
ciM <- CI.getCI
return . buildUrl $ case ciM of
Nothing -> "server"
Just ci -> "server-" <> (T.toLower . T.pack $ show ci)
-- ignoring if there is any error in response and returning the current version
decodeResp bs = case A.eitherDecode bs of
Left _ -> return $ UpdateInfo currentVersion
Right a -> return a
ignoreHttpErr :: H.HttpException -> IO ()
ignoreHttpErr _ = return ()