Setup noThunks on Env

package.yaml

@@ -175,6 +175,7 @@ library:
   - monad-logger
   - mtl
   - natural-transformation
+  - nothunks
   - opaleye
   - pandoc
   - parallel

src/Gargantext/API.hs

@@ -45,6 +45,7 @@ import Network.Wai
 import Network.Wai.Handler.Warp hiding (defaultSettings)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.RequestLogger
+import NoThunks.Class (NoThunks)
 import Servant
 import System.IO (FilePath)
 import Data.Text.IO (putStrLn)
@@ -193,7 +194,7 @@ serverGargAdminAPI =  roots
 --gargMock :: Server GargAPI
 --gargMock = mock apiGarg Proxy
 ---------------------------------------------------------------------
-makeApp :: EnvC env => env -> IO Application
+makeApp :: (NoThunks env, EnvC env) => env -> IO Application
 makeApp env = serveWithContext api cfg <$> server env
   where
     cfg :: Servant.Context AuthContext

src/Gargantext/API/Admin/EnvTypes.hs

 -- |
 
-{-# LANGUAGE TemplateHaskell     #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE DerivingVia        #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell    #-}
 
 module Gargantext.API.Admin.EnvTypes where
 
@@ -10,10 +14,12 @@ import Database.PostgreSQL.Simple (Connection)
 import GHC.Generics (Generic)
 import Network.HTTP.Client (Manager)
 import Servant.Client (BaseUrl)
-import Servant.Job.Async (HasJobEnv(..), Job)
+import Servant.Job.Async (HasJobEnv(..), Job, JobEnv)
 import System.Log.FastLogger
 import qualified Servant.Job.Core
 
+import NoThunks.Class (NoThunks(..), OnlyCheckWhnfNamed(..))
+
 import Gargantext.API.Admin.Types
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Ngrams.Types (HasRepoVar(..), HasRepoSaver(..), HasRepo(..), RepoEnv(..))
@@ -60,6 +66,12 @@ instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
 instance HasJobEnv Env JobLog JobLog where
   job_env = env_scrapers
 
+deriving via OnlyCheckWhnfNamed "LoggerSet" LoggerSet instance NoThunks LoggerSet
+deriving via OnlyCheckWhnfNamed "Manager" Manager instance NoThunks Manager
+deriving via OnlyCheckWhnfNamed "Pool" (Pool a) instance NoThunks (Pool a)
+deriving via OnlyCheckWhnfNamed "JobEnv" (JobEnv a b) instance NoThunks (JobEnv a b)
+instance NoThunks Env
+
 data MockEnv = MockEnv
   { _menv_firewall :: !FireWall
   }

src/Gargantext/API/Admin/Types.hs

 -- |
 
-{-# LANGUAGE TemplateHaskell     #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE DerivingVia        #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TemplateHaskell    #-}
 
 module Gargantext.API.Admin.Types where
 
@@ -9,6 +13,7 @@ import Control.Monad.Logger
 import Data.ByteString (ByteString)
 import GHC.Enum
 import GHC.Generics (Generic)
+import NoThunks.Class (NoThunks(..), OnlyCheckWhnfNamed(..))
 import Servant.Auth.Server (JWTSettings, CookieSettings(..))
 import Servant.Client (BaseUrl)
 
@@ -21,6 +26,8 @@ data SendEmailType = SendEmailViaAws
                    | WriteEmailToFile
     deriving (Show, Read, Enum, Bounded, Generic)
 
+instance NoThunks SendEmailType
+
 data Settings = Settings
     { _allowedOrigin   :: !ByteString   -- allowed origin for CORS
     , _allowedHost     :: !ByteString   -- allowed host for CORS
@@ -33,9 +40,16 @@ data Settings = Settings
     , _sendLoginEmails :: !SendEmailType
     , _scrapydUrl      :: !BaseUrl
     }
+    deriving (Generic)
 
 makeLenses ''Settings
 
+deriving via OnlyCheckWhnfNamed "BaseUrl" BaseUrl instance NoThunks BaseUrl
+deriving via OnlyCheckWhnfNamed "CookieSettings" CookieSettings instance NoThunks CookieSettings
+deriving via OnlyCheckWhnfNamed "JWTSettings" JWTSettings instance NoThunks JWTSettings
+deriving via OnlyCheckWhnfNamed "LogLevel" LogLevel instance NoThunks LogLevel
+instance NoThunks Settings
+
 class HasSettings env where
   settings :: Getter env Settings
 

src/Gargantext/API/Ngrams/Types.hs

 -- |
 
-{-# LANGUAGE ConstraintKinds   #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+{-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE DerivingVia         #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeOperators     #-}
-{-# LANGUAGE TypeFamilies      #-}
-{-# OPTIONS -fno-warn-orphans #-}
+{-# LANGUAGE StandaloneDeriving  #-}
+{-# LANGUAGE TemplateHaskell     #-}
+{-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TypeFamilies        #-}
 
 module Gargantext.API.Ngrams.Types where
 
@@ -26,6 +29,7 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Map.Strict.Patch as PM
 import Data.Maybe (fromMaybe)
 import Data.Monoid
+import NoThunks.Class (NoThunks, OnlyCheckWhnfNamed(..))
 import Data.Patch.Class (Replace, replace, Action(act), Group, Applicable(..), Composable(..), Transformable(..),
                          PairPatch(..), Patched, ConflictResolution, ConflictResolutionReplace,
                          MaybePatch(Mod), unMod, old, new)
@@ -683,6 +687,9 @@ data RepoEnv = RepoEnv
 
 makeLenses ''RepoEnv
 
+-- All fields of RepoEnv are strict. MVar has no instance.
+deriving via OnlyCheckWhnfNamed "RepoEnv" RepoEnv instance NoThunks RepoEnv
+
 class HasRepoVar env where
   repoVar :: Getter env (MVar NgramsRepo)
 

src/Gargantext/API/Server.hs

@@ -16,8 +16,10 @@ module Gargantext.API.Server where
 import Control.Lens ((^.))
 import Control.Monad.Except (withExceptT)
 import Control.Monad.Reader (runReaderT)
+import Data.Foldable (traverse_)
 import Data.Text (Text)
 import Data.Version (showVersion)
+import NoThunks.Class (NoThunks(..))
 import Servant
 import Servant.Swagger.UI (swaggerSchemaUIServer)
 import qualified Data.ByteString.Lazy.Char8 as BL8
@@ -49,8 +51,9 @@ serverGargAPI baseUrl -- orchestrator
     gargVersion = pure (cs $ showVersion PG.version)
 
 -- | Server declarations
-server :: forall env. EnvC env => env -> IO (Server API)
+server :: forall env. (NoThunks env, EnvC env) => env -> IO (Server API)
 server env = do
+  traverse_ (printDebug "Unexpected thunks") =<< noThunks ["env"] env
   -- orchestrator <- scrapyOrchestrator env
   pure $  swaggerSchemaUIServer swaggerDoc
      :<|> hoistServerWithContext

src/Gargantext/Prelude/Config.hs

@@ -21,6 +21,7 @@ import Gargantext.Prelude
 import Data.Text (Text, pack)
 import GHC.Generics (Generic)
 import Control.Lens (makeLenses)
+import NoThunks.Class (NoThunks)
 
 
 data GargConfig = GargConfig { _gc_url              :: !Text
@@ -44,6 +45,8 @@ data GargConfig = GargConfig { _gc_url              :: !Text
 
 makeLenses ''GargConfig
 
+instance NoThunks GargConfig
+
 readConfig :: FilePath -> IO GargConfig
 readConfig fp = do
   ini         <- readIniFile fp

stack.yaml

@@ -84,3 +84,4 @@ extra-deps:
 - dependent-sum-0.4@sha256:40c705604f52374fb72616e10234635104a626ede737ddde899777b719df120b,1907
 - xmlbf-xeno-0.2@sha256:39f70fced6052524c290cf595f114661c721452e65fc3e0953a44e7682a6a6b0,950
 
+- nothunks-0.1.1.0
\ No newline at end of file