[git] implement GIT_HASH using nix shellHook instead of the 'githash' hs package

parent 76a27e73
Pipeline #7849 passed with stages
in 50 minutes and 46 seconds
......@@ -546,7 +546,6 @@ library
, fullstop ^>= 0.1.4
, gargantext-graph-core >= 0.2.0.0
, gargantext-prelude
, githash >= 0.1.7.0 && < 0.2
, graphviz ^>= 2999.20.1.0
, haskell-bee
, haskell-bee-pgmq
......
......@@ -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";
......
......@@ -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
......
......@@ -12,6 +12,7 @@ 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)
......@@ -65,7 +66,7 @@ instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
data GargVersionResponse =
GargVersionResponse { _gvr_version :: T.Text
, _gvr_commitHash :: T.Text }
, _gvr_commitHash :: GitHash }
deriving (Show, Eq, Generic)
instance NFData GargVersionResponse
instance ToJSON GargVersionResponse where
......
......@@ -26,16 +26,16 @@ 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 GitHash
import Paths_gargantext qualified as PG -- cabal magic build module
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
......@@ -44,24 +44,22 @@ serverGargAPI env
, gargPrivateAPI = serverPrivateGargAPI
, gargPublicAPI = serverPublicGargAPI (env ^. hasConfig . gc_frontend_config . fc_external_url)
}
where
gi = $$tGitInfoCwd
where
gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError))
gargVersion = GargVersion
{ gargVersionEp = pure $ GargVersionResponse { _gvr_version = cs $ showVersion PG.version
, _gvr_commitHash = T.pack $ giHash gi } }
, _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)
......
......@@ -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)
......@@ -20,6 +20,7 @@ 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)
......@@ -53,7 +54,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith (\ctx -> setupE
Left err -> Prelude.fail (show err)
Right (GargVersionResponse { .. }) -> do
_gvr_version `shouldSatisfy` ((>= 1) . T.length) -- we got something back
_gvr_commitHash `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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment