Commit ffd91184 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[ENV/DEVENV] Adding HasSettings class and instances (Reader).

parent d1a3103e
Pipeline #313 failed with stage
...@@ -278,7 +278,7 @@ type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html ...@@ -278,7 +278,7 @@ type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
--------------------------------------------------------------------- ---------------------------------------------------------------------
-- | Server declarations -- | Server declarations
server :: (HasConnection env, HasRepo env) server :: (HasConnection env, HasRepo env, HasSettings env)
=> env -> IO (Server API) => env -> IO (Server API)
server env = do server env = do
-- orchestrator <- scrapyOrchestrator env -- orchestrator <- scrapyOrchestrator env
...@@ -318,7 +318,7 @@ gargMock :: Server GargAPI ...@@ -318,7 +318,7 @@ gargMock :: Server GargAPI
gargMock = mock apiGarg Proxy gargMock = mock apiGarg Proxy
--------------------------------------------------------------------- ---------------------------------------------------------------------
makeApp :: (HasConnection env, HasRepo env) makeApp :: (HasConnection env, HasRepo env, HasSettings env)
=> env -> IO Application => env -> IO Application
makeApp = fmap (serve api) . server makeApp = fmap (serve api) . server
......
...@@ -75,7 +75,7 @@ import qualified Data.Vector as Vec ...@@ -75,7 +75,7 @@ import qualified Data.Vector as Vec
type GargServer api = type GargServer api =
forall env m. forall env m.
(CmdM env ServantErr m, HasRepo env) (CmdM env ServantErr m, HasRepo env, HasSettings env)
=> ServerT api m => ServerT api m
------------------------------------------------------------------- -------------------------------------------------------------------
...@@ -406,11 +406,11 @@ getMetrics cId maybeListId tabType maybeLimit = do ...@@ -406,11 +406,11 @@ getMetrics cId maybeListId tabType maybeLimit = do
listType t m = maybe (panic errorMsg) fst $ Map.lookup t m listType t m = maybe (panic errorMsg) fst $ Map.lookup t m
errorMsg = "API.Node.metrics: key absent" errorMsg = "API.Node.metrics: key absent"
{- --{-
let metrics' = Map.fromListWith (<>) $ map (\(Metric _ s1 s2 lt) -> (lt, [Vec.fromList [s1,s2]])) metrics let metrics' = Map.fromListWith (<>) $ map (\(Metric _ s1 s2 lt) -> (lt, [Vec.fromList [s1,s2]])) metrics
_ <- liftIO $ Learn.grid metrics' _ <- liftIO $ Learn.grid metrics'
en <- ask en <- ask
printDebug "path" $ _fileFolder $ _env_settings en printDebug "path" $ _fileFolder $ view repoSettings en
--} --}
pure $ Metrics metrics pure $ Metrics metrics
......
...@@ -85,6 +85,9 @@ data Settings = Settings ...@@ -85,6 +85,9 @@ data Settings = Settings
makeLenses ''Settings makeLenses ''Settings
class HasSettings env where
repoSettings :: Getter env Settings
parseJwk :: Text -> Jose.Jwk parseJwk :: Text -> Jose.Jwk
parseJwk secretStr = jwk parseJwk secretStr = jwk
...@@ -162,6 +165,9 @@ instance HasRepoSaver Env where ...@@ -162,6 +165,9 @@ instance HasRepoSaver Env where
instance HasRepo Env where instance HasRepo Env where
repoEnv = env_repo repoEnv = env_repo
instance HasSettings Env where
repoSettings = env_settings
data MockEnv = MockEnv data MockEnv = MockEnv
{ _menv_firewall :: !FireWall { _menv_firewall :: !FireWall
} }
...@@ -251,6 +257,7 @@ newEnv port file = do ...@@ -251,6 +257,7 @@ newEnv port file = do
data DevEnv = DevEnv data DevEnv = DevEnv
{ _dev_env_conn :: !Connection { _dev_env_conn :: !Connection
, _dev_env_repo :: !RepoEnv , _dev_env_repo :: !RepoEnv
, _dev_env_settings :: !Settings
} }
makeLenses ''DevEnv makeLenses ''DevEnv
...@@ -267,6 +274,9 @@ instance HasRepoSaver DevEnv where ...@@ -267,6 +274,9 @@ instance HasRepoSaver DevEnv where
instance HasRepo DevEnv where instance HasRepo DevEnv where
repoEnv = dev_env_repo repoEnv = dev_env_repo
instance HasSettings DevEnv where
repoSettings = dev_env_settings
cleanEnv :: HasRepo env => env -> IO () cleanEnv :: HasRepo env => env -> IO ()
cleanEnv env = do cleanEnv env = do
r <- takeMVar (env ^. repoEnv . renv_var) r <- takeMVar (env ^. repoEnv . renv_var)
...@@ -286,6 +296,7 @@ withDevEnv iniPath k = do ...@@ -286,6 +296,7 @@ withDevEnv iniPath k = do
pure $ DevEnv pure $ DevEnv
{ _dev_env_conn = conn { _dev_env_conn = conn
, _dev_env_repo = repo , _dev_env_repo = repo
, _dev_env_settings = devSettings
} }
-- | Run Cmd Sugar for the Repl (GHCI) -- | Run Cmd Sugar for the Repl (GHCI)
......
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