1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-21 22:41:43 +03:00
graphql-engine/server/src-lib/Hasura/Server/CheckUpdates.hs

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

68 lines
2.2 KiB
Haskell
Raw Normal View History

{-# LANGUAGE TemplateHaskell #-}
module Hasura.Server.CheckUpdates
( checkForUpdates,
)
where
import CI qualified
import Control.Concurrent.Extended qualified as C
import Control.Exception (try)
import Control.Lens
import Data.Aeson qualified as A
import Data.Aeson.Casing qualified as A
import Data.Aeson.TH qualified as A
import Data.Either (fromRight)
import Data.Text qualified as T
import Data.Text.Conversions (toText)
import Hasura.HTTP
import Hasura.Logging (LoggerCtx (..))
import Hasura.Prelude
import Hasura.Server.Version (Version, currentVersion)
import Network.HTTP.Client qualified as HTTP
import Network.URI.Encode qualified as URI
import Network.Wreq qualified as Wreq
import System.Log.FastLogger qualified as FL
newtype UpdateInfo = UpdateInfo
{ _uiLatest :: Version
}
deriving (Show)
-- note that this is erroneous and should drop three characters or use
-- aesonPrefix, but needs to remain like this for backwards compatibility
$(A.deriveJSON (A.aesonDrop 2 A.snakeCase) ''UpdateInfo)
checkForUpdates :: LoggerCtx a -> HTTP.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 (tshow ci)
-- ignoring if there is any error in response and returning the current version
decodeResp = pure . fromRight (UpdateInfo currentVersion) . A.eitherDecode
ignoreHttpErr :: HTTP.HttpException -> IO ()
ignoreHttpErr _ = return ()