hasura · shahidhk · Jul 27, 2018 · Jul 25, 2018 · Jul 26, 2018 · Jul 26, 2018
@@ -126,6 +126,7 @@ library
                      , Hasura.Server.Query
                      , Hasura.Server.Utils
                      , Hasura.Server.Version
+                     , Hasura.Server.CheckUpdates
                      , Hasura.RQL.Types
                      , Hasura.RQL.Instances
                      , Hasura.RQL.Types.SchemaCache
@@ -212,6 +213,9 @@ executable graphql-engine
                      , lens
                      , unordered-containers >= 0.2
                      , pg-client
+                     , http-client
+                     , http-client-tls
+
   other-modules:     Ops
                      TH
 
@@ -241,5 +245,7 @@ test-suite graphql-engine-test
                      , pg-client
                      , time
                      , yaml
+                     , http-client
+                     , http-client-tls
 
   other-modules:     Spec
@@ -6,23 +6,27 @@ module Main where
 import           Ops
 
 import           Data.Time.Clock            (getCurrentTime)
-import qualified Network.Wai.Handler.Warp   as Warp
 import           Options.Applicative
 import           System.Environment         (lookupEnv)
 import           System.Exit                (exitFailure)
 
+import qualified Control.Concurrent         as C
 import qualified Data.Aeson                 as A
 import qualified Data.ByteString.Char8      as BC
 import qualified Data.ByteString.Lazy       as BL
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import qualified Data.Text                  as T
 import qualified Data.Yaml                  as Y
+import qualified Network.HTTP.Client        as HTTP
+import qualified Network.HTTP.Client.TLS    as HTTP
+import qualified Network.Wai.Handler.Warp   as Warp
 
-import           Hasura.Logging             (mkLoggerCtx, defaultLoggerSettings)
+import           Hasura.Logging             (defaultLoggerSettings, mkLoggerCtx)
 import           Hasura.Prelude
 import           Hasura.RQL.DDL.Metadata    (fetchMetadata)
 import           Hasura.Server.App          (mkWaiApp)
 import           Hasura.Server.Auth         (AuthMode (..))
+import           Hasura.Server.CheckUpdates (checkForUpdates)
 import           Hasura.Server.Init
 
 import qualified Database.PG.Query          as Q
@@ -107,8 +111,10 @@ main =  do
     return $ mkConnInfo mEnvDbUrl rci
   printConnInfo ci
   loggerCtx <- mkLoggerCtx defaultLoggerSettings
+  httpManager <- HTTP.newManager HTTP.tlsManagerSettings
   case ravenMode of
     ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook enableConsole) -> do
+
       mFinalAccessKey <- considerEnv "HASURA_GRAPHQL_ACCESS_KEY" mAccessKey
       mFinalWebHook <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" mWebHook
       am <- either ((>> exitFailure) . putStrLn) return $
@@ -120,10 +126,15 @@ main =  do
       migrate ci
       pool <- Q.initPGPool ci cp
       putStrLn $ "server: running on port " ++ show port
-      app <- mkWaiApp isoL mRootDir loggerCtx pool am finalCorsCfg enableConsole
+      app <- mkWaiApp isoL mRootDir loggerCtx pool httpManager am finalCorsCfg enableConsole
       let warpSettings = Warp.setPort port Warp.defaultSettings
                          -- Warp.setHost "*" Warp.defaultSettings
+
+      -- start a background thread to check for updates
+      void $ C.forkIO $ checkForUpdates loggerCtx httpManager
+
       Warp.runSettings warpSettings app
+
     ROExport -> do
       res <- runTx ci fetchMetadata
       either ((>> exitFailure) . printJSON) printJSON res

@@ -16,7 +16,7 @@ module Hasura.Logging
   , Logger
   , LogLevel(..)
   , mkLogger
-  , LoggerCtx
+  , LoggerCtx(..)
   , mkLoggerCtx
   , cleanLoggerCtx
   ) where

@@ -25,7 +25,6 @@ import qualified Text.Mustache.Compile                  as M
 import           Web.Spock.Core
 
 import qualified Network.HTTP.Client                    as HTTP
-import qualified Network.HTTP.Client.TLS                as HTTP
 import qualified Network.Wai.Middleware.Static          as MS
 
 import qualified Database.PG.Query                      as Q
@@ -39,7 +38,7 @@ import qualified Network.WebSockets                     as WS
 
 import           Hasura.Prelude                         hiding (get, put)
 import           Hasura.RQL.DDL.Schema.Table
-import           Hasura.RQL.DML.Explain
+--import           Hasura.RQL.DML.Explain
 import           Hasura.RQL.DML.QueryTemplate
 import           Hasura.RQL.Types
 import           Hasura.Server.Init
@@ -54,6 +53,7 @@ import           Hasura.SQL.Types
 import qualified Hasura.Logging                         as L
 import           Hasura.Server.Auth                     (AuthMode, getUserInfo)
 
+
 consoleTmplt :: M.Template
 consoleTmplt = $(M.embedSingleTemplate "src-rsr/console.html")
 
@@ -268,20 +268,19 @@ mkWaiApp
   -> Maybe String
   -> L.LoggerCtx
   -> Q.PGPool
+  -> HTTP.Manager
   -> AuthMode
   -> CorsConfig
   -> Bool
   -> IO Wai.Application
-mkWaiApp isoLevel mRootDir loggerCtx pool mode corsCfg enableConsole = do
+mkWaiApp isoLevel mRootDir loggerCtx pool httpManager mode corsCfg enableConsole = do
     cacheRef <- do
       pgResp <- liftIO $ runExceptT $ Q.runTx pool (Q.Serializable, Nothing) $ do
         Q.catchE defaultTxErrorHandler initStateTx
         sc <- buildSchemaCache
         (,) sc <$> GS.mkGCtxMap (scTables sc)
       either initErrExit return pgResp >>= newIORef
 
-    httpManager <- HTTP.newManager HTTP.tlsManagerSettings
-
     cacheLock <- newMVar ()
 
     let serverCtx =
@@ -311,7 +310,9 @@ httpApp mRootDir corsCfg serverCtx enableConsole = do
       serveApiConsole consoleHTML
     else maybe (return ()) (middleware . MS.staticPolicy . MS.addBase) mRootDir
 
-    get "v1/version" getVersion
+    get "v1/version" $ do
+      uncurry setHeader jsonHeader
+      lazyBytes $ encode $ object [ "version" .= currentVersion ]
 
     get    ("v1/template" <//> var) tmpltGetOrDeleteH
     post   ("v1/template" <//> var) tmpltPutOrPostH

@@ -76,8 +76,7 @@ userInfoFromWebhook manager urlT reqHeaders = do
 
   where
     filteredHeaders = flip filter reqHeaders $ \(n, _) ->
-      n /= "Content-Length" && n /= "User-Agent" && n /= "Host"
-      && n /= "Origin" && n /= "Referer"
+      n `notElem` ["Content-Length", "User-Agent", "Host", "Origin", "Referer"]
 
     validateStatus statusCode
       | statusCode == N.status200 = return ()

@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Hasura.Server.CheckUpdates
+  ( checkForUpdates
+  ) where
+
+import           Control.Exception     (try)
+import           Control.Lens
+import           Control.Monad         (forever)
+
+import qualified Control.Concurrent    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.Wreq          as Wreq
+import qualified System.Log.FastLogger as FL
+
+import           Hasura.Logging        (LoggerCtx (..))
+import           Hasura.Prelude
+import           Hasura.Server.Version (currentVersion)
+
+
+newtype UpdateInfo
+  = UpdateInfo
+  { uiLatest :: T.Text
+  } deriving (Show, Eq)
+
+$(A.deriveJSON (A.aesonDrop 2 A.snakeCase) ''UpdateInfo)
+
+checkForUpdates :: LoggerCtx -> H.Manager -> IO ()
+checkForUpdates (LoggerCtx loggerSet _ _) manager = do
+  let options = Wreq.defaults
+                & Wreq.checkResponse ?~ (\_ _ -> return ())
+                & Wreq.manager .~ Right manager
+
+  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.threadDelay aDay
+
+  where
+    updateMsg v = "Update: A new version is available: " <> v
+    url = "https://releases.hasura.io/graphql-engine?agent=server&version="
+          <> currentVersion
+    aDay = 86400 * 1000 * 1000
+
+    -- 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 ()
@@ -2,20 +2,18 @@
 {-# LANGUAGE TemplateHaskell   #-}
 
 module Hasura.Server.Version
-  ( getVersion
+  ( currentVersion
   , consoleVersion
   )
 where
 
 import           Control.Lens        ((^.))
-import           Data.Aeson
-import           Web.Spock.Core
 
 import qualified Data.SemVer         as V
 import qualified Data.Text           as T
 
 import           Hasura.Prelude
-import           Hasura.Server.Utils (jsonHeader, runScript)
+import           Hasura.Server.Utils (runScript)
 
 version :: T.Text
 version = T.dropWhileEnd (== '\n') $ $(runScript "../scripts/get-version.sh")
@@ -31,7 +29,5 @@ mkVersion ver = T.pack $ "v" ++ show major ++ "." ++ show minor
     major = ver ^. V.major
     minor = ver ^. V.minor
 
-getVersion :: (MonadIO m) => ActionT m ()
-getVersion = do
-  uncurry setHeader jsonHeader
-  lazyBytes $ encode $ object [ "version" .= version ]
+currentVersion :: T.Text
+currentVersion = version
@@ -22,6 +22,8 @@ import           Hasura.Server.Auth         (AuthMode (..))
 
 
 import qualified Database.PG.Query          as PGQ
+import qualified Network.HTTP.Client        as HTTP
+import qualified Network.HTTP.Client.TLS    as HTTP
 
 import           Hasura.Server.Init
 import           Ops                        (initCatalogSafe)
@@ -42,8 +44,9 @@ resetStateTx = do
 ravenApp :: L.LoggerCtx -> PGQ.PGPool -> IO Application
 ravenApp loggerCtx pool = do
   let corsCfg = CorsConfigG "*" False -- cors is enabled
+  httpManager <- HTTP.newManager HTTP.tlsManagerSettings
   -- spockAsApp $ spockT id $ app Q.Serializable Nothing rlogger pool AMNoAuth corsCfg True -- no access key and no webhook
-  mkWaiApp Q.Serializable Nothing loggerCtx pool AMNoAuth corsCfg True -- no access key and no webhook
+  mkWaiApp Q.Serializable Nothing loggerCtx pool httpManager AMNoAuth corsCfg True -- no access key and no webhook
 
 main :: IO ()
 main = do