From 75f90a257b28954aa5f7c6cebc2cbafb8fc12e98 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= <jan.van.brugge@futurice.com>
Date: Fri, 18 Feb 2022 18:30:11 +0100
Subject: [PATCH] Use JSONB aggregates to query contacts

This converts a n+1 query into a single query
---
 backend/src/Data/ClientRequest.hs |  6 +++++-
 backend/src/Database.hs           | 27 ++++++++++++++-------------
 2 files changed, 19 insertions(+), 14 deletions(-)

diff --git a/backend/src/Data/ClientRequest.hs b/backend/src/Data/ClientRequest.hs
index 832c7db..4e1bc73 100644
--- a/backend/src/Data/ClientRequest.hs
+++ b/backend/src/Data/ClientRequest.hs
@@ -9,7 +9,8 @@ import Data.Text (Text)
 import Data.Time.Calendar (Day)
 import Data.User (Email, User (..))
 import Data.Workmode (Workmode (..))
-import Database.PostgreSQL.Simple.FromRow (FromRow (..), field)
+import Database.PostgreSQL.Simple.FromField (fromJSONField)
+import Database.PostgreSQL.Simple.FromRow (FromRow (..), field, fieldWith)
 import Database.PostgreSQL.Simple.ToField (ToField (toField))
 import Database.PostgreSQL.Simple.ToRow (ToRow (..))
 import Database.PostgreSQL.Simple.Types (Null (Null))
@@ -65,6 +66,9 @@ data Office = MkOffice
 
 data UserRegistration = MkUserRegistration Email Registration
 
+instance FromRow Contacts where
+  fromRow = MkContacts <$> field <*> field <*> fieldWith fromJSONField
+
 instance ToRow UserRegistration where
   toRow (MkUserRegistration email MkRegistration {office, date, workmode}) =
     [toField email, toField office, toField date] <> case workmode of
diff --git a/backend/src/Database.hs b/backend/src/Database.hs
index 6d17a9b..6d9fed8 100644
--- a/backend/src/Database.hs
+++ b/backend/src/Database.hs
@@ -1,5 +1,4 @@
 {-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE TupleSections #-}
 
 module Database where
 
@@ -46,18 +45,20 @@ queryBooked office start end =
 queryContacts :: (MonadIO m, MonadReader Env m) => Email -> Day -> Day -> m [Contacts]
 queryContacts email start end =
   query'
-    "SELECT office, date FROM registrations WHERE workmode = 'Office' AND user_email = ? AND date >= ? AND date <= ? ORDER BY date DESC"
-    (email, start, end)
-    >>= mapM
-      ( \t@(office, date) ->
-          MkContacts date office
-            <$> query'
-              ( userFields <> " WHERE u.user_email IN ("
-                  <> "SELECT r.user_email FROM registrations AS r WHERE workmode = 'Office' AND office = ? AND date = ?"
-                  <> ")"
-              )
-              t
-      )
+    ( "WITH dates AS ("
+        <> "SELECT date,office FROM registrations WHERE "
+        <> "workmode = 'Office' AND user_email = ? AND date >= ? AND date <= ?),"
+        <> "contacts AS ("
+        <> "SELECT date,office,user_email FROM registrations JOIN dates USING (date,office) "
+        <> "WHERE user_email <> ?),"
+        <> "user_fields AS (SELECT uf.name, uf.user_email AS email, uf.picture AS portrait, uf.default_office AS \"defaultOffice\", uf.is_admin AS \"isAdmin\" FROM ("
+        <> userFields
+        <> ") AS uf) "
+        <> "SELECT date,office,jsonb_agg(to_jsonb(user_fields.*)) AS contacts "
+        <> "FROM contacts JOIN user_fields ON contacts.user_email = user_fields.email "
+        <> "GROUP BY date, office ORDER BY date DESC"
+    )
+    (email, start, end, email)
 
 tryRegistrations :: (MonadIO m, MonadReader Env m) => Maybe AdminUser -> Email -> [Registration] -> m (Maybe [Day])
 tryRegistrations admin user xs = do