wire up HTTP.web

nieled · Aug 6, 2022 · 14a570b · 14a570b
1 parent 141f958
commit 14a570b
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 15 deletions.
diff --git a/package.yaml b/package.yaml
@@ -53,6 +53,7 @@ dependencies:
 - time-lens
 - wai
 - wai-extra
+- wai-middleware-static
 - warp
 
 default-extensions:

diff --git a/src/Adapter/HTTP/API/Auth.hs b/src/Adapter/HTTP/API/Auth.hs
@@ -1,8 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Adapter.HTTP.API.Auth where
 
+import           Adapter.HTTP.API.Common        ( reqCurrentUserId )
 import           Adapter.HTTP.Common            ( parseAndValidateJSON
-                                                , reqCurrentUserId
                                                 , setSessionIdInCookie
                                                 , toResult
                                                 )

diff --git a/src/Adapter/HTTP/Common.hs b/src/Adapter/HTTP/Common.hs
@@ -110,13 +110,3 @@ getCurrentUserId = do
   case mSessionId of
     Nothing        -> return Nothing
     Just sessionId -> lift $ resolveSessionId sessionId
-
-reqCurrentUserId :: (SessionRepo m, ScottyError e) => ActionT e m UserId
-reqCurrentUserId = do
-  mUserId <- getCurrentUserId
-  case mUserId of
-    Nothing -> do
-      status status401
-      json ("Auth Required" :: Text)
-      finish
-    Just userId -> return userId
diff --git a/src/Adapter/HTTP/Web/Main.hs b/src/Adapter/HTTP/Web/Main.hs
@@ -1,5 +1,6 @@
 module Adapter.HTTP.Web.Main where
 
+import qualified Adapter.HTTP.Web.Auth         as Auth
 import           Control.Monad.Reader           ( MonadIO
                                                 , MonadTrans(..)
                                                 )
@@ -20,10 +21,25 @@ import           Network.Wai                    ( Application
                                                 , Request(pathInfo)
                                                 , Response
                                                 )
+import           Network.Wai.Middleware.Gzip    ( GzipFiles(GzipCompress)
+                                                , GzipSettings(gzipFiles)
+                                                , def
+                                                , gzip
+                                                )
+import           Network.Wai.Middleware.Static  ( CacheContainer
+                                                , CachingStrategy
+                                                  ( PublicStaticCaching
+                                                  )
+                                                , Options(cacheContainer)
+                                                , addBase
+                                                , initCaching
+                                                , staticPolicy'
+                                                )
 import           Web.Scotty.Trans               ( ScottyError(..)
                                                 , ScottyT
                                                 , defaultHandler
                                                 , get
+                                                , middleware
                                                 , notFound
                                                 , scottyAppT
                                                 , status
@@ -38,7 +54,9 @@ main
      )
   => (m Response -> IO Response)
   -> IO Application
-main runner = scottyAppT runner routes
+main runner = do
+  cacheContainer <- initCaching PublicStaticCaching
+  scottyAppT runner $ routes cacheContainer
 
 routes
   :: ( MonadIO m
@@ -47,9 +65,13 @@ routes
      , EmailVerificationNotif m
      , SessionRepo m
      )
-  => ScottyT Text m ()
-routes = do
-  get "/" $ text "Hello from web!"
+  => CacheContainer
+  -> ScottyT Text m ()
+routes cachingStrategy = do
+  middleware $ gzip $ def { gzipFiles = GzipCompress }
+  middleware $ staticPolicy' cachingStrategy (addBase "src/Adapter/HTTP/Web")
+
+  Auth.routes
 
   notFound $ do
     status status404

diff --git a/uaa-hs.cabal b/uaa-hs.cabal
@@ -86,6 +86,7 @@ library
     , time-lens
     , wai
     , wai-extra
+    , wai-middleware-static
     , warp
   default-language: Haskell2010
 
@@ -138,6 +139,7 @@ executable uaa-hs-exe
     , uaa-hs
     , wai
     , wai-extra
+    , wai-middleware-static
     , warp
   default-language: Haskell2010
 
@@ -191,5 +193,6 @@ test-suite uaa-hs-test
     , uaa-hs
     , wai
     , wai-extra
+    , wai-middleware-static
     , warp
   default-language: Haskell2010