From 889ebe60bfd8458c6be9207938bdff1b5f11471e Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sat, 2 Mar 2024 22:11:02 +0100
Subject: [PATCH 01/22] Made request logger less verbose by not logging
 requests to static files

This was the existing behaviour until we switched out the static middleware a while ago
---
 IHP/ControllerSupport.hs | 14 ++++++-----
 IHP/ErrorController.hs   | 13 ++++------
 IHP/IDE/ToolServer.hs    |  5 ++--
 IHP/RouterSupport.hs     | 51 ++++++++++++++++++++--------------------
 IHP/Server.hs            | 23 +++++-------------
 5 files changed, 47 insertions(+), 59 deletions(-)

diff --git a/IHP/ControllerSupport.hs b/IHP/ControllerSupport.hs
index a5468b0ef..b32988fde 100644
--- a/IHP/ControllerSupport.hs
+++ b/IHP/ControllerSupport.hs
@@ -66,6 +66,9 @@ class InitControllerContext application where
     initContext = pure ()
     {-# INLINABLE initContext #-}
 
+instance InitControllerContext () where
+    initContext = pure ()
+
 {-# INLINE runAction #-}
 runAction :: forall controller. (Controller controller, ?context :: ControllerContext, ?modelContext :: ModelContext, ?applicationContext :: ApplicationContext, ?requestContext :: RequestContext) => controller -> IO ResponseReceived
 runAction controller = do
@@ -149,12 +152,11 @@ prepareRLSIfNeeded modelContext = do
         Nothing -> pure modelContext
 
 {-# INLINE startWebSocketApp #-}
-startWebSocketApp :: forall webSocketApp application. (?applicationContext :: ApplicationContext, ?context :: RequestContext, InitControllerContext application, ?application :: application, Typeable application, WebSockets.WSApp webSocketApp) => IO ResponseReceived -> IO ResponseReceived
-startWebSocketApp onHTTP = do
+startWebSocketApp :: forall webSocketApp application. (?applicationContext :: ApplicationContext, ?context :: RequestContext, InitControllerContext application, ?application :: application, Typeable application, WebSockets.WSApp webSocketApp) => IO ResponseReceived -> Network.Wai.Application
+startWebSocketApp onHTTP request respond = do
     let ?modelContext = ?applicationContext.modelContext
-    let ?requestContext = ?context
-    let respond = ?context.respond
-    let request = ?context.request
+    requestContext <- createRequestContext ?applicationContext request respond
+    let ?requestContext = requestContext
 
     let handleConnection pendingConnection = do
             connection <- WebSockets.acceptRequest pendingConnection
@@ -177,7 +179,7 @@ startWebSocketApp onHTTP = do
             Just response -> respond response
             Nothing -> onHTTP
 {-# INLINE startWebSocketAppAndFailOnHTTP #-}
-startWebSocketAppAndFailOnHTTP :: forall webSocketApp application. (?applicationContext :: ApplicationContext, ?context :: RequestContext, InitControllerContext application, ?application :: application, Typeable application, WebSockets.WSApp webSocketApp) => IO ResponseReceived
+startWebSocketAppAndFailOnHTTP :: forall webSocketApp application. (?applicationContext :: ApplicationContext, ?context :: RequestContext, InitControllerContext application, ?application :: application, Typeable application, WebSockets.WSApp webSocketApp) => Network.Wai.Application
 startWebSocketAppAndFailOnHTTP = startWebSocketApp @webSocketApp @application (respond $ responseLBS HTTP.status400 [(hContentType, "text/plain")] "This endpoint is only available via a WebSocket")
     where
         respond = ?context.respond
diff --git a/IHP/ErrorController.hs b/IHP/ErrorController.hs
index 29b84d9b8..a468d0bcc 100644
--- a/IHP/ErrorController.hs
+++ b/IHP/ErrorController.hs
@@ -316,9 +316,10 @@ recordNotFoundExceptionHandlerProd exception controller additionalInfo =
                 in Just (handleNotFound ?context.request ?context.respond)
         Nothing -> Nothing
 
-handleRouterException :: (?context :: RequestContext) => SomeException -> IO ResponseReceived
-handleRouterException exception =
-    case fromException exception of
+handleRouterException :: (?applicationContext :: ApplicationContext) => SomeException -> Application
+handleRouterException exception request respond =
+    let ?context = ?applicationContext
+    in case fromException exception of
         Just Router.NoConstructorMatched { expectedType, value, field } -> do
             let errorMessage = [hsx|
                     <p>Routing failed with: {tshow exception}</p>
@@ -329,14 +330,12 @@ handleRouterException exception =
             let title = case value of
                     Just value -> [hsx|Expected <strong>{expectedType}</strong> for field <strong>{field}</strong> but got <q>{value}</q>|]
                     Nothing -> [hsx|The action was called without the required <q>{field}</q> parameter|]
-            let RequestContext { respond } = ?context
             respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
         Just Router.BadType { expectedType, value = Just value, field } -> do
             let errorMessage = [hsx|
                     <p>Routing failed with: {tshow exception}</p>
                 |]
             let title = [hsx|Query parameter <q>{field}</q> needs to be a <q>{expectedType}</q> but got <q>{value}</q>|]
-            let RequestContext { respond } = ?context
             respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
         _ -> case fromException exception of
             Just Router.UnexpectedMethodException { allowedMethods = [Router.DELETE], method = Router.GET } -> do
@@ -371,7 +370,6 @@ handleRouterException exception =
                         </p>
                     |]
                 let title = [hsx|Action was called from a GET request, but needs to be called as a DELETE request|]
-                let RequestContext { respond } = ?context
                 respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
             Just Router.UnexpectedMethodException { allowedMethods = [Router.POST], method = Router.GET } -> do
                 let errorMessage = [hsx|
@@ -386,7 +384,6 @@ handleRouterException exception =
                         </p>
                     |]
                 let title = [hsx|Action was called from a GET request, but needs to be called as a POST request|]
-                let RequestContext { respond } = ?context
                 respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
             Just Router.UnexpectedMethodException { allowedMethods, method } -> do
                 let errorMessage = [hsx|
@@ -397,7 +394,6 @@ handleRouterException exception =
                         </p>
                     |]
                 let title = [hsx|Action was called with a {method} request, but needs to be called with one of these request methods: <q>{allowedMethods}</q>|]
-                let RequestContext { respond } = ?context
                 respond $ responseBuilder status400 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
             _ -> do
                 let errorMessage = [hsx|
@@ -407,7 +403,6 @@ handleRouterException exception =
                         <p>Are you trying to do a DELETE action, but your link is missing class="js-delete"?</p>
                     |]
                 let title = H.text "Routing failed"
-                let RequestContext { respond } = ?context
                 respond $ responseBuilder status500 [(hContentType, "text/html")] (Blaze.renderHtmlBuilder (renderError title errorMessage))
 
 
diff --git a/IHP/IDE/ToolServer.hs b/IHP/IDE/ToolServer.hs
index 722d58478..dae1e7dfa 100644
--- a/IHP/IDE/ToolServer.hs
+++ b/IHP/IDE/ToolServer.hs
@@ -37,6 +37,7 @@ import qualified System.Process as Process
 import System.Info
 import qualified IHP.EnvVar as EnvVar
 import qualified IHP.AutoRefresh.Types as AutoRefresh
+import qualified IHP.AutoRefresh as AutoRefresh
 import IHP.Controller.Context
 import qualified IHP.IDE.ToolServer.Layout as Layout
 import IHP.Controller.Layout
@@ -85,7 +86,7 @@ startToolServer' port isDebugMode = do
             let ?applicationContext = applicationContext
             requestContext <- ControllerSupport.createRequestContext applicationContext request respond
             let ?context = requestContext
-            frontControllerToWAIApp toolServerApplication [] (staticApp request respond)
+            frontControllerToWAIApp @ToolServerApplication @AutoRefresh.AutoRefreshWSApp (\app -> app) toolServerApplication staticApp request respond
 
     let openAppUrl = openUrl ("http://localhost:" <> tshow port <> "/")
     let warpSettings = Warp.defaultSettings
@@ -157,4 +158,4 @@ readDatabaseNeedsMigration :: (?context :: ControllerContext) => IO Bool
 readDatabaseNeedsMigration = do
     context <- theDevServerContext
     state <- readIORef (context.appStateRef)
-    readIORef (state.databaseNeedsMigration)
+    readIORef (state.databaseNeedsMigration)
\ No newline at end of file
diff --git a/IHP/RouterSupport.hs b/IHP/RouterSupport.hs
index 2e88ea0be..addf6f42d 100644
--- a/IHP/RouterSupport.hs
+++ b/IHP/RouterSupport.hs
@@ -84,37 +84,38 @@ runAction'
     :: forall application controller
      . ( Controller controller
        , ?applicationContext :: ApplicationContext
-       , ?context :: RequestContext
        , InitControllerContext application
        , ?application :: application
        , Typeable application
        , Typeable controller
        )
-     => controller -> (TMap.TMap -> TMap.TMap) -> IO ResponseReceived
-runAction' controller contextSetter = do
+     => controller -> (TMap.TMap -> TMap.TMap) -> Application
+runAction' controller contextSetter request respond = do
     let ?modelContext = ApplicationContext.modelContext ?applicationContext
-    let ?requestContext = ?context
+    requestContext <- createRequestContext ?applicationContext request respond
+    let ?context = requestContext
+    let ?requestContext = requestContext
     contextOrErrorResponse <- newContextForAction contextSetter controller
     case contextOrErrorResponse of
         Left res -> res
         Right context -> let ?context = context in runAction controller
 {-# INLINABLE runAction' #-}
 
-type RouteParseResult = IO (TMap.TMap -> TMap.TMap, (TMap.TMap -> TMap.TMap) -> IO ResponseReceived)
+type RouteParseResult = IO (TMap.TMap -> TMap.TMap, (TMap.TMap -> TMap.TMap) -> Application)
 type RouteParser = Parser (RouteParseResult)
 
-toRouteParser :: Parser (IO ResponseReceived) -> RouteParser
+toRouteParser :: Parser Application -> RouteParser
 toRouteParser parser = do
     controller <- parser
     pure $ pure (\t -> t, \_ -> controller)
 
-toRouteParser' :: Parser ((TMap.TMap -> TMap.TMap) -> IO ResponseReceived) -> RouteParser
+toRouteParser' :: Parser ((TMap.TMap -> TMap.TMap) -> Application) -> RouteParser
 toRouteParser' parser = do
     controller <- parser
     pure $ pure (\t -> t, controller)
 
-toRouteParseResult :: IO ResponseReceived -> RouteParseResult
-toRouteParseResult ioResponseReceived = pure (\t -> t, \_ -> ioResponseReceived)
+toRouteParseResult :: Application -> RouteParseResult
+toRouteParseResult application = pure (\t -> t, \_ -> application)
 
 class FrontController application where
     controllers
@@ -132,8 +133,8 @@ defaultRouter
     => [RouteParser] -> RouteParser
 defaultRouter additionalControllers = do
     let allControllers = controllers <> additionalControllers
-    ioResponseReceived <- choice $ map (\r -> r <* endOfInput) allControllers
-    pure ioResponseReceived
+    applications <- choice $ map (\r -> r <* endOfInput) allControllers
+    pure applications
 {-# INLINABLE defaultRouter #-}
 
 class HasPath controller where
@@ -835,13 +836,20 @@ startPage action = get (ByteString.pack (actionPrefix @action)) action
 withPrefix prefix routes = string prefix >> choice (map (\r -> r <* endOfInput) routes)
 {-# INLINABLE withPrefix #-}
 
-runApp :: (?applicationContext :: ApplicationContext, ?context :: RequestContext) => RouteParser -> IO ResponseReceived -> IO ResponseReceived
-runApp routes notFoundAction = do
-    let path = ?context.request.rawPathInfo
-        handleException :: SomeException -> IO (Either String (IO ResponseReceived))
+frontControllerToWAIApp :: forall app (autoRefreshApp :: Type). (?applicationContext :: ApplicationContext, FrontController app, WSApp autoRefreshApp, Typeable autoRefreshApp, InitControllerContext ()) => Middleware -> app -> Application -> Application
+frontControllerToWAIApp middleware application notFoundAction request respond = do
+    let requestContext = RequestContext { request, respond, requestBody = FormBody { params = [], files = [] }, vault = ?applicationContext.session, frameworkConfig = ?applicationContext.frameworkConfig }
+
+    let ?context = requestContext
+
+    let
+        path = request.rawPathInfo
+        handleException :: SomeException -> IO (Either String Application)
         handleException exception = pure $ Right $ ErrorController.handleRouterException exception
 
-    routedAction :: Either String (IO ResponseReceived) <-
+        routes = let ?application = application in router [let ?application = () in webSocketApp @autoRefreshApp]
+
+    routedAction :: Either String Application <-
         (do
             res <- evaluate $ parseOnly (routes <* endOfInput) path
             case res of
@@ -850,17 +858,10 @@ runApp routes notFoundAction = do
                     (tmapSetter, controllerFn) <- io
                     pure $ Right $ controllerFn $ tmapSetter
             )
-            -- pure (undefined::IO ResponseReceived)))
         `Exception.catch` handleException
     case routedAction of
-        Left message -> notFoundAction
-        Right action -> action
-{-# INLINABLE runApp #-}
-
-frontControllerToWAIApp :: forall app. (?applicationContext :: ApplicationContext, ?context :: RequestContext, FrontController app) => app -> [RouteParser] -> IO ResponseReceived -> IO ResponseReceived
-frontControllerToWAIApp application additionalControllers notFoundAction = runApp defaultRouter notFoundAction
-    where
-        defaultRouter :: RouteParser = (let ?application = application in router additionalControllers)
+        Left message -> notFoundAction request respond
+        Right action -> (middleware action) request respond
 {-# INLINABLE frontControllerToWAIApp #-}
 
 mountFrontController :: forall frontController. (?applicationContext :: ApplicationContext, ?context :: RequestContext, FrontController frontController) => frontController -> RouteParser
diff --git a/IHP/Server.hs b/IHP/Server.hs
index ed93305a6..ce4e8e316 100644
--- a/IHP/Server.hs
+++ b/IHP/Server.hs
@@ -65,10 +65,9 @@ run configBuilder = do
                     . runServer frameworkConfig
                     . customMiddleware
                     . corsMiddleware
-                    . sessionMiddleware
-                    . requestLoggerMiddleware
                     . methodOverridePost
-                    $ application staticApp
+                    . sessionMiddleware
+                    $ application staticApp requestLoggerMiddleware
 
 {-# INLINABLE run #-}
 
@@ -99,7 +98,7 @@ initStaticApp frameworkConfig = do
 
         frameworkStaticDir = libDir <> "/static/"
         frameworkSettings = (Static.defaultWebAppSettings frameworkStaticDir)
-                { Static.ss404Handler = Just handleNotFound
+                { Static.ss404Handler = Just (frameworkConfig.requestLoggerMiddleware handleNotFound)
                 , Static.ssMaxAge = maxAge
                 }
         appSettings = (Static.defaultWebAppSettings "static/")
@@ -127,16 +126,9 @@ initCorsMiddleware FrameworkConfig { corsResourcePolicy } = case corsResourcePol
         Just corsResourcePolicy -> Cors.cors (const (Just corsResourcePolicy))
         Nothing -> id
 
-application :: (FrontController RootApplication, ?applicationContext :: ApplicationContext) => Application -> Application
-application staticApp request respond = do
-        requestContext <- ControllerSupport.createRequestContext ?applicationContext request respond
-        let ?context = requestContext
-        let builtinControllers = let ?application = () in
-                [ webSocketApp @AutoRefresh.AutoRefreshWSApp
-                , webSocketAppWithCustomPath @AutoRefresh.AutoRefreshWSApp "" -- For b.c. with older versions of ihp-auto-refresh.js
-                ]
-
-        frontControllerToWAIApp RootApplication builtinControllers (staticApp request respond)
+application :: (FrontController RootApplication, ?applicationContext :: ApplicationContext) => Application -> Middleware -> Application
+application staticApp middleware request respond = do
+    frontControllerToWAIApp @RootApplication @AutoRefresh.AutoRefreshWSApp middleware RootApplication staticApp request respond
 {-# INLINABLE application #-}
 
 runServer :: (?applicationContext :: ApplicationContext) => FrameworkConfig -> Application -> IO ()
@@ -152,9 +144,6 @@ runServer FrameworkConfig { environment = Env.Production, appPort, exceptionTrac
                     |> Warp.setPort appPort
                     |> Warp.setOnException exceptionTracker.onException
 
-instance ControllerSupport.InitControllerContext () where
-    initContext = pure ()
-
 withInitalizers :: FrameworkConfig -> ModelContext -> IO () -> IO ()
 withInitalizers frameworkConfig modelContext continue = do
         let ?context = frameworkConfig

From b1cf07d5130cfc6e806e5a50cfaff0a397f714dc Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sat, 2 Mar 2024 22:11:14 +0100
Subject: [PATCH 02/22] Fixed demo app in Main.hs not working

---
 Main.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/Main.hs b/Main.hs
index 0442bc236..0775466b4 100644
--- a/Main.hs
+++ b/Main.hs
@@ -13,12 +13,19 @@ data DemoController = DemoAction deriving (Eq, Show, Data)
 
 instance AutoRoute DemoController
 instance InitControllerContext RootApplication
-instance FrontController RootApplication where
+data WebApplication = WebApplication deriving (Eq, Show)
+
+instance InitControllerContext WebApplication where
+    initContext = pure ()
+
+instance FrontController WebApplication where
     controllers =
-        [ parseRoute @DemoController
-        , startPage DemoAction
+        [ startPage DemoAction
         ]
 
+instance FrontController RootApplication where
+    controllers = [ mountFrontController WebApplication ]
+
 instance Controller DemoController where
     action DemoAction = renderPlain "Hello World!"
 

From be721e54f5b278bfc7bd81b1adfe6f0a70543d41 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sat, 2 Mar 2024 22:11:33 +0100
Subject: [PATCH 03/22] Define IHP_LIB for IHP development

---
 .envrc | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.envrc b/.envrc
index cffc922b0..a7d0f9482 100644
--- a/.envrc
+++ b/.envrc
@@ -1 +1,2 @@
 use flake . --impure
+export IHP_LIB=lib/IHP/
\ No newline at end of file

From c70c578682a6a3c800d637ad24c184d53d3568c2 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sat, 2 Mar 2024 22:19:12 +0100
Subject: [PATCH 04/22] Fixed tests

---
 Test/Controller/AccessDeniedSpec.hs | 2 +-
 Test/Controller/NotFoundSpec.hs     | 2 +-
 Test/RouterSupportSpec.hs           | 2 +-
 Test/SEO/Sitemap.hs                 | 2 +-
 Test/ViewSupportSpec.hs             | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/Test/Controller/AccessDeniedSpec.hs b/Test/Controller/AccessDeniedSpec.hs
index 8a847540c..34ca74011 100644
--- a/Test/Controller/AccessDeniedSpec.hs
+++ b/Test/Controller/AccessDeniedSpec.hs
@@ -75,7 +75,7 @@ makeApplication :: (?applicationContext :: ApplicationContext) => IO Application
 makeApplication = do
     store <- Session.mapStore_
     let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie ?applicationContext.session
-    pure (sessionMiddleware (Server.application handleNotFound))
+    pure (sessionMiddleware $ (Server.application handleNotFound) (\app -> app))
 
 assertAccessDenied :: SResponse -> IO ()
 assertAccessDenied response = do
diff --git a/Test/Controller/NotFoundSpec.hs b/Test/Controller/NotFoundSpec.hs
index 2c526db25..3448c5cec 100644
--- a/Test/Controller/NotFoundSpec.hs
+++ b/Test/Controller/NotFoundSpec.hs
@@ -75,7 +75,7 @@ makeApplication :: (?applicationContext :: ApplicationContext) => IO Application
 makeApplication = do
     store <- Session.mapStore_
     let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie ?applicationContext.session
-    pure (sessionMiddleware (Server.application handleNotFound))
+    pure (sessionMiddleware $ (Server.application handleNotFound) (\app -> app))
 
 assertNotFound :: SResponse -> IO ()
 assertNotFound response = do
diff --git a/Test/RouterSupportSpec.hs b/Test/RouterSupportSpec.hs
index 09a4c0158..bac750f42 100644
--- a/Test/RouterSupportSpec.hs
+++ b/Test/RouterSupportSpec.hs
@@ -141,7 +141,7 @@ config = do
     option (AppPort 8000)
 
 application :: (?applicationContext :: ApplicationContext) => Application
-application = Server.application handleNotFound
+application = Server.application handleNotFound (\app -> app)
 
 tests :: Spec
 tests = beforeAll (mockContextNoDatabase WebApplication config) do
diff --git a/Test/SEO/Sitemap.hs b/Test/SEO/Sitemap.hs
index 82155b618..ed85c1d1b 100644
--- a/Test/SEO/Sitemap.hs
+++ b/Test/SEO/Sitemap.hs
@@ -79,5 +79,5 @@ tests = beforeAll (mockContextNoDatabase WebApplication config) do
     describe "SEO" do
         describe "Sitemap" do
             it "should render a XML Sitemap" $ withContext do
-                runSession (testGet "/sitemap.xml") (Server.application handleNotFound)
+                runSession (testGet "/sitemap.xml") (Server.application handleNotFound (\app -> app))
                     >>= assertSuccess "<?xml version=\"1.0\" encoding=\"UTF-8\"?><urlset xmlns=\"http://www.sitemaps.org/schemas/sitemap/0.9\"><url><loc>http://localhost:8000/test/ShowPost?postId=00000000-0000-0000-0000-000000000000</loc><lastmod>2105-04-16</lastmod><changefreq>hourly</changefreq></url></urlset>"
diff --git a/Test/ViewSupportSpec.hs b/Test/ViewSupportSpec.hs
index 8911230cd..f5fe528d7 100644
--- a/Test/ViewSupportSpec.hs
+++ b/Test/ViewSupportSpec.hs
@@ -102,7 +102,7 @@ makeApplication :: (?applicationContext :: ApplicationContext) => IO Application
 makeApplication = do
     store <- Session.mapStore_
     let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie ?applicationContext.session
-    pure (sessionMiddleware (Server.application handleNotFound))
+    pure (sessionMiddleware $ (Server.application handleNotFound (\app -> app)))
 
 tests :: Spec
 tests = beforeAll (mockContextNoDatabase WebApplication config) do

From 0a562b229b6eefe318f575d3bb8e632e84ecccba Mon Sep 17 00:00:00 2001
From: Aron Novak <AronNovak@users.noreply.github.com>
Date: Sat, 2 Mar 2024 22:28:09 +0100
Subject: [PATCH 05/22] More AWS documentation (#1913)

* more aws bits

* Update Guide/deployment.markdown

* Update Guide/deployment.markdown

Co-authored-by: Amitai Burstein <amitai@gizra.com>

* Update Guide/deployment.markdown

Co-authored-by: Amitai Burstein <amitai@gizra.com>

* Update Guide/deployment.markdown

* specify least privilege-based better iam policy

* s3 doc

* logging part

* proper initial db guide

* gitignore

* Update Guide/deployment.markdown

* added flake.nix part

* db url fix

---------

Co-authored-by: Amitai Burstein <amitai@gizra.com>
---
 .gitignore                |   2 +
 Guide/deployment.markdown | 142 ++++++++++++++++++++++++++++++++++++--
 2 files changed, 139 insertions(+), 5 deletions(-)

diff --git a/.gitignore b/.gitignore
index ba0123cec..e8d960f41 100644
--- a/.gitignore
+++ b/.gitignore
@@ -20,3 +20,5 @@ devenv.local.nix
 
 # nix build output links
 result*
+
+.idea
diff --git a/Guide/deployment.markdown b/Guide/deployment.markdown
index 643e875b1..aa4e54b94 100644
--- a/Guide/deployment.markdown
+++ b/Guide/deployment.markdown
@@ -10,19 +10,151 @@ IHP comes with a standard command called `deploy-to-nixos`. This tool is a littl
 
 AWS EC2 is a good choice for deploying IHP in a professional setup.
 
-### Creating a new EC2 Instance
+### AWS infrastructure preparation
+
+#### Creating a new EC2 Instance
 
 Start a new EC2 instance and use the official NixOS AMI `NixOS-23.05.426.afc48694f2a-x86_64-linux`. You can find the latest NixOS AMI at https://nixos.org/download#nixos-amazon
 
 Example steps:
  - Visit [EC2 creation page](https://eu-west-1.console.aws.amazon.com/ec2/home?region=eu-west-1#LaunchInstances:) in your desired region.
- - Select AMI by name, it will appear under "Community AMIs" after searching by name.
- - Select at least a `t3a.small` instance size to have enough RAM for the compilation
- - Specify a generous root disk volume. By nature NixOS can consume lots of disk space as you trial-and-error your application deployment. As a minimum, we advise 60 GiB
+ - Select AMI by name, it will appear under "Community AMIs" after searching by name (there can be a slight delay before the result appears as it searches in all community AMIs).
+ - Select at least a `t3a.small` instance size to have enough RAM for the compilation. For a real-world application, chances are that you need `t3a.medium` to successfully compile it.
+ - Specify a generous root disk volume. By nature NixOS can consume lots of disk space as you trial-and-error your application deployment. As a minimum, we advise 60 GiB.
  - Under `Network settings`, allow SSH traffic from your IP address only, allow HTTPS and HTTP traffic from the internet. Due to the certificate validation for Let's Encrypt, even if your application does not need to have it, allow HTTP too.
  - Make sure to attach SSH keys to the instance at creation time, that is available locally, so you can SSH to the EC2 instance without password later.
+   - Either before creating the EC2 instance, you import your existing keypair to [EC2 Key Pairs](https://us-east-1.console.aws.amazon.com/ec2/home?region=eu-west-1#ImportKeyPair:), then you should select it at the EC2 creation page.
+   - Or let AWS create one on-the-fly: ![image](https://github.com/digitallyinduced/ihp/assets/114076/317b022a-ad6e-43ae-931d-8710db0b711c) . Afterwards, you will be able to download the private key file, later on it is referred as `ihp-app.pem` in this documentation.
+
+#### (Optional) Creating an RDS Instance
+
+For production systems, it is advised to use a fully managed PostgreSQL instance, it can be multi-region, fault tolerant, but most of all,
+daily backups happen automatically with configurable retention.
+
+To switch from the local PostgreSQL instance to a managed one (you can do it after or before the initial deployment), you can execute the following steps:
+ - Visit [RDS creation page](https://us-east-1.console.aws.amazon.com/rds/home?region=eu-west-1#launch-dbinstance:) in your desired region.
+ - Select PostgreSQL as the Engine Type.
+ - Select a compatible Engine Version, there are good chances that the very last version will fit.
+ - At Templates, Choose `Free Tier` for any non-live environments, `Production` for the live environment.
+ - (Optional) Choose `Auto generate password` for having a secure master password.
+ - Choose `Connect to an EC2 compute resource` and select your already existing EC2 instance.
+ - Then you can `Create database`. This process is slow, check back in 10 minutes or so afterward. Note down the auto-generated password.
+ - Edit your `flake.nix`, under `flake.nixosConfigurations."ihp-app".services.ihp`, you can specify the database URL like: `databaseUrl = lib.mkForce "postgresql://postgres:YOUR-PASSWORD@YOUR-HOSTNAME.amatonaws.com/postgres";`. You can find the proper hostname after the initialization is complete, on the RDS instance detail page.
+ - `pg_dump --no-owner --no-acl` your existing local database on the EC2 instance directly, and then, you can load it to the newly created instance via `pgsql`. `deploy-to-nixos` won't populate the initial schema at an existing remote database, that's why dumping, `scp d`ing and loading it via `psql` is necessary.
+
+#### (Optional) Creating an S3 bucket
+
+If your application needs to store files, on AWS, those should use an S3 bucket for that.
+
+Infrastructure-side preparation:
+ - Visit the [S3 creation page](https://s3.console.aws.amazon.com/s3/bucket/create?region=eu-west-1) and create a bucket in the same region..If objects should or should not be public, it's up to the application's business requirements. The S3 [ARN](https://docs.aws.amazon.com/IAM/latest/UserGuide/reference-arns.html) from the S3 details page should be noted down.
+ - Create an new IAM user for the S3 access. Create an [AWS access key](https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_access-keys.html) for that IAM user.
+ - For that user, attach a policy that allows access to the bucket, for example:
+```json
+{
+    "Version": "2012-10-17",
+    "Statement": [
+        {
+            "Sid": "VisualEditor1",
+            "Effect": "Allow",
+            "Action": "s3:*",
+            "Resource": [
+                "YOUR-BUCKET-ARN",
+                "YOUR-BUCKET-ARN/*"
+            ]
+        }
+    ]
+}
+```
+ - See the [Storage guide](https://ihp.digitallyinduced.com/Guide/file-storage.html#s3) on how to use the access key.
+
+ If your application requires so, make the S3 bucket publicly available.
+  - Go to https://s3.console.aws.amazon.com/s3/buckets/YOUR-BUCKET?region=eu-west-1&bucketType=general&tab=permissions (permissions tab of the S3 bucket)
+  - Set `Block all public access˙ to entirely off.
+  - Set a bucket policy like this:
+```json
+{
+    "Version": "2012-10-17",
+    "Statement": [
+        {
+            "Sid": "PublicReadGetObject",
+            "Effect": "Allow",
+            "Principal": "*",
+            "Action": "s3:GetObject",
+            "Resource": "YOUR-BUCKET-ARN/*"
+        }
+    ]
+}
+```
+ - Test the access by locating a file in a bucket under Objects and "Copy S3 URI" for it.
+
+#### (Optional) Connecting CloudWatch
+
+For a production system, logging is essential, so you are informed about anomalies before customer complaints, or you are able to provide an evidence for an incident and so on.
+
+Mind the region of your EC2 instance for these steps.
+
+- [Create a CloudWatch log group](https://eu-west-1.console.aws.amazon.com/cloudwatch/home?region=eu-west-1#logsV2:log-groups/create-log-group), note down the ARN.
+- Create a log stream inside the previously created log group, for instance `in`.
+- Create an IAM user with an access key and secret with the following policy:
+```json
+{
+	"Version": "2012-10-17",
+	"Statement": [
+		{
+			"Effect": "Allow",
+			"Action": [
+				"logs:CreateLogStream",
+				"logs:PutLogEvents",
+				"logs:DescribeLogStreams"
+			],
+			"Resource": [
+				"[YOUR-GROUP-ARN]",
+				"[YOUR-GROUP-ARN]:*"
+			]
+		}
+	]
+}
+```
+- Configure the `services.vector` part in your `flake.nix` to activate logging:
+```
+services.vector = {
+    enable = true;
+    journaldAccess = true;
+    settings = {
+        sources.journald = {
+            type = "journald";
+            include_units = ["app.service" "nginx.service" "worker.service"];
+        };
+        transforms.remap_remove_specific_keys = {
+             type = "remap";
+             inputs = ["journald"];
+             source = ''
+                 del(._STREAM_ID)
+                 del(._SYSTEMD_UNIT)
+                 del(._BOOT_ID)
+                 del(.source_type)
+             '';
+        };
+        sinks.out = {
+            auth = {
+                access_key_id = "YOUR-IAM-ACCESS-KEY";
+                secret_access_key = "YOUR-IAM-ACCESS-KEY";
+            };
+            inputs  = ["remap_remove_specific_keys"];
+            type = "aws_cloudwatch_logs";
+            compression = "gzip";
+            encoding.codec = "json";
+            region = "us-east-1";
+            group_name = "tpp-qa";
+            stream_name = "in";
+        };
+    };
+};
+```
+- Review the incoming log entries, adjust remapping accordingly. You might want to remove or transform more entries to make the logs useful for alerts or accountability.
 
-### Connecting to the EC2 Instance
+### Connecting to the EC2 / Virtual Machine Instance
 
 After you've created the instance, configure your local SSH settings to point to the instance.
 

From cd882069b9ebbd20575545f44a0d006cc2e4bccd Mon Sep 17 00:00:00 2001
From: Montmorency <lamberh@tcd.ie>
Date: Sat, 2 Mar 2024 21:29:08 +0000
Subject: [PATCH 06/22] Emacs direnv (#1872)

* emacs direnv and lsp config.

* added link to emacs config for direnv/nix haskell.
---
 Guide/editors.markdown         | 64 ++++++++++++++++++++++++++++++++++
 Guide/search/package-lock.json | 58 ++++++++++++++++++++++++++++++
 2 files changed, 122 insertions(+)

diff --git a/Guide/editors.markdown b/Guide/editors.markdown
index 26f78b3c4..76de50f3e 100644
--- a/Guide/editors.markdown
+++ b/Guide/editors.markdown
@@ -149,6 +149,70 @@ and `chmod +x ~/bin/emacs-line`, then export this env var in your shell (e.g. in
 export IHP_EDITOR="$HOME/bin/emacs-line"
 ```
 
+Another useful package set that integrates with lsp/lsp-ui and loads the default nix environment from direnv as well as removing [common flycheck issue](https://github.com/joncol/dotfiles/blob/master/homedir/.emacs.d/init.el). 
+This config also adds a jump to definition for functions bound to "C-c p":
+
+```emacs
+(use-package direnv
+  :defer
+  :custom
+  (direnv-always-show-summary nil)
+  :config
+  (direnv-mode))
+(use-package lsp-mode
+  :custom
+  (lsp-lens-enable nil)
+  (lsp-enable-symbol-highlighting nil)
+
+  :hook
+  (lsp-mode . lsp-enable-which-key-integration)
+
+  :config
+  ;; This is to make `lsp-mode' work with `direnv' and pick up the correct
+  ;; version of GHC.
+  (advice-add 'lsp :before #'direnv-update-environment)
+  (setq lsp-modeline-code-actions-enable nil))
+
+(use-package lsp-ui
+  :hook (prog-mode . lsp-ui-mode)
+  :bind (("C-c p" . lsp-ui-peek-find-definitions))
+  :config
+  (setq lsp-ui-doc-position 'bottom))
+
+;; (add-hook 'haskell-mode-hook #'lsp)
+(use-package flycheck-haskell
+  ;; Disabling this package, since it only gives error:
+  ;; "Reading Haskell configuration failed with exit code Segmentation fault and
+  ;; output:", when trying to run it in Nix/direnv setup.
+  :disabled
+  :hook (haskell-mode . flycheck-haskell-setup))
+
+(add-hook 'haskell-mode-hook
+          (lambda ()
+            (rainbow-mode -1)
+;; we aren't evil:
+;;            (evil-leader/set-key "x h" 'haskell-hoogle)
+;;            (setq evil-shift-width 2)
+            (define-key haskell-mode-map (kbd "C-c C-c C-s")
+              'haskell-mode-stylish-buffer)
+            (bind-key (kbd "C-c C-c C-a") 'haskell-sort-imports)
+            (setq haskell-auto-insert-module-format-string
+                  "module %s\n  () where\n\n")
+            (haskell-auto-insert-module-template)
+            (smartparens-mode)
+            (sp-local-pair 'haskell-mode "{" "}")
+            (setq haskell-hoogle-command nil)
+            (ligature-mode)))
+
+(use-package lsp-haskell
+  :hook ((haskell-mode . lsp-deferred)
+         (haskell-literate-mode . lsp-deferred))
+  :custom
+  (lsp-haskell-server-path "haskell-language-server"))
+
+(use-package haskell-mode
+  :defer)
+```
 
 ## Using IHP with Vim / NeoVim
 
diff --git a/Guide/search/package-lock.json b/Guide/search/package-lock.json
index c41bd2464..4e84da9b5 100644
--- a/Guide/search/package-lock.json
+++ b/Guide/search/package-lock.json
@@ -177,6 +177,29 @@
         "react-dom": ">= 16.8.0 < 18.0.0"
       }
     },
+    "node_modules/@types/prop-types": {
+      "version": "15.7.11",
+      "resolved": "https://registry.npmjs.org/@types/prop-types/-/prop-types-15.7.11.tgz",
+      "integrity": "sha512-ga8y9v9uyeiLdpKddhxYQkxNDrfvuPrlFb0N1qnZZByvcElJaXthF1UhvCh9TLWJBEHeNtdnbysW7Y6Uq8CVng==",
+      "peer": true
+    },
+    "node_modules/@types/react": {
+      "version": "17.0.71",
+      "resolved": "https://registry.npmjs.org/@types/react/-/react-17.0.71.tgz",
+      "integrity": "sha512-lfqOu9mp16nmaGRrS8deS2Taqhd5Ih0o92Te5Ws6I1py4ytHBcXLqh0YIqVsViqwVI5f+haiFM6hju814BzcmA==",
+      "peer": true,
+      "dependencies": {
+        "@types/prop-types": "*",
+        "@types/scheduler": "*",
+        "csstype": "^3.0.2"
+      }
+    },
+    "node_modules/@types/scheduler": {
+      "version": "0.16.8",
+      "resolved": "https://registry.npmjs.org/@types/scheduler/-/scheduler-0.16.8.tgz",
+      "integrity": "sha512-WZLiwShhwLRmeV6zH+GkbOFT6Z6VklCItrDioxUnv+u4Ll+8vKeFySoFyK/0ctcRpOmwAicELfmys1sDc/Rw+A==",
+      "peer": true
+    },
     "node_modules/algoliasearch": {
       "version": "4.10.5",
       "resolved": "https://registry.npmjs.org/algoliasearch/-/algoliasearch-4.10.5.tgz",
@@ -198,6 +221,12 @@
         "@algolia/transporter": "4.10.5"
       }
     },
+    "node_modules/csstype": {
+      "version": "3.1.2",
+      "resolved": "https://registry.npmjs.org/csstype/-/csstype-3.1.2.tgz",
+      "integrity": "sha512-I7K1Uu0MBPzaFKg4nI5Q7Vs2t+3gWWW648spaF+Rg7pI9ds18Ugn+lvg4SHczUdKlHI5LWBXyqfS8+DufyBsgQ==",
+      "peer": true
+    },
     "node_modules/esbuild": {
       "version": "0.13.2",
       "resolved": "https://registry.npmjs.org/esbuild/-/esbuild-0.13.2.tgz",
@@ -629,6 +658,29 @@
         "algoliasearch": "^4.0.0"
       }
     },
+    "@types/prop-types": {
+      "version": "15.7.11",
+      "resolved": "https://registry.npmjs.org/@types/prop-types/-/prop-types-15.7.11.tgz",
+      "integrity": "sha512-ga8y9v9uyeiLdpKddhxYQkxNDrfvuPrlFb0N1qnZZByvcElJaXthF1UhvCh9TLWJBEHeNtdnbysW7Y6Uq8CVng==",
+      "peer": true
+    },
+    "@types/react": {
+      "version": "17.0.71",
+      "resolved": "https://registry.npmjs.org/@types/react/-/react-17.0.71.tgz",
+      "integrity": "sha512-lfqOu9mp16nmaGRrS8deS2Taqhd5Ih0o92Te5Ws6I1py4ytHBcXLqh0YIqVsViqwVI5f+haiFM6hju814BzcmA==",
+      "peer": true,
+      "requires": {
+        "@types/prop-types": "*",
+        "@types/scheduler": "*",
+        "csstype": "^3.0.2"
+      }
+    },
+    "@types/scheduler": {
+      "version": "0.16.8",
+      "resolved": "https://registry.npmjs.org/@types/scheduler/-/scheduler-0.16.8.tgz",
+      "integrity": "sha512-WZLiwShhwLRmeV6zH+GkbOFT6Z6VklCItrDioxUnv+u4Ll+8vKeFySoFyK/0ctcRpOmwAicELfmys1sDc/Rw+A==",
+      "peer": true
+    },
     "algoliasearch": {
       "version": "4.10.5",
       "resolved": "https://registry.npmjs.org/algoliasearch/-/algoliasearch-4.10.5.tgz",
@@ -650,6 +702,12 @@
         "@algolia/transporter": "4.10.5"
       }
     },
+    "csstype": {
+      "version": "3.1.2",
+      "resolved": "https://registry.npmjs.org/csstype/-/csstype-3.1.2.tgz",
+      "integrity": "sha512-I7K1Uu0MBPzaFKg4nI5Q7Vs2t+3gWWW648spaF+Rg7pI9ds18Ugn+lvg4SHczUdKlHI5LWBXyqfS8+DufyBsgQ==",
+      "peer": true
+    },
     "esbuild": {
       "version": "0.13.2",
       "resolved": "https://registry.npmjs.org/esbuild/-/esbuild-0.13.2.tgz",

From 13b55672120e07de109449069378590329ba6eda Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sat, 2 Mar 2024 22:43:06 +0100
Subject: [PATCH 07/22] fixed markdown

---
 Guide/deployment.markdown | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Guide/deployment.markdown b/Guide/deployment.markdown
index aa4e54b94..6bc69feb2 100644
--- a/Guide/deployment.markdown
+++ b/Guide/deployment.markdown
@@ -70,7 +70,7 @@ Infrastructure-side preparation:
 
  If your application requires so, make the S3 bucket publicly available.
   - Go to https://s3.console.aws.amazon.com/s3/buckets/YOUR-BUCKET?region=eu-west-1&bucketType=general&tab=permissions (permissions tab of the S3 bucket)
-  - Set `Block all public access˙ to entirely off.
+  - Set `Block all public access` to entirely off.
   - Set a bucket policy like this:
 ```json
 {

From c526aebc02c29530d7d286de178cd1dc1ba8c3cb Mon Sep 17 00:00:00 2001
From: Aron Novak <AronNovak@users.noreply.github.com>
Date: Thu, 7 Mar 2024 19:30:17 +0100
Subject: [PATCH 08/22] make it easier to spot schema + fixture errors (#1928)

---
 lib/IHP/Makefile.dist | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/lib/IHP/Makefile.dist b/lib/IHP/Makefile.dist
index 6a3ca2890..ec3bd6f14 100644
--- a/lib/IHP/Makefile.dist
+++ b/lib/IHP/Makefile.dist
@@ -114,10 +114,10 @@ psql: ## Connects to the running postgresql server
 	@psql -h $$PWD/build/db -d app
 
 db: Application/Schema.sql Application/Fixtures.sql ## Creates a new database with the current Schema and imports Fixtures.sql
-	echo "drop schema public cascade; create schema public;" | psql -h $$PWD/build/db -d app
-	psql -h $$PWD/build/db -d app < "${IHP_LIB}/IHPSchema.sql"
-	psql -h $$PWD/build/db -d app < Application/Schema.sql
-	psql -h $$PWD/build/db -d app < Application/Fixtures.sql
+	(echo "drop schema public cascade; create schema public;" | psql -h $${PWD}/build/db -d app) && \
+	psql -v ON_ERROR_STOP=1 -h $${PWD}/build/db -d app < "$${IHP_LIB}/IHPSchema.sql" && \
+	psql -v ON_ERROR_STOP=1 -h $${PWD}/build/db -d app < Application/Schema.sql && \
+	psql -v ON_ERROR_STOP=1 -h $${PWD}/build/db -d app < Application/Fixtures.sql
 
 dumpdb: dump_db ## Saves the current database state into the Fixtures.sql
 dump_db: ## Saves the current database state into the Fixtures.sql

From 779144da3cb3503044a0d2cb4d11437abfe2721c Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Tue, 12 Mar 2024 10:58:18 +0100
Subject: [PATCH 09/22] Only track exception (e.g. with sentry) in production

This was the expected behaviour, but turns out I missed one place
---
 IHP/ErrorController.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/IHP/ErrorController.hs b/IHP/ErrorController.hs
index a468d0bcc..3ff0f5a80 100644
--- a/IHP/ErrorController.hs
+++ b/IHP/ErrorController.hs
@@ -78,11 +78,12 @@ displayException exception action additionalInfo = do
     -- to the error tracking service (e.g. sentry). Usually this service also writes
     -- the error message to the stderr output
     --
-    let exceptionTracker = ?applicationContext.frameworkConfig.exceptionTracker.onException
-    let request = ?requestContext.request
+    when (?context.frameworkConfig.environment == Environment.Production) do
+        let exceptionTracker = ?applicationContext.frameworkConfig.exceptionTracker.onException
+        let request = ?requestContext.request
 
 
-    exceptionTracker (Just request) exception
+        exceptionTracker (Just request) exception
 
     supportingHandlers
         |> head

From da05bbe62df348c86cc0e1d1ab8b31b977c88b78 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Wed, 13 Mar 2024 10:50:25 +0100
Subject: [PATCH 10/22] ihp-openai: Don't use deprecated prompt anymore, as we
 mostly use the chat API

---
 ihp-openai/IHP/OpenAI.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/ihp-openai/IHP/OpenAI.hs b/ihp-openai/IHP/OpenAI.hs
index f5ba2daf1..5652a44db 100644
--- a/ihp-openai/IHP/OpenAI.hs
+++ b/ihp-openai/IHP/OpenAI.hs
@@ -19,7 +19,7 @@ import Control.Applicative ((<|>))
 
 data CompletionRequest = CompletionRequest
     { messages :: ![Message]
-    , prompt :: !Text
+    , prompt :: !Text -- ^ Deprecated, use 'messages' instead
     , maxTokens :: !Int
     , temperature :: !Double
     , presencePenalty :: !Double
@@ -39,7 +39,7 @@ instance ToJSON CompletionRequest where
     toJSON CompletionRequest { model, prompt, messages, maxTokens, temperature, presencePenalty, frequencePenalty, stream } =
         object
             [ "model" .= model
-            , "messages" .= (messages <> [userMessage prompt])
+            , "messages" .= (messages <> (if not (Text.null prompt) then [userMessage prompt] else []))
             , "max_tokens" .= maxTokens
             , "stream" .= stream
             , "temperature" .= temperature

From 042b09113c1163ca7a98e96105111d890ffbb4be Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Wed, 13 Mar 2024 10:51:57 +0100
Subject: [PATCH 11/22] ihp-openai: Added missing assistantMessage

---
 ihp-openai/IHP/OpenAI.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/ihp-openai/IHP/OpenAI.hs b/ihp-openai/IHP/OpenAI.hs
index 5652a44db..69f23f94d 100644
--- a/ihp-openai/IHP/OpenAI.hs
+++ b/ihp-openai/IHP/OpenAI.hs
@@ -62,6 +62,9 @@ userMessage content = Message { role = UserRole, content }
 systemMessage :: Text -> Message
 systemMessage content = Message { role = SystemRole, content }
 
+assistantMessage :: Text -> Message
+assistantMessage content = Message { role = AssistantRole, content }
+
 newCompletionRequest :: CompletionRequest
 newCompletionRequest = CompletionRequest
     { prompt = ""

From e73425adfe3dc05c8ffc3dce2a1418286971b929 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 10:00:10 +0100
Subject: [PATCH 12/22] Fixed actions in the IDE not working because request
 body is consumed twice

---
 IHP/IDE/ToolServer.hs | 2 --
 1 file changed, 2 deletions(-)

diff --git a/IHP/IDE/ToolServer.hs b/IHP/IDE/ToolServer.hs
index dae1e7dfa..efddb8d21 100644
--- a/IHP/IDE/ToolServer.hs
+++ b/IHP/IDE/ToolServer.hs
@@ -84,8 +84,6 @@ startToolServer' port isDebugMode = do
     let toolServerApplication = ToolServerApplication { devServerContext = ?context }
     let application :: Wai.Application = \request respond -> do
             let ?applicationContext = applicationContext
-            requestContext <- ControllerSupport.createRequestContext applicationContext request respond
-            let ?context = requestContext
             frontControllerToWAIApp @ToolServerApplication @AutoRefresh.AutoRefreshWSApp (\app -> app) toolServerApplication staticApp request respond
 
     let openAppUrl = openUrl ("http://localhost:" <> tshow port <> "/")

From ffbb5c6a4fc6fc7b9517b22477efa7f3b4c0257d Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 10:43:27 +0100
Subject: [PATCH 13/22] Simplify session vault key handling

Moved the session vault key from the ApplicationContext and RequestContext data structure to a global variable. This is the suggested way by the WAI developers.

See https://www.yesodweb.com/blog/2015/10/using-wais-vault
---
 IHP/ApplicationContext.hs           |  2 --
 IHP/Controller/RequestContext.hs    |  1 -
 IHP/Controller/Session.hs           | 11 +++++++++--
 IHP/ControllerSupport.hs            |  4 ++--
 IHP/RouterSupport.hs                |  2 +-
 IHP/Server.hs                       | 13 ++++++-------
 IHP/Test/Mocking.hs                 | 17 +++++++----------
 Test/Controller/AccessDeniedSpec.hs |  2 +-
 Test/Controller/CookieSpec.hs       |  2 +-
 Test/Controller/NotFoundSpec.hs     |  2 +-
 Test/Controller/ParamSpec.hs        |  4 ++--
 Test/View/CSSFrameworkSpec.hs       |  2 +-
 Test/View/FormSpec.hs               |  2 +-
 Test/ViewSupportSpec.hs             |  2 +-
 14 files changed, 33 insertions(+), 33 deletions(-)

diff --git a/IHP/ApplicationContext.hs b/IHP/ApplicationContext.hs
index a21fcd8dc..9174e71e3 100644
--- a/IHP/ApplicationContext.hs
+++ b/IHP/ApplicationContext.hs
@@ -2,14 +2,12 @@ module IHP.ApplicationContext where
 
 import IHP.Prelude
 import Network.Wai.Session (Session)
-import qualified Data.Vault.Lazy as Vault
 import IHP.AutoRefresh.Types (AutoRefreshServer)
 import IHP.FrameworkConfig (FrameworkConfig)
 import IHP.PGListener (PGListener)
 
 data ApplicationContext = ApplicationContext
     { modelContext :: !ModelContext
-    , session :: !(Vault.Key (Session IO ByteString ByteString))
     , autoRefreshServer :: !(IORef AutoRefreshServer)
     , frameworkConfig :: !FrameworkConfig
     , pgListener :: PGListener
diff --git a/IHP/Controller/RequestContext.hs b/IHP/Controller/RequestContext.hs
index bf6a46ddf..fffc93b66 100644
--- a/IHP/Controller/RequestContext.hs
+++ b/IHP/Controller/RequestContext.hs
@@ -24,6 +24,5 @@ data RequestContext = RequestContext
     { request :: Request
     , respond :: Respond
     , requestBody :: RequestBody
-    , vault :: (Vault.Key (Session IO ByteString ByteString))
     , frameworkConfig :: FrameworkConfig
     }
diff --git a/IHP/Controller/Session.hs b/IHP/Controller/Session.hs
index d0e633c1c..3d5c207e6 100644
--- a/IHP/Controller/Session.hs
+++ b/IHP/Controller/Session.hs
@@ -24,6 +24,7 @@ module IHP.Controller.Session
   , getSessionEither
   , deleteSession
   , getSessionAndClear
+  , sessionVaultKey
   ) where
 
 import IHP.Prelude
@@ -36,6 +37,8 @@ import qualified Network.Wai as Wai
 import qualified Data.Serialize as Serialize
 import Data.Serialize (Serialize)
 import Data.Serialize.Text ()
+import qualified Network.Wai.Session
+import System.IO.Unsafe (unsafePerformIO)
 
 -- | Types of possible errors as a result of
 -- requesting a value from the session storage
@@ -161,5 +164,9 @@ sessionVault = case vaultLookup of
         Just session -> session
         Nothing -> error "sessionInsert: The session vault is missing in the request"
     where
-        RequestContext { request, vault } = ?context.requestContext
-        vaultLookup = Vault.lookup vault (Wai.vault request)
+        RequestContext { request } = ?context.requestContext
+        vaultLookup = Vault.lookup sessionVaultKey request.vault
+
+sessionVaultKey :: Vault.Key (Network.Wai.Session.Session IO ByteString ByteString)
+sessionVaultKey = unsafePerformIO Vault.newKey
+{-# NOINLINE sessionVaultKey #-}
\ No newline at end of file
diff --git a/IHP/ControllerSupport.hs b/IHP/ControllerSupport.hs
index b32988fde..197958203 100644
--- a/IHP/ControllerSupport.hs
+++ b/IHP/ControllerSupport.hs
@@ -259,7 +259,7 @@ requestBodyJSON =
 
 {-# INLINE createRequestContext #-}
 createRequestContext :: ApplicationContext -> Request -> Respond -> IO RequestContext
-createRequestContext ApplicationContext { session, frameworkConfig } request respond = do
+createRequestContext ApplicationContext { frameworkConfig } request respond = do
     let contentType = lookup hContentType (requestHeaders request)
     requestBody <- case contentType of
         "application/json" -> do
@@ -270,7 +270,7 @@ createRequestContext ApplicationContext { session, frameworkConfig } request res
             (params, files) <- WaiParse.parseRequestBodyEx frameworkConfig.parseRequestBodyOptions WaiParse.lbsBackEnd request
             pure RequestContext.FormBody { .. }
 
-    pure RequestContext.RequestContext { request, respond, requestBody, vault = session, frameworkConfig }
+    pure RequestContext.RequestContext { request, respond, requestBody, frameworkConfig }
 
 
 -- | Returns a custom config parameter
diff --git a/IHP/RouterSupport.hs b/IHP/RouterSupport.hs
index addf6f42d..96da10814 100644
--- a/IHP/RouterSupport.hs
+++ b/IHP/RouterSupport.hs
@@ -838,7 +838,7 @@ withPrefix prefix routes = string prefix >> choice (map (\r -> r <* endOfInput)
 
 frontControllerToWAIApp :: forall app (autoRefreshApp :: Type). (?applicationContext :: ApplicationContext, FrontController app, WSApp autoRefreshApp, Typeable autoRefreshApp, InitControllerContext ()) => Middleware -> app -> Application -> Application
 frontControllerToWAIApp middleware application notFoundAction request respond = do
-    let requestContext = RequestContext { request, respond, requestBody = FormBody { params = [], files = [] }, vault = ?applicationContext.session, frameworkConfig = ?applicationContext.frameworkConfig }
+    let requestContext = RequestContext { request, respond, requestBody = FormBody { params = [], files = [] }, frameworkConfig = ?applicationContext.frameworkConfig }
 
     let ?context = requestContext
 
diff --git a/IHP/Server.hs b/IHP/Server.hs
index ce4e8e316..0157da068 100644
--- a/IHP/Server.hs
+++ b/IHP/Server.hs
@@ -8,6 +8,7 @@ import Network.Wai.Middleware.MethodOverridePost (methodOverridePost)
 import Network.Wai.Session (withSession, Session)
 import Network.Wai.Session.ClientSession (clientsessionStore)
 import qualified Web.ClientSession as ClientSession
+import IHP.Controller.Session (sessionVaultKey)
 import qualified Data.Vault.Lazy as Vault
 import IHP.ApplicationContext
 import qualified IHP.ControllerSupport as ControllerSupport
@@ -48,14 +49,12 @@ run configBuilder = do
 
         withInitalizers frameworkConfig modelContext do
             withPGListener \pgListener -> do
-                sessionVault <- Vault.newKey
-
                 autoRefreshServer <- newIORef (AutoRefresh.newAutoRefreshServer pgListener)
 
                 let ?modelContext = modelContext
-                let ?applicationContext = ApplicationContext { modelContext = ?modelContext, session = sessionVault, autoRefreshServer, frameworkConfig, pgListener }
+                let ?applicationContext = ApplicationContext { modelContext = ?modelContext, autoRefreshServer, frameworkConfig, pgListener }
 
-                sessionMiddleware <- initSessionMiddleware sessionVault frameworkConfig
+                sessionMiddleware <- initSessionMiddleware frameworkConfig
                 staticApp <- initStaticApp frameworkConfig
                 let corsMiddleware = initCorsMiddleware frameworkConfig
                 let requestLoggerMiddleware = frameworkConfig.requestLoggerMiddleware
@@ -108,8 +107,8 @@ initStaticApp frameworkConfig = do
 
     pure (Static.staticApp appSettings)
 
-initSessionMiddleware :: Vault.Key (Session IO ByteString ByteString) -> FrameworkConfig -> IO Middleware
-initSessionMiddleware sessionVault FrameworkConfig { sessionCookie } = do
+initSessionMiddleware :: FrameworkConfig -> IO Middleware
+initSessionMiddleware FrameworkConfig { sessionCookie } = do
     let path = "Config/client_session_key.aes"
 
     hasSessionSecretEnvVar <- EnvVar.hasEnvVar "IHP_SESSION_SECRET"
@@ -118,7 +117,7 @@ initSessionMiddleware sessionVault FrameworkConfig { sessionCookie } = do
             if hasSessionSecretEnvVar || not doesConfigDirectoryExist
                 then ClientSession.getKeyEnv "IHP_SESSION_SECRET"
                 else ClientSession.getKey path
-    let sessionMiddleware :: Middleware = withSession store "SESSION" sessionCookie sessionVault
+    let sessionMiddleware :: Middleware = withSession store "SESSION" sessionCookie sessionVaultKey
     pure sessionMiddleware
 
 initCorsMiddleware :: FrameworkConfig -> Middleware
diff --git a/IHP/Test/Mocking.hs b/IHP/Test/Mocking.hs
index 0598b2abd..8582cf66a 100644
--- a/IHP/Test/Mocking.hs
+++ b/IHP/Test/Mocking.hs
@@ -33,6 +33,7 @@ import qualified Network.Wai.Session
 import qualified Data.Serialize as Serialize
 import qualified Control.Exception as Exception
 import qualified IHP.PGListener as PGListener
+import IHP.Controller.Session (sessionVaultKey)
 
 type ContextParameters application = (?applicationContext :: ApplicationContext, ?context :: RequestContext, ?modelContext :: ModelContext, ?application :: application, InitControllerContext application, ?mocking :: MockContext application)
 
@@ -58,17 +59,15 @@ withIHPApp application configBuilder hspecAction = do
         withTestDatabase \testDatabase -> do
             modelContext <- createModelContext dbPoolIdleTime dbPoolMaxConnections (testDatabase.url) logger
 
-            session <- Vault.newKey
             pgListener <- PGListener.init modelContext
             autoRefreshServer <- newIORef (AutoRefresh.newAutoRefreshServer pgListener)
-            let sessionVault = Vault.insert session mempty Vault.empty
-            let applicationContext = ApplicationContext { modelContext = modelContext, session, autoRefreshServer, frameworkConfig, pgListener }
+            let sessionVault = Vault.insert sessionVaultKey mempty Vault.empty
+            let applicationContext = ApplicationContext { modelContext = modelContext, autoRefreshServer, frameworkConfig, pgListener }
 
             let requestContext = RequestContext
                  { request = defaultRequest {vault = sessionVault}
                  , requestBody = FormBody [] []
                  , respond = const (pure ResponseReceived)
-                 , vault = session
                  , frameworkConfig = frameworkConfig }
 
             (hspecAction MockContext { .. })
@@ -81,17 +80,15 @@ mockContextNoDatabase application configBuilder = do
    logger <- newLogger def { level = Warn } -- don't log queries
    modelContext <- createModelContext dbPoolIdleTime dbPoolMaxConnections databaseUrl logger
 
-   session <- Vault.newKey
-   let sessionVault = Vault.insert session mempty Vault.empty
+   let sessionVault = Vault.insert sessionVaultKey mempty Vault.empty
    pgListener <- PGListener.init modelContext
    autoRefreshServer <- newIORef (AutoRefresh.newAutoRefreshServer pgListener)
-   let applicationContext = ApplicationContext { modelContext = modelContext, session, autoRefreshServer, frameworkConfig, pgListener }
+   let applicationContext = ApplicationContext { modelContext = modelContext, autoRefreshServer, frameworkConfig, pgListener }
 
    let requestContext = RequestContext
          { request = defaultRequest {vault = sessionVault}
          , requestBody = FormBody [] []
          , respond = \resp -> pure ResponseReceived
-         , vault = session
          , frameworkConfig = frameworkConfig }
 
    pure MockContext{..}
@@ -230,8 +227,8 @@ withUser user callback =
 
         insertSession key value = pure ()
 
-        newVault = Vault.insert vaultKey newSession (Wai.vault request)
-        RequestContext { request, vault = vaultKey } = ?mocking.requestContext
+        newVault = Vault.insert sessionVaultKey newSession (Wai.vault request)
+        RequestContext { request } = ?mocking.requestContext
 
         sessionValue = Serialize.encode (user.id)
         sessionKey = cs (Session.sessionKey @user)
diff --git a/Test/Controller/AccessDeniedSpec.hs b/Test/Controller/AccessDeniedSpec.hs
index 34ca74011..dba55e502 100644
--- a/Test/Controller/AccessDeniedSpec.hs
+++ b/Test/Controller/AccessDeniedSpec.hs
@@ -74,7 +74,7 @@ config = do
 makeApplication :: (?applicationContext :: ApplicationContext) => IO Application
 makeApplication = do
     store <- Session.mapStore_
-    let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie ?applicationContext.session
+    let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie sessionVaultKey
     pure (sessionMiddleware $ (Server.application handleNotFound) (\app -> app))
 
 assertAccessDenied :: SResponse -> IO ()
diff --git a/Test/Controller/CookieSpec.hs b/Test/Controller/CookieSpec.hs
index ca950a556..8750b175e 100644
--- a/Test/Controller/CookieSpec.hs
+++ b/Test/Controller/CookieSpec.hs
@@ -37,6 +37,6 @@ createControllerContext = do
     let
         requestBody = FormBody { params = [], files = [] }
         request = Wai.defaultRequest
-        requestContext = RequestContext { request, respond = error "respond", requestBody, vault = error "vault", frameworkConfig = error "frameworkConfig" }
+        requestContext = RequestContext { request, respond = error "respond", requestBody, frameworkConfig = error "frameworkConfig" }
     let ?requestContext = requestContext
     newControllerContext
diff --git a/Test/Controller/NotFoundSpec.hs b/Test/Controller/NotFoundSpec.hs
index 3448c5cec..b79ca3cd3 100644
--- a/Test/Controller/NotFoundSpec.hs
+++ b/Test/Controller/NotFoundSpec.hs
@@ -74,7 +74,7 @@ config = do
 makeApplication :: (?applicationContext :: ApplicationContext) => IO Application
 makeApplication = do
     store <- Session.mapStore_
-    let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie ?applicationContext.session
+    let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie sessionVaultKey
     pure (sessionMiddleware $ (Server.application handleNotFound) (\app -> app))
 
 assertNotFound :: SResponse -> IO ()
diff --git a/Test/Controller/ParamSpec.hs b/Test/Controller/ParamSpec.hs
index 630ad13c0..d45ed7c00 100644
--- a/Test/Controller/ParamSpec.hs
+++ b/Test/Controller/ParamSpec.hs
@@ -434,14 +434,14 @@ createControllerContextWithParams params =
         let
             requestBody = FormBody { params, files = [] }
             request = Wai.defaultRequest
-            requestContext = RequestContext { request, respond = error "respond", requestBody, vault = error "vault", frameworkConfig = error "frameworkConfig" }
+            requestContext = RequestContext { request, respond = error "respond", requestBody, frameworkConfig = error "frameworkConfig" }
         in FrozenControllerContext { requestContext, customFields = TypeMap.empty }
 
 createControllerContextWithJson params =
         let
             requestBody = JSONBody { jsonPayload = Just (json params), rawPayload = cs params }
             request = Wai.defaultRequest
-            requestContext = RequestContext { request, respond = error "respond", requestBody, vault = error "vault", frameworkConfig = error "frameworkConfig" }
+            requestContext = RequestContext { request, respond = error "respond", requestBody, frameworkConfig = error "frameworkConfig" }
         in FrozenControllerContext { requestContext, customFields = TypeMap.empty }
 
 json :: Text -> Aeson.Value
diff --git a/Test/View/CSSFrameworkSpec.hs b/Test/View/CSSFrameworkSpec.hs
index 11f1a2c24..945defe00 100644
--- a/Test/View/CSSFrameworkSpec.hs
+++ b/Test/View/CSSFrameworkSpec.hs
@@ -721,5 +721,5 @@ createControllerContextWithCSSFramework cssFramework = do
                 option cssFramework
     let requestBody = FormBody { params = [], files = [] }
     let request = Wai.defaultRequest
-    let requestContext = RequestContext { request, respond = error "respond", requestBody, vault = error "vault", frameworkConfig = frameworkConfig }
+    let requestContext = RequestContext { request, respond = error "respond", requestBody, frameworkConfig = frameworkConfig }
     pure FrozenControllerContext { requestContext, customFields = TypeMap.empty }
\ No newline at end of file
diff --git a/Test/View/FormSpec.hs b/Test/View/FormSpec.hs
index 7cc5d27bb..75532c411 100644
--- a/Test/View/FormSpec.hs
+++ b/Test/View/FormSpec.hs
@@ -49,7 +49,7 @@ createControllerContext = do
     frameworkConfig <- FrameworkConfig.buildFrameworkConfig (pure ())
     let requestBody = FormBody { params = [], files = [] }
     let request = Wai.defaultRequest
-    let requestContext = RequestContext { request, respond = undefined, requestBody, vault = undefined, frameworkConfig = frameworkConfig }
+    let requestContext = RequestContext { request, respond = undefined, requestBody, frameworkConfig = frameworkConfig }
     pure FrozenControllerContext { requestContext, customFields = mempty }
 
 data Project'  = Project {id :: (Id' "projects"), title :: Text, meta :: MetaBag} deriving (Eq, Show)
diff --git a/Test/ViewSupportSpec.hs b/Test/ViewSupportSpec.hs
index f5fe528d7..191bda6e8 100644
--- a/Test/ViewSupportSpec.hs
+++ b/Test/ViewSupportSpec.hs
@@ -101,7 +101,7 @@ config = do
 makeApplication :: (?applicationContext :: ApplicationContext) => IO Application
 makeApplication = do
     store <- Session.mapStore_
-    let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie ?applicationContext.session
+    let sessionMiddleware :: Middleware = Session.withSession store "SESSION" ?applicationContext.frameworkConfig.sessionCookie sessionVaultKey
     pure (sessionMiddleware $ (Server.application handleNotFound (\app -> app)))
 
 tests :: Spec

From e87c0a3225350fabaa8aafe78d5447a22ec4d761 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 10:52:16 +0100
Subject: [PATCH 14/22] removed unused importsd

---
 IHP/ApplicationContext.hs        | 1 -
 IHP/Controller/RequestContext.hs | 2 --
 IHP/Controller/Response.hs       | 5 ++---
 IHP/ControllerSupport.hs         | 3 +--
 IHP/EnvVar.hs                    | 1 -
 IHP/IDE/FileWatcher.hs           | 1 -
 IHP/IDE/ToolServer.hs            | 8 +++-----
 IHP/Server.hs                    | 7 ++-----
 8 files changed, 8 insertions(+), 20 deletions(-)

diff --git a/IHP/ApplicationContext.hs b/IHP/ApplicationContext.hs
index 9174e71e3..97c16dc04 100644
--- a/IHP/ApplicationContext.hs
+++ b/IHP/ApplicationContext.hs
@@ -1,7 +1,6 @@
 module IHP.ApplicationContext where
 
 import IHP.Prelude
-import Network.Wai.Session (Session)
 import IHP.AutoRefresh.Types (AutoRefreshServer)
 import IHP.FrameworkConfig (FrameworkConfig)
 import IHP.PGListener (PGListener)
diff --git a/IHP/Controller/RequestContext.hs b/IHP/Controller/RequestContext.hs
index fffc93b66..5bac8c508 100644
--- a/IHP/Controller/RequestContext.hs
+++ b/IHP/Controller/RequestContext.hs
@@ -8,8 +8,6 @@ import           ClassyPrelude
 import qualified Data.ByteString.Lazy as LBS
 import           Network.Wai                   (Request, Response, ResponseReceived)
 import           Network.Wai.Parse (File, Param)
-import qualified Data.Vault.Lazy               as Vault
-import           Network.Wai.Session           (Session)
 import           IHP.FrameworkConfig
 import qualified Data.Aeson as Aeson
 
diff --git a/IHP/Controller/Response.hs b/IHP/Controller/Response.hs
index 5a79af936..4dddf3f70 100644
--- a/IHP/Controller/Response.hs
+++ b/IHP/Controller/Response.hs
@@ -9,12 +9,11 @@ where
 import ClassyPrelude
 import Network.HTTP.Types.Header
 import qualified IHP.Controller.Context as Context
-import IHP.Controller.Context (ControllerContext(ControllerContext))
 import qualified Network.Wai
 import Network.Wai (Response)
 import qualified Control.Exception as Exception
 
-respondAndExit :: (?context::ControllerContext) => Response -> IO ()
+respondAndExit :: (?context :: Context.ControllerContext) => Response -> IO ()
 respondAndExit response = do
     responseWithHeaders <- addResponseHeadersFromContext response
     Exception.throwIO (ResponseException responseWithHeaders)
@@ -35,7 +34,7 @@ addResponseHeaders headers = Network.Wai.mapResponseHeaders (\hs -> headers <> h
 -- > addResponseHeadersFromContext response
 -- You probabaly want `setHeader`
 --
-addResponseHeadersFromContext :: (?context :: ControllerContext) => Response -> IO Response
+addResponseHeadersFromContext :: (?context :: Context.ControllerContext) => Response -> IO Response
 addResponseHeadersFromContext response = do
     maybeHeaders <- Context.maybeFromContext @[Header]
     let headers = fromMaybe [] maybeHeaders
diff --git a/IHP/ControllerSupport.hs b/IHP/ControllerSupport.hs
index 197958203..900d66695 100644
--- a/IHP/ControllerSupport.hs
+++ b/IHP/ControllerSupport.hs
@@ -29,7 +29,7 @@ module IHP.ControllerSupport
 
 import ClassyPrelude
 import IHP.HaskellSupport
-import Network.Wai (Response, Request, ResponseReceived, responseLBS, requestHeaders)
+import Network.Wai (Request, ResponseReceived, responseLBS, requestHeaders)
 import qualified Network.HTTP.Types as HTTP
 import qualified Network.Wai
 import IHP.ModelSupport
@@ -39,7 +39,6 @@ import qualified Data.ByteString.Lazy
 import qualified IHP.Controller.RequestContext as RequestContext
 import IHP.Controller.RequestContext (RequestContext, Respond)
 import qualified Data.CaseInsensitive
-import qualified Control.Exception as Exception
 import qualified IHP.ErrorController as ErrorController
 import qualified Data.Typeable as Typeable
 import IHP.FrameworkConfig (FrameworkConfig (..), ConfigProvider(..))
diff --git a/IHP/EnvVar.hs b/IHP/EnvVar.hs
index a2e164bb8..0ae52926f 100644
--- a/IHP/EnvVar.hs
+++ b/IHP/EnvVar.hs
@@ -11,7 +11,6 @@ import IHP.Prelude
 import Data.String.Interpolate.IsString (i)
 import qualified System.Posix.Env.ByteString as Posix
 import Network.Socket (PortNumber)
-import Data.Word (Word16)
 import IHP.Mail.Types
 import IHP.Environment
 
diff --git a/IHP/IDE/FileWatcher.hs b/IHP/IDE/FileWatcher.hs
index 7713e50d1..d380eb9d2 100644
--- a/IHP/IDE/FileWatcher.hs
+++ b/IHP/IDE/FileWatcher.hs
@@ -9,7 +9,6 @@ import System.Directory (listDirectory, doesDirectoryExist)
 import qualified Data.Map as Map
 import qualified System.FSNotify as FS
 import IHP.IDE.Types
-import qualified Data.Time.Clock as Clock
 import qualified Data.List as List
 import IHP.IDE.LiveReloadNotificationServer (notifyAssetChange)
 import qualified Control.Debounce as Debounce
diff --git a/IHP/IDE/ToolServer.hs b/IHP/IDE/ToolServer.hs
index efddb8d21..2f7d09747 100644
--- a/IHP/IDE/ToolServer.hs
+++ b/IHP/IDE/ToolServer.hs
@@ -6,13 +6,11 @@ import qualified Network.Wai.Handler.Warp as Warp
 import IHP.IDE.Types
 import IHP.IDE.PortConfig
 import qualified IHP.ControllerSupport as ControllerSupport
-import qualified IHP.ErrorController as ErrorController
 import IHP.ApplicationContext
 import IHP.ModelSupport
 import IHP.RouterSupport hiding (get)
 import Network.Wai.Session.ClientSession (clientsessionStore)
 import qualified Web.ClientSession as ClientSession
-import qualified Data.Vault.Lazy as Vault
 import Network.Wai.Middleware.MethodOverridePost (methodOverridePost)
 import Network.Wai.Session (withSession)
 import qualified Network.WebSockets as Websocket
@@ -49,6 +47,7 @@ import qualified IHP.PGListener as PGListener
 import qualified Network.Wai.Application.Static as Static
 import qualified WaiAppStatic.Types as Static
 import IHP.Controller.NotFound (handleNotFound)
+import IHP.Controller.Session (sessionVaultKey)
 
 withToolServer :: (?context :: Context) => IO () -> IO ()
 withToolServer inner = withAsyncBound async (\_ -> inner)
@@ -72,15 +71,14 @@ startToolServer' port isDebugMode = do
             Just baseUrl -> Config.option $ Config.BaseUrl baseUrl
             Nothing -> pure ()
 
-    session <- Vault.newKey
     store <- fmap clientsessionStore (ClientSession.getKey "Config/client_session_key.aes")
-    let sessionMiddleware :: Wai.Middleware = withSession store "SESSION" (frameworkConfig.sessionCookie) session
+    let sessionMiddleware :: Wai.Middleware = withSession store "SESSION" (frameworkConfig.sessionCookie) sessionVaultKey
     let modelContext = notConnectedModelContext undefined
     pgListener <- PGListener.init modelContext
     autoRefreshServer <- newIORef (AutoRefresh.newAutoRefreshServer pgListener)
     staticApp <- initStaticApp
 
-    let applicationContext = ApplicationContext { modelContext, session, autoRefreshServer, frameworkConfig, pgListener }
+    let applicationContext = ApplicationContext { modelContext, autoRefreshServer, frameworkConfig, pgListener }
     let toolServerApplication = ToolServerApplication { devServerContext = ?context }
     let application :: Wai.Application = \request respond -> do
             let ?applicationContext = applicationContext
diff --git a/IHP/Server.hs b/IHP/Server.hs
index 0157da068..3899c4a5a 100644
--- a/IHP/Server.hs
+++ b/IHP/Server.hs
@@ -5,19 +5,16 @@ import IHP.Prelude
 import qualified Network.Wai.Handler.Warp as Warp
 import Network.Wai
 import Network.Wai.Middleware.MethodOverridePost (methodOverridePost)
-import Network.Wai.Session (withSession, Session)
+import Network.Wai.Session (withSession)
 import Network.Wai.Session.ClientSession (clientsessionStore)
 import qualified Web.ClientSession as ClientSession
 import IHP.Controller.Session (sessionVaultKey)
-import qualified Data.Vault.Lazy as Vault
 import IHP.ApplicationContext
-import qualified IHP.ControllerSupport as ControllerSupport
 import qualified IHP.Environment as Env
 import qualified IHP.PGListener as PGListener
 
 import IHP.FrameworkConfig
-import IHP.RouterSupport (frontControllerToWAIApp, FrontController, webSocketApp, webSocketAppWithCustomPath)
-import IHP.ErrorController
+import IHP.RouterSupport (frontControllerToWAIApp, FrontController)
 import qualified IHP.AutoRefresh as AutoRefresh
 import qualified IHP.AutoRefresh.Types as AutoRefresh
 import IHP.LibDir

From 40d98d0ec198bdd812886725b932df825036ecbe Mon Sep 17 00:00:00 2001
From: Rodrigo Mesquita <rodrigo.m.mesquita@gmail.com>
Date: Fri, 15 Mar 2024 16:39:31 +0000
Subject: [PATCH 15/22] Fix conditional GHC 9.6 compilation

The CPP macro __GLASGOW_HASKELL__ was using an incorrect integer
numbering scheme for GHC versions, making the conditional compilation
incorrect (960 means GHC 9.60, whereas 906 means GHC 9.6).

See https://downloads.haskell.org/ghc/latest/docs/users_guide/intro.html#version-numbering
---
 ihp-hsx/IHP/HSX/HaskellParser.hs |  2 +-
 ihp-hsx/IHP/HSX/HsExpToTH.hs     | 14 +++++++-------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/ihp-hsx/IHP/HSX/HaskellParser.hs b/ihp-hsx/IHP/HSX/HaskellParser.hs
index 1895d8fa7..08f93e69b 100644
--- a/ihp-hsx/IHP/HSX/HaskellParser.hs
+++ b/ihp-hsx/IHP/HSX/HaskellParser.hs
@@ -30,7 +30,7 @@ parseHaskellExpression sourcePos extensions input =
                     error = renderWithContext defaultSDocContext
                         $ vcat
                         $ map (formatBulleted defaultSDocContext)
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
                         $ map (diagnosticMessage NoDiagnosticOpts)
 #else
                         $ map diagnosticMessage
diff --git a/ihp-hsx/IHP/HSX/HsExpToTH.hs b/ihp-hsx/IHP/HSX/HsExpToTH.hs
index d7a33e6d0..35ed01fff 100644
--- a/ihp-hsx/IHP/HSX/HsExpToTH.hs
+++ b/ihp-hsx/IHP/HSX/HsExpToTH.hs
@@ -28,7 +28,7 @@ import qualified GHC.Unit.Module as Module
 import GHC.Stack
 import qualified Data.List.NonEmpty as NonEmpty
 import Language.Haskell.Syntax.Type
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
 import Language.Haskell.Syntax.Basic
 #endif
 
@@ -92,7 +92,7 @@ toExp (Expr.HsVar _ n) =
         then TH.ConE (toName n')
         else TH.VarE (toName n')
 
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
 toExp (Expr.HsUnboundVar _ n)              = TH.UnboundVarE (TH.mkName . occNameString $ occName n)
 #else
 toExp (Expr.HsUnboundVar _ n)              = TH.UnboundVarE (TH.mkName . occNameString $ n)
@@ -110,7 +110,7 @@ toExp (Expr.HsOverLit _ OverLit {ol_val})
 toExp (Expr.HsApp _ e1 e2)
   = TH.AppE (toExp . unLoc $ e1) (toExp . unLoc $ e2)
 
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
 toExp (Expr.HsAppType _ e _ HsWC {hswc_body}) = TH.AppTypeE (toExp . unLoc $ e) (toType . unLoc $ hswc_body)
 #else
 toExp (Expr.HsAppType _ e HsWC {hswc_body}) = TH.AppTypeE (toExp . unLoc $ e) (toType . unLoc $ hswc_body)
@@ -124,7 +124,7 @@ toExp (Expr.NegApp _ e _)
   = TH.AppE (TH.VarE 'negate) (toExp . unLoc $ e)
 
 -- NOTE: for lambda, there is only one match
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
 toExp (Expr.HsLam _ (Expr.MG _ (unLoc -> (map unLoc -> [Expr.Match _ _ (map unLoc -> ps) (Expr.GRHSs _ [unLoc -> Expr.GRHS _ _ (unLoc -> e)] _)]))))
 #else
 toExp (Expr.HsLam _ (Expr.MG _ (unLoc -> (map unLoc -> [Expr.Match _ _ (map unLoc -> ps) (Expr.GRHSs _ [unLoc -> Expr.GRHS _ _ (unLoc -> e)] _)])) _))
@@ -199,7 +199,7 @@ toExp (Expr.HsProjection _ locatedFields) =
     extractFieldLabel (DotFieldOcc _ locatedStr) = locatedStr
     extractFieldLabel _ = error "Don't know how to handle XDotFieldOcc constructor..."
   in
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
     TH.ProjectionE (NonEmpty.map (unpackFS . (.field_label) . unLoc . extractFieldLabel . unLoc) locatedFields)
 #else
     TH.ProjectionE (NonEmpty.map (unpackFS . unLoc . extractFieldLabel . unLoc) locatedFields)
@@ -210,13 +210,13 @@ toExp (Expr.HsGetField _ expr locatedField) =
     extractFieldLabel (DotFieldOcc _ locatedStr) = locatedStr
     extractFieldLabel _ = error "Don't know how to handle XDotFieldOcc constructor..."
   in
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
     TH.GetFieldE (toExp (unLoc expr)) (unpackFS . (.field_label) . unLoc . extractFieldLabel . unLoc $ locatedField)
 #else
     TH.GetFieldE (toExp (unLoc expr)) (unpackFS . unLoc . extractFieldLabel . unLoc $ locatedField)
 #endif
 
-#if __GLASGOW_HASKELL__ >= 960
+#if __GLASGOW_HASKELL__ >= 906
 toExp (Expr.HsOverLabel _ _ fastString) = TH.LabelE (unpackFS fastString)
 #else
 toExp (Expr.HsOverLabel _ fastString) = TH.LabelE (unpackFS fastString)

From 2947dfe65dc668011c082efb0fe2512c7cf28f6d Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 20:27:02 +0100
Subject: [PATCH 16/22] Use ghc96 everywhere

---
 NixSupport/default.nix                   | 2 +-
 NixSupport/make-nixpkgs-from-options.nix | 2 +-
 devenv-module.nix                        | 2 +-
 flake-module.nix                         | 2 +-
 ihp-hsx/shell.nix                        | 2 +-
 ihp-openai/shell.nix                     | 2 +-
 6 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/NixSupport/default.nix b/NixSupport/default.nix
index 5a0fa1975..50a8bc71d 100644
--- a/NixSupport/default.nix
+++ b/NixSupport/default.nix
@@ -1,4 +1,4 @@
-{ compiler ? "ghc94"
+{ compiler ? "ghc96"
 , additionalNixpkgsOptions ? {}
 , pkgs ? import "${toString projectPath}/Config/nix/nixpkgs-config.nix" { ihp = ihp; additionalNixpkgsOptions = additionalNixpkgsOptions; }
 , ghc ? pkgs.haskell.packages.${compiler}
diff --git a/NixSupport/make-nixpkgs-from-options.nix b/NixSupport/make-nixpkgs-from-options.nix
index ff6551f27..5c3517906 100644
--- a/NixSupport/make-nixpkgs-from-options.nix
+++ b/NixSupport/make-nixpkgs-from-options.nix
@@ -8,7 +8,7 @@
 , dontHaddockPackages ? []
 , nixPkgsRev ? "277bf961c323b6cde46932cc9308135d0687af95"
 , nixPkgsSha256 ? "sha256-ciSZqliNLDattmjR/1yQ0mJHZSkXWZlnIR6TcdDGFMQ"
-, compiler ? "ghc94"
+, compiler ? "ghc96"
 , manualOverrides ? haskellPackagesNew: haskellPackagesOld: { } # More exotic overrides go here
 , additionalNixpkgsOptions ? {}
 }:
diff --git a/devenv-module.nix b/devenv-module.nix
index 0086532e2..020e75013 100644
--- a/devenv-module.nix
+++ b/devenv-module.nix
@@ -8,7 +8,7 @@ that is defined in flake-module.nix
     perSystem = { nix-filter, pkgs, lib, ... }: let
         ghcCompiler = import ./NixSupport/mkGhcCompiler.nix {
             inherit pkgs;
-            ghcCompiler = pkgs.haskell.packages.ghc94;
+            ghcCompiler = pkgs.haskell.packages.ghc96;
             ihp = ./.;
             filter = inputs.nix-filter.lib;
         };
diff --git a/flake-module.nix b/flake-module.nix
index 338894378..507f62bc8 100644
--- a/flake-module.nix
+++ b/flake-module.nix
@@ -26,7 +26,7 @@ ihpFlake:
                     description = ''
                         The GHC compiler to use for IHP.
                     '';
-                    default = pkgs.haskell.packages.ghc94;
+                    default = pkgs.haskell.packages.ghc96;
                 };
 
                 packages = lib.mkOption {
diff --git a/ihp-hsx/shell.nix b/ihp-hsx/shell.nix
index f74a66058..cb3f12e2a 100644
--- a/ihp-hsx/shell.nix
+++ b/ihp-hsx/shell.nix
@@ -3,7 +3,7 @@ let
         ihp = ./../.;
         haskellPackagesDir = ./../NixSupport/haskell-packages;
     };
-    ghc = pkgs.haskell.packages.ghc94;
+    ghc = pkgs.haskell.packages.ghc96;
     haskellDeps = ghc.ghcWithPackages (p: with p; [
         classy-prelude
         string-conversions
diff --git a/ihp-openai/shell.nix b/ihp-openai/shell.nix
index 926699d11..197cf9b06 100644
--- a/ihp-openai/shell.nix
+++ b/ihp-openai/shell.nix
@@ -3,7 +3,7 @@ let
         ihp = ./../.;
         haskellPackagesDir = ./../NixSupport/haskell-packages;
     };
-    ghc = pkgs.haskell.packages.ghc94;
+    ghc = pkgs.haskell.packages.ghc96;
     haskellDeps = ghc.ghcWithPackages (p: with p; [
         text
         bytestring

From 1cd5170b8ccec284cd96145c4cd9d98bde1f97e8 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 20:33:16 +0100
Subject: [PATCH 17/22] Updated nixpkgs

---
 flake.lock | 8 ++++----
 flake.nix  | 2 +-
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/flake.lock b/flake.lock
index 5a1756a44..2e7092209 100644
--- a/flake.lock
+++ b/flake.lock
@@ -488,17 +488,17 @@
     },
     "nixpkgs_2": {
       "locked": {
-        "lastModified": 1696291921,
-        "narHash": "sha256-isKgVAoUxuxYEuO3Q4xhbfKcZrF/+UkJtOTv0eb/W5E=",
+        "lastModified": 1710461556,
+        "narHash": "sha256-uxBpjpYSVLCkNxOLHDuli2twd6mmuvuTuU77aT/eiGY=",
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "ea0284a3da391822909be5e98a60c1e62572a7dc",
+        "rev": "cb97fed5722648882d1b4a03df0b67681909fb68",
         "type": "github"
       },
       "original": {
         "owner": "NixOS",
         "repo": "nixpkgs",
-        "rev": "ea0284a3da391822909be5e98a60c1e62572a7dc",
+        "rev": "cb97fed5722648882d1b4a03df0b67681909fb68",
         "type": "github"
       }
     },
diff --git a/flake.nix b/flake.nix
index bed7dd964..88e4c7138 100644
--- a/flake.nix
+++ b/flake.nix
@@ -3,7 +3,7 @@
 
     inputs = {
         # TODO use nixpkgs-unstable and just .lock a version?
-        nixpkgs.url = "github:NixOS/nixpkgs?rev=ea0284a3da391822909be5e98a60c1e62572a7dc";
+        nixpkgs.url = "github:NixOS/nixpkgs?rev=cb97fed5722648882d1b4a03df0b67681909fb68";
 
         # pre-defined set of default target systems
         systems.url = "github:nix-systems/default";

From d59d471eda04fd1e82d169799ce4c7343dafb517 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 20:47:30 +0100
Subject: [PATCH 18/22] Added forks for broken packages

---
 NixSupport/haskell-packages/minio-hs.nix  | 41 +++++++++++++++++++++++
 NixSupport/haskell-packages/smtp-mail.nix | 22 ++++++++++++
 2 files changed, 63 insertions(+)
 create mode 100644 NixSupport/haskell-packages/minio-hs.nix
 create mode 100644 NixSupport/haskell-packages/smtp-mail.nix

diff --git a/NixSupport/haskell-packages/minio-hs.nix b/NixSupport/haskell-packages/minio-hs.nix
new file mode 100644
index 000000000..d2322f623
--- /dev/null
+++ b/NixSupport/haskell-packages/minio-hs.nix
@@ -0,0 +1,41 @@
+{ mkDerivation, aeson, base, base64-bytestring, binary, bytestring
+, case-insensitive, conduit, conduit-extra, crypton-connection
+, cryptonite, cryptonite-conduit, digest, directory, filepath
+, http-client, http-client-tls, http-conduit, http-types, ini, lib
+, memory, network-uri, QuickCheck, raw-strings-qq, relude
+, resourcet, retry, tasty, tasty-hunit, tasty-quickcheck
+, tasty-smallcheck, text, time, time-units, transformers, unliftio
+, unliftio-core, unordered-containers, xml-conduit, fetchFromGitHub
+}:
+mkDerivation {
+  pname = "minio-hs";
+  version = "1.7.0";
+  src = fetchFromGitHub {
+    owner = "mpscholten";
+    repo = "minio-hs";
+    rev = "786cf1881f0b62b7539e63547e76afc3c1ade36a";
+    sha256 = "sha256-dK4nH6j16oFNB27tp1ExAWahhFUlKpzLpqTiHju8dl8=";
+  };
+  isLibrary = true;
+  isExecutable = true;
+  libraryHaskellDepends = [
+    aeson base base64-bytestring binary bytestring case-insensitive
+    conduit conduit-extra crypton-connection cryptonite
+    cryptonite-conduit digest directory filepath http-client
+    http-client-tls http-conduit http-types ini memory network-uri
+    relude resourcet retry text time time-units transformers unliftio
+    unliftio-core unordered-containers xml-conduit
+  ];
+  testHaskellDepends = [
+    aeson base base64-bytestring binary bytestring case-insensitive
+    conduit conduit-extra crypton-connection cryptonite
+    cryptonite-conduit digest directory filepath http-client
+    http-client-tls http-conduit http-types ini memory network-uri
+    QuickCheck raw-strings-qq relude resourcet retry tasty tasty-hunit
+    tasty-quickcheck tasty-smallcheck text time time-units transformers
+    unliftio unliftio-core unordered-containers xml-conduit
+  ];
+  homepage = "https://github.com/minio/minio-hs#readme";
+  description = "A MinIO Haskell Library for Amazon S3 compatible cloud storage";
+  license = lib.licenses.asl20;
+}
\ No newline at end of file
diff --git a/NixSupport/haskell-packages/smtp-mail.nix b/NixSupport/haskell-packages/smtp-mail.nix
new file mode 100644
index 000000000..56c141158
--- /dev/null
+++ b/NixSupport/haskell-packages/smtp-mail.nix
@@ -0,0 +1,22 @@
+{ mkDerivation, array, base, base16-bytestring, base64-bytestring
+, bytestring, crypton-connection, cryptonite, filepath, lib, memory
+, mime-mail, network, network-bsd, text, fetchFromGitHub
+}:
+mkDerivation {
+  pname = "smtp-mail";
+  version = "0.3.0.0";
+  src = fetchFromGitHub {
+    owner = "MasterWordServices";
+    repo = "smtp-mail";
+    rev = "4c724c80814ab1da7c37256a6c10e04c88b9af95";
+    sha256 = "sha256-gjg2k8UHBwumoH8OUsFZ+Xd5icotaVHRmlQt6Xc7Mf0=";
+  };
+  libraryHaskellDepends = [
+    array base base16-bytestring base64-bytestring bytestring
+    crypton-connection cryptonite filepath memory mime-mail network network-bsd
+    text
+  ];
+  homepage = "http://github.com/jhickner/smtp-mail";
+  description = "Simple email sending via SMTP";
+  license = lib.licenses.bsd3;
+}
\ No newline at end of file

From 5f289b778f873cb51d638cc6b11e47e12290fb02 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Fri, 15 Mar 2024 20:57:48 +0100
Subject: [PATCH 19/22] Allow overriding the logger in the controller context
 (#1923)

* Allow overriding the logger in the controller context

* added more comments
---
 IHP/Controller/Context.hs | 26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/IHP/Controller/Context.hs b/IHP/Controller/Context.hs
index 61a8cd3bc..0ddb744cd 100644
--- a/IHP/Controller/Context.hs
+++ b/IHP/Controller/Context.hs
@@ -10,6 +10,7 @@ import qualified Data.Typeable as Typeable
 import IHP.Controller.RequestContext
 import IHP.FrameworkConfig
 import IHP.Log.Types
+import System.IO.Unsafe (unsafePerformIO)
 
 -- | A container storing useful data along the request lifecycle, such as the request, the current user, set current view layout, flash messages, ...
 --
@@ -137,5 +138,28 @@ instance HasField "frameworkConfig" ControllerContext FrameworkConfig where
     getField controllerContext = controllerContext.requestContext.frameworkConfig
     {-# INLINABLE getField #-}
 
+-- The following hack is bad, but allows us to override the logger using 'putContext'
+-- The alternative would be https://github.com/digitallyinduced/ihp/pull/1921 which is also not very nice
+--
+-- This can be useful to customize the log formatter for all actions of an app:
+--
+-- > import IHP.Log.Types
+-- > import IHP.Controller.Context
+-- > 
+-- > instance InitControllerContext WebApplication where
+-- >     initContext = do
+-- >         let defaultLogger :: Logger = ?context.frameworkConfig.logger
+-- >         let withUserIdLogger :: Logger = { Log.formatter = userIdFormatter defaultLogger.formatter }
+-- >         putContext withUserIdLogger
+-- > 
+-- > userIdFormatter :: (?context :: Context) => Log.LogFormatter -> Log.LogFormatter
+-- > userIdFormatter existingFormatter time level string =
+-- >         existingFormatter time level (prependUserId string)
+-- > 
+-- > preprendUserId :: (?context :: Context) => Text -> Text
+-- > preprendUserId string = "userId: " <> show currentUserId <> " " <> string
+--
+-- This design mistake should be fixed in IHP v2
 instance HasField "logger" ControllerContext Logger where
-    getField controllerContext = controllerContext.frameworkConfig.logger
+    getField context@(FrozenControllerContext { customFields }) = fromMaybe context.frameworkConfig.logger (TypeMap.lookup @Logger customFields)
+    getField context = (unsafePerformIO (freeze context)).logger -- Hacky, but there's no better way. The only way to retrieve the logger here, is by reading from the IORef in an unsafe way

From fa08a0c2caddc0f82c6c4a0a1ecb00ce9373572c Mon Sep 17 00:00:00 2001
From: Amitai Burstein <amitai@gizra.com>
Date: Sat, 16 Mar 2024 17:23:29 +0200
Subject: [PATCH 20/22] Add docs about Unique Constraints

---
 Guide/database.markdown | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/Guide/database.markdown b/Guide/database.markdown
index 954c42328..4408b7e4b 100644
--- a/Guide/database.markdown
+++ b/Guide/database.markdown
@@ -765,14 +765,6 @@ Similarly as for renaming, deleting a column currently won't work automatically
 1. Delete your column in the Schema Designer
 2. Delete the column from the database by executing `ALTER TABLE tablename DROP COLUMN colname`
 
-### Alternate Method
-
-There's always more than one way. This is another.
-
-1. Make changes in the Schema Designer
-2. Click `Save DB to Fixtures` in the Schema Designer (Use the arrow next to the `Update DB` button to see this option)
-3. Edit `Fixtures.sql` to your heart's content.
-4. Click `Push to DB` in the Schema Designer (Use the arrow next to the `Update DB` button to see this option)
 
 ### Migrations In Production
 
@@ -848,3 +840,16 @@ action CreateUserAction = do
 
     redirectTo NewSessionAction
 ```
+
+## Unique Constraints
+
+It's possible to use the UI to set the unique constraint on a column. However, sometimes you might want to add a unique constraint on multiple columns. This can be done by adding a unique constraint to the `Schema.sql` file. For example, to add a unique constraint on the `email` and `username` columns of the `users` table, you would add the following to the `Schema.sql` file:
+
+```sql
+CREATE TABLE users (
+    id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+    email TEXT NOT NULL,
+    username TEXT NOT NULL,
+    UNIQUE (email, username)
+);
+```
\ No newline at end of file

From cc0ae34a6ddcbacac0dbe3e13a6c84358d387ab6 Mon Sep 17 00:00:00 2001
From: Marc Scholten <marc@digitallyinduced.com>
Date: Sun, 17 Mar 2024 12:10:49 +0100
Subject: [PATCH 21/22] Docs: Add reference to the migration guide

---
 Guide/database.markdown | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Guide/database.markdown b/Guide/database.markdown
index 4408b7e4b..ed1c145c6 100644
--- a/Guide/database.markdown
+++ b/Guide/database.markdown
@@ -768,7 +768,7 @@ Similarly as for renaming, deleting a column currently won't work automatically
 
 ### Migrations In Production
 
-IHP currently has no built-in migration system yet. We're still experimenting with a great way to solve this. Until then, the recommended approach used by digitally induced is to manually migrate your database using DDL statements as shown above.
+See the [Migrations guide](https://ihp.digitallyinduced.com/Guide/database-migrations.html).
 
 
 ## Supported Database Types
@@ -852,4 +852,4 @@ CREATE TABLE users (
     username TEXT NOT NULL,
     UNIQUE (email, username)
 );
-```
\ No newline at end of file
+```

From 5658c05304b69aad1884d8a63352511cc9ff81eb Mon Sep 17 00:00:00 2001
From: Amitai Burstein <amitai@gizra.com>
Date: Mon, 18 Mar 2024 09:49:15 +0200
Subject: [PATCH 22/22] Docs about Passing JSON to the View (#1934)

* Docs about Passing JSON to the View

fixes #1900

* indent code

* Move toJSON code into the View
---
 Guide/view.markdown | 52 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 52 insertions(+)

diff --git a/Guide/view.markdown b/Guide/view.markdown
index 6a6f4419d..4e326c972 100644
--- a/Guide/view.markdown
+++ b/Guide/view.markdown
@@ -181,6 +181,58 @@ Now the `company` variable can be used to read the current user's company across
 
 Use [`theRequest`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:theRequest) to access the current [WAI request](https://hackage.haskell.org/package/wai-3.2.2.1/docs/Network-Wai.html).
 
+### Passing JSON to the View
+
+You might need to pass JSON values to the view, so later you could have a JS script to read it. You should use Aeson's `toJSON` function to convert your data to JSON and then pass it to the view. Let's say you have a `Posts` controller and `Post`s records that you want to print in the console.
+
+```haskell
+-- Web/Controller/Posts.hs
+instance Controller PostsController where
+    action PostsAction = do
+        posts <- query @Post |> fetch
+
+        render IndexView { .. }
+
+```
+
+Then in the view, you can access the JSON data like this:
+
+```haskell
+-- Web/View/Posts/Index.hs
+
+module Web.View.Posts.Index where
+import Web.View.Prelude
+
+-- Add Aeson import.
+import Data.Aeson (encode)
+
+data IndexView = IndexView { posts :: [Post] }
+
+instance View IndexView where
+    html IndexView { .. } = [hsx|
+        <div>
+            Open the developer's console to see the posts JSON data.
+        </div>
+        {- Pass the encoded JSON to the JS script -}
+        <script data-posts={encode $ postsToJson posts}>
+            // Parse the encoded JSON, and print to console
+            console.log(JSON.parse(document.currentScript.dataset.posts));
+        </script>
+    |]
+    where
+        postsToJson :: [Post] -> Value
+        postsToJson posts =
+            posts
+                |> fmap (\post -> object
+                    [ "id" .= post.id
+                    , "title" .= post.title
+                    , "body" .= post.body
+                    ])
+                |> toJSON
+```
+
+No you can go to `/Posts`, create a few posts, and see their JSON in the browser's developer console.
+
 ### Highlighting the current active link
 
 Use [`isActiveAction`](https://ihp.digitallyinduced.com/api-docs/IHP-ViewSupport.html#v:isActiveAction) to check whether the current request URL matches a given action: