server: add v1/version api, fix #34 (#37)

server/src-lib/Hasura/Server/App.hs

@@ -28,7 +28,8 @@ import qualified Network.HTTP.Client.TLS       as HT
 import           Network.Wai                   (strictRequestBody)
 import qualified Network.Wreq                  as Wq
 import qualified Network.Wreq.Types            as WqT
-import qualified Data.FileEmbed                as FE
+import qualified Text.Mustache                 as M
+import qualified Text.Mustache.Compile         as M
 
 import           Web.Spock.Core
 
@@ -53,12 +54,22 @@ import           Hasura.Server.Middleware      (corsMiddleware,
                                                 mkDefaultCorsPolicy)
 import           Hasura.Server.Query
 import           Hasura.Server.Utils
+import           Hasura.Server.Version
 import           Hasura.SQL.Types
 
 type RavenLogger = ServerLogger (BL.ByteString, Either QErr BL.ByteString)
 
-consoleHTML :: T.Text
-consoleHTML = $(FE.embedStringFile "src-rsr/console.html")
+consoleTmplt :: M.Template
+consoleTmplt = $(M.embedSingleTemplate "src-rsr/console.html")
+
+mkConsoleHTML :: IO T.Text
+mkConsoleHTML =
+  bool (initErrExit errMsg) (return res) (null errs)
+  where
+    (errs, res) = M.checkedSubstitute consoleTmplt $
+                   object ["version" .= consoleVersion]
+    errMsg = "Fatal Error : console template rendering failed"
+             ++ show errs
 
 ravenLogGen :: LogDetailG (BL.ByteString, Either QErr BL.ByteString)
 ravenLogGen _ (reqBody, res) =
@@ -138,9 +149,6 @@ buildQCtx = do
   cache <- liftIO $ readIORef scRef
   return $ QCtx userInfo $ fst cache
 
-jsonHeader :: (T.Text, T.Text)
-jsonHeader = ("Content-Type", "application/json; charset=utf-8")
-
 fromWebHook
   :: (MonadIO m)
   => T.Text
@@ -383,9 +391,13 @@ app isoLevel mRootDir logger pool mode corsCfg enableConsole = do
       middleware $ corsMiddleware (mkDefaultCorsPolicy $ ccDomain corsCfg)
 
     -- API Console and Root Dir
-    if enableConsole then serveApiConsole consoleHTML
+    if enableConsole then do
+      consoleHTML <- lift mkConsoleHTML
+      serveApiConsole consoleHTML
     else maybe (return ()) (middleware . MS.staticPolicy . MS.addBase) mRootDir
 
+    get "v1/version" getVersion
+
     get    ("v1/template" <//> var) $ tmpltGetOrDeleteH serverCtx
     post   ("v1/template" <//> var) $ tmpltPutOrPostH serverCtx
     put    ("v1/template" <//> var) $ tmpltPutOrPostH serverCtx

server/src-lib/Hasura/Server/Utils.hs

@@ -6,8 +6,13 @@ import qualified Database.PG.Query.Connection as Q
 
 import           Data.List.Split
 import           Network.URI
+import           System.Exit
+import           System.Process
 
 import qualified Data.Text                    as T
+import qualified Data.Text.IO                 as TI
+import qualified Language.Haskell.TH.Syntax   as TH
+
 import           Hasura.Prelude
 
 dropAndSnakeCase :: T.Text -> T.Text
@@ -22,6 +27,9 @@ toSnakeCase = T.pack . map change . T.unpack
 isXHasuraTxt :: T.Text -> Bool
 isXHasuraTxt = T.isInfixOf "x-hasura-" . T.toLower
 
+jsonHeader :: (T.Text, T.Text)
+jsonHeader = ("Content-Type", "application/json; charset=utf-8")
+
 userRoleHeader :: T.Text
 userRoleHeader = "x-hasura-role"
 
@@ -65,3 +73,15 @@ uriAuthParameters uriAuth = port . host . auth
                  [u]    -> \info -> info { Q.connUser = dropLast u }
                  [u, p] -> \info -> info { Q.connUser = u, Q.connPassword = dropLast p }
                  _      -> id
+
+-- Running shell script during compile time
+runScript :: FilePath -> TH.Q TH.Exp
+runScript fp = do
+  TH.addDependentFile fp
+  fileContent <- TH.runIO $ TI.readFile fp
+  (exitCode, stdOut, stdErr) <- TH.runIO $
+    readProcessWithExitCode "/bin/sh" [] $ T.unpack fileContent
+  when (exitCode /= ExitSuccess) $ fail $
+    "Running shell script " ++ fp ++ " failed with exit code : "
+    ++ show exitCode ++ " and with error : " ++ stdErr
+  TH.lift stdOut

server/src-lib/Hasura/Server/Version.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Hasura.Server.Version
+  ( getVersion
+  , 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)
+
+version :: T.Text
+version = T.dropWhileEnd (== '\n') $ $(runScript "../scripts/get-version.sh")
+
+consoleVersion :: T.Text
+consoleVersion = case V.fromText version of
+  Right ver -> mkVersion ver
+  Left _    -> version
+
+mkVersion :: V.Version -> T.Text
+mkVersion ver = T.pack $ "v" ++ show major ++ "." ++ show minor
+  where
+    major = ver ^. V.major
+    minor = ver ^. V.minor
+
+getVersion :: (MonadIO m) => ActionT m ()
+getVersion = do
+  uncurry setHeader jsonHeader
+  lazyBytes $ encode $ object [ "version" .= version ]