diff --git a/server/Main.hs b/server/Main.hs index b57835a..9cce78b 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -1,6 +1,6 @@ module Main where -import App +import App (run) main :: IO () main = run diff --git a/spec/TaggerSpec.hs b/spec/TaggerSpec.hs index b6ff261..aed527d 100644 --- a/spec/TaggerSpec.hs +++ b/spec/TaggerSpec.hs @@ -21,11 +21,14 @@ import Tagger.Owned (Owned (Owned)) import Tagger.Tag (Tag (Tag)) import Tagger.User (User) import Test.Hspec (Spec, around, describe, it, runIO, shouldMatchList, shouldSatisfy) -import TestServices (testServices) +import TestServices (mkTestEnv, testServices) import Prelude hiding (getContents) withTaggerApp :: (Port -> IO ()) -> IO () -withTaggerApp = testWithApplication $ mkApp <$> testServices +withTaggerApp test = do + env <- mkTestEnv + let application = mkApp env <$> testServices env + testWithApplication application test hasStatus :: Status -> Either ClientError a -> Bool hasStatus status = \case diff --git a/spec/TestServices.hs b/spec/TestServices.hs index 657ebe7..549f367 100644 --- a/spec/TestServices.hs +++ b/spec/TestServices.hs @@ -12,40 +12,42 @@ import Infrastructure.SystemTime as SystemTime import Optics import Servant.Auth.Server (defaultJWTSettings, generateKey) -testServices :: IO AppServices -testServices = do +mkTestEnv :: IO Env +mkTestEnv = do key <- generateKey - userMap <- newTVarIO mempty - contentsMap <- newTVarIO mempty SystemTime.withHandle $ \timeHandle -> Logger.withHandle timeHandle $ \loggerHandle -> do - let env = - Env - { config = error "[TestServices.hs] Config not loaded in tests.", - jwkKey = key, - handles = - Handles - { logger = loggerHandle, - database = error "[TestServices.hs] Database handle not initialized in tests.", - systemTime = timeHandle - } - } - userRepository = Repo.User.inMemory userMap - contentsRepository = Repo.Content.inMemory contentsMap - passwordManager = - encryptedPasswordManager - (env & #handles % #logger %~ withContext "PasswordManager") - (bcryptPasswordManager (defaultJWTSettings env.jwkKey)) - authenticator = Auth.authenticator userRepository passwordManager - authenticateUser = - connectedAuthenticateUser - (env & #handles % #logger %~ withContext "Authenticator") - authenticator - pure $ - AppServices - { jwtSettings = defaultJWTSettings key, - passwordManager = passwordManager, - contentRepository = connectedContentRepository env contentsRepository, - userRepository = connectedUserRepository env userRepository, - authenticateUser + pure + Env + { config = error "[TestServices.hs] Config not loaded in tests.", + jwkKey = key, + handles = + Handles + { logger = loggerHandle, + database = error "[TestServices.hs] Database handle not initialized in tests.", + systemTime = timeHandle + } } + +testServices :: Env -> IO AppServices +testServices env = do + userMap <- newTVarIO mempty + contentsMap <- newTVarIO mempty + let userRepository = Repo.User.inMemory userMap + contentsRepository = Repo.Content.inMemory contentsMap + passwordManager = + encryptedPasswordManager + (env & #handles % #logger %~ withContext "PasswordManager") + (bcryptPasswordManager (defaultJWTSettings env.jwkKey)) + authenticator = Auth.authenticator userRepository passwordManager + authenticateUser = + connectedAuthenticateUser + (env & #handles % #logger %~ withContext "Authenticator") + authenticator + pure $ + AppServices + { passwordManager = passwordManager, + contentRepository = connectedContentRepository env contentsRepository, + userRepository = connectedUserRepository env userRepository, + authenticateUser + } diff --git a/src/API.hs b/src/API.hs index 352981f..5a4675f 100644 --- a/src/API.hs +++ b/src/API.hs @@ -31,12 +31,17 @@ data ApplicationAPI mode = ApplicationAPI -- | -- Setup all the application server, providing the services needed by the various endpoints mkAPI :: AppServices -> ApplicationAPI AsServer -mkAPI AppServices {passwordManager, contentRepository, userRepository, authenticateUser} = +mkAPI services = ApplicationAPI - { tagger = authenticatedTaggerServer contentRepository, + { tagger = + authenticatedTaggerServer services.contentRepository, docs = Docs.api, healthcheck = Healthcheck.api, - authentication = Authentication.api passwordManager authenticateUser userRepository + authentication = + Authentication.api + services.passwordManager + services.authenticateUser + services.userRepository } -- | diff --git a/src/API/AppServices.hs b/src/API/AppServices.hs index 61b43a1..0e59f0c 100644 --- a/src/API/AppServices.hs +++ b/src/API/AppServices.hs @@ -18,7 +18,7 @@ import Infrastructure.Authentication.PasswordManager qualified as PasswordManage import Infrastructure.Logging.Logger (withContext) import Optics import Servant (Handler) -import Servant.Auth.Server (JWTSettings, defaultJWTSettings) +import Servant.Auth.Server (defaultJWTSettings) import Tagger.Authentication.Authenticator (Authenticator) import Tagger.Authentication.Authenticator qualified as Auth import Tagger.Repository.Content (ContentRepository) @@ -30,8 +30,7 @@ import Prelude hiding (log) -- | -- Collection of services needed by the application to work data AppServices = AppServices - { jwtSettings :: JWTSettings, - passwordManager :: PasswordManager Handler, + { passwordManager :: PasswordManager Handler, contentRepository :: ContentRepository Handler, userRepository :: UserRepository Handler, authenticateUser :: Auth.Authenticator Handler @@ -57,10 +56,8 @@ start env = connectedAuthenticateUser (env & #handles % #logger %~ withContext "Authenticator") authenticator - jwtSettings = defaultJWTSettings env.jwkKey in AppServices - { jwtSettings, - passwordManager, + { passwordManager, contentRepository, userRepository, authenticateUser diff --git a/src/App.hs b/src/App.hs index 29c7a7b..60656bd 100644 --- a/src/App.hs +++ b/src/App.hs @@ -1,9 +1,10 @@ module App (run) where +import API.AppServices qualified as AppServices import API.Config (Config (..), Port (..), apiPort) import API.Config qualified as Config import App.Env (Env (..)) -import Application (mkApp') +import Application (mkApp) import Boot (Handles (..), boot) import CLIOptions (CLIOptions (configPath)) import CLIOptions qualified @@ -19,8 +20,9 @@ run = do boot config $ \handles -> do let port = config.api.apiPort.getPort - context = Env {handles, config, jwkKey} - application = mkApp' context + env = Env {handles, config, jwkKey} + services = AppServices.start env + application = mkApp env services Logger.logInfo handles.logger $ "Accepting connections on port " <> show port <> "." Warp.run port application diff --git a/src/Application.hs b/src/Application.hs index eb03c99..1177fbe 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -1,23 +1,20 @@ -module Application (mkApp', mkApp) where +module Application (mkApp) where import API -import API.AppServices as AppServices +import API.AppServices import App.Env qualified as App import Data.Proxy (Proxy (..)) import Middleware qualified import Network.Wai (Application) import Servant (Context (EmptyContext, (:.)), serveWithContext) -import Servant.Auth.Server (defaultCookieSettings) +import Servant.Auth.Server (defaultCookieSettings, defaultJWTSettings) -mkApp' :: App.Env -> Application -mkApp' context = - let services = AppServices.start context - app = mkApp services +mkApp :: App.Env -> AppServices -> Application +mkApp env services = + let jwtSettings = defaultJWTSettings env.jwkKey + app = + serveWithContext + (Proxy :: Proxy API) + (defaultCookieSettings :. jwtSettings :. EmptyContext) + (mkAPI services) in Middleware.apply app - -mkApp :: AppServices -> Application -mkApp appServices = - serveWithContext - (Proxy :: Proxy API) - (defaultCookieSettings :. jwtSettings appServices :. EmptyContext) - (mkAPI appServices)