Merge branch 'dev-improve-api-version' into 'dev'

[API] version with git hash

See merge request !422

nix/pkgs.nix

@@ -78,6 +78,7 @@ rec {
     export LIBRARY_PATH="${pkgs.gfortran.cc.lib}:${libPaths}"
     export CXX_PATH="${customStdenv.cc.cc.lib}"
     export LIB_PATHS="${libPaths}"
+    export GIT_REV="$(git rev-parse HEAD)"
   '';
   shell = pkgs.mkShell.override { stdenv = customStdenv; } {
     name = "gargantext-shell";

src/Gargantext/API.hs

@@ -52,6 +52,7 @@ import Gargantext.Core.Config
 import Gargantext.Core.Config.Types (CORSOrigin(..), CORSSettings, MicroServicesProxyStatus(..), NotificationsConfig(..), PortNumber, SettingsFile(..), corsAllowedOrigins, fc_cors, fc_cookie_settings, fc_internal_url, microServicesProxyStatus)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Notifications (withNotifications)
+import Gargantext.Core.Utils (getGitHash)
 import Gargantext.Database.Prelude qualified as DB
 import Gargantext.MicroServices.ReverseProxy (microServicesProxyApp)
 import Gargantext.Prelude hiding (putStrLn, to)
@@ -200,7 +201,8 @@ makeGargMiddleware crsSettings mode = do
 
 makeApp :: Env -> IO Application
 makeApp env = do
-  pure $ serveWithContext api cfg (server env)
+  gitHash <- getGitHash
+  pure $ serveWithContext api cfg (server gitHash env)
   -- (ekgStore, ekgMid) <- newEkgStore api
   -- ekgDir <- (</> "ekg-assets") <$> getDataDir
   -- pure $ ekgMid $ serveWithContext apiWithEkg cfg

src/Gargantext/API/Routes/Named.hs

@@ -25,7 +25,7 @@ import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.GraphQL (GraphQLAPI)
 import Gargantext.API.Routes.Named.Private (GargPrivateAPI)
 import Gargantext.API.Routes.Named.Public (GargPublicAPI)
-import Gargantext.API.Routes.Types (WithCustomErrorScheme)
+import Gargantext.API.Routes.Types (GargVersionResponse, WithCustomErrorScheme)
 import Gargantext.API.Worker (WorkerAPI)
 import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher
 import Servant.API ((:>), (:-), JSON, ReqBody, Post, Get, QueryParam)
@@ -102,5 +102,5 @@ data ForgotPasswordAsyncAPI mode = ForgotPasswordAsyncAPI
 
 
 data GargVersion mode = GargVersion
-  { gargVersionEp :: mode :- "version" :> Summary "Backend version" :> Get '[JSON] Text
+  { gargVersionEp :: mode :- "version" :> Summary "Backend version" :> Get '[JSON] GargVersionResponse
   } deriving Generic

src/Gargantext/API/Routes/Types.hs

-{-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeFamilies         #-}
 
 module Gargantext.API.Routes.Types where
 
-import Control.Lens ((&), (%~), traversed)
-import Data.ByteString (ByteString)
+import Control.Lens ((%~), traversed)
+import Data.Aeson ((.:), (.=), object, withObject)
 import Data.CaseInsensitive qualified as CI
 import Data.List qualified as L
-import Data.Proxy (Proxy(..))
+import Data.Swagger (ToSchema)
 import Data.Set qualified as Set
+import Data.Text qualified as T
 import Gargantext.API.Errors (GargErrorScheme(..), renderGargErrorScheme)
+import Gargantext.Core.Utils (GitHash)
+import Gargantext.Prelude
 import Network.HTTP.Types (HeaderName)
 import Network.Wai (requestHeaders)
-import Prelude
 import Servant.API.Routes (HasRoutes, getRoutes, mkHeaderRep, responseHeaders)
 import Servant.API.Routes.Internal.Response (unResponses)
 import Servant.API.Routes.Route (routeResponse)
@@ -60,3 +62,21 @@ instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
         errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString
         addHeader' rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
     in  addHeader' <$> apiRoutes
+
+
+data GargVersionResponse =
+  GargVersionResponse { _gvr_version    :: T.Text
+                      , _gvr_commitHash :: GitHash }
+  deriving (Show, Eq, Generic)
+instance NFData GargVersionResponse
+instance ToJSON GargVersionResponse where
+  toJSON GargVersionResponse { .. } = object [
+      "version" .= toJSON _gvr_version
+    , "commitHash" .= toJSON _gvr_commitHash
+    ]
+instance FromJSON GargVersionResponse where
+  parseJSON = withObject "GargVersionResponse" $ \o -> do
+    _gvr_version <- o .: "version"
+    _gvr_commitHash <- o .: "commitHash"
+    pure GargVersionResponse { .. }
+instance ToSchema GargVersionResponse

src/Gargantext/API/Server/Named.hs

@@ -19,12 +19,14 @@ import Gargantext.API.Errors
 import Gargantext.API.GraphQL as GraphQL ( GraphQLAPI, api )
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes.Named
+import Gargantext.API.Routes.Types (GargVersionResponse(..))
 import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
 import Gargantext.API.Swagger (openApiDoc)
 import Gargantext.API.ThrowAll (serverPrivateGargAPI)
 import Gargantext.Core.Notifications.Dispatcher.WebSocket qualified as Dispatcher
 import Gargantext.Core.Config (gc_frontend_config, hasConfig)
 import Gargantext.Core.Config.Types (fc_directory, fc_external_url)
+import Gargantext.Core.Utils (GitHash)
 import Gargantext.Prelude hiding (Handler, catch)
 import Gargantext.System.Logging (logLocM, LogLevel(..))
 import Paths_gargantext qualified as PG -- cabal magic build module
@@ -32,8 +34,8 @@ import Servant
 import Servant.Server.Generic (AsServer, AsServerT)
 import Servant.Swagger.UI (swaggerSchemaUIServer)
 
-serverGargAPI :: Env -> BackEndAPI (AsServerT (GargM Env BackendInternalError))
-serverGargAPI env
+serverGargAPI :: GitHash -> Env -> BackEndAPI (AsServerT (GargM Env BackendInternalError))
+serverGargAPI gitHash env
        =  BackEndAPI $ MkBackEndAPI $ GargAPIVersion $ GargAPI'
             { gargAuthAPI                = AuthAPI auth
             , gargForgotPasswordAPI      = forgotPassword
@@ -42,20 +44,22 @@ serverGargAPI env
             , gargPrivateAPI             = serverPrivateGargAPI
             , gargPublicAPI              = serverPublicGargAPI (env ^. hasConfig . gc_frontend_config . fc_external_url)
             }
-  where
+  where    
     gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError))
-    gargVersion = GargVersion $ pure (cs $ showVersion PG.version)
+    gargVersion = GargVersion
+      { gargVersionEp = pure $ GargVersionResponse { _gvr_version = cs $ showVersion PG.version
+                                                   , _gvr_commitHash = gitHash } }
 
 -- | Server declarations
-server :: Env -> API AsServer
-server env =
+server :: GitHash -> Env -> API AsServer
+server gitHash env =
   API $ \errScheme -> NamedAPI
      { swaggerAPI = swaggerSchemaUIServer openApiDoc
      , backendAPI = hoistServerWithContext
                       (Proxy :: Proxy (NamedRoutes BackEndAPI))
                       (Proxy :: Proxy AuthContext)
                       (transformJSON errScheme)
-                      (serverGargAPI env)
+                      (serverGargAPI gitHash env)
      , graphqlAPI = hoistServerWithContext
                       (Proxy :: Proxy (NamedRoutes GraphQLAPI))
                       (Proxy :: Proxy AuthContext)

src/Gargantext/Core/Utils.hs

@@ -24,16 +24,18 @@ module Gargantext.Core.Utils (
                            , (?!)
                            , (?|)
                            , nonemptyIntercalate
+                           , GitHash(..)
+                           , getGitHash
                           ) where
 
 import Data.List qualified as List
-import Data.Maybe
-import Data.Monoid
+import Data.Swagger (ToSchema)
 import Data.Text qualified as T
 import Gargantext.Core.Utils.Prefix
 import Gargantext.Prelude
 import Prelude ((!!))
 import Prelude qualified
+import System.Environment (getEnv)
 import System.Random (initStdGen, uniformR)
 
 
@@ -94,3 +96,11 @@ infixr 4 ?|
 -- | Intercalate strings, but only nonempty ones
 nonemptyIntercalate :: Text -> [Text] -> Text
 nonemptyIntercalate sep xs = T.intercalate sep $ filter (/= "") xs
+
+
+---- Git hash
+newtype GitHash = GitHash { unGitHash :: Text }
+  deriving (Show, Eq, Generic, NFData, ToJSON, FromJSON, ToSchema)
+
+getGitHash :: IO GitHash
+getGitHash = getEnv "GIT_REV" <&> (GitHash . T.pack)

test/Test/API/Authentication.hs

@@ -17,8 +17,10 @@ import Data.Aeson.QQ
 import Data.Text as T
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Routes.Named
+import Gargantext.API.Routes.Types (GargVersionResponse(..))
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu
+import Gargantext.Core.Utils (unGitHash)
 import Gargantext.Database.Action.User.New
 import Gargantext.Prelude
 import Network.HTTP.Client hiding (Proxy)
@@ -50,7 +52,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith (\ctx -> setupE
         result <- runClientM version_api (clientEnv _sctx_port)
         case result of
           Left err -> Prelude.fail (show err)
-          Right r  -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back
+          Right (GargVersionResponse { .. })  -> do
+            _gvr_version `shouldSatisfy` ((>= 1) . T.length) -- we got something back
+            _gvr_commitHash `shouldSatisfy` ((>= 1) . T.length . unGitHash) -- we got something back
 
     describe "POST /api/v1.0/auth" $ do