From bc4039c7fd0c29a2ded3ca6c3fcde16d68e1dfa7 Mon Sep 17 00:00:00 2001
From: me <me@alloca.space>
Date: Tue, 17 Dec 2024 10:46:59 +0200
Subject: [PATCH] get note sql

---
 app/DB.hs     | 28 ++++++++++++++++++++++++++++
 app/Routes.hs | 22 ++++++++--------------
 2 files changed, 36 insertions(+), 14 deletions(-)

diff --git a/app/DB.hs b/app/DB.hs
index e915ac0..86302e3 100644
--- a/app/DB.hs
+++ b/app/DB.hs
@@ -1,6 +1,7 @@
 -- | Database interaction
 module DB where
 
+import Data.Maybe (listToMaybe)
 import GHC.Stack (HasCallStack)
 import Data.Text qualified as T
 import Database.Sqlite.Easy qualified as DB
@@ -13,6 +14,7 @@ import Fedi
 data DB
   = DB
     { getNotes :: IO [Note]
+    , getNote :: DB.Int64 -> IO (Maybe Note)
     , insertNote :: NoteEntry -> IO NoteId
     }
 
@@ -36,6 +38,8 @@ mkDB connstr details = do
   pure DB
     { getNotes =
       DB.withPool pool (getNotesFromDb $ actorUrl details)
+    , getNote =
+      \noteid -> DB.withPool pool (getNoteFromDb noteid $ actorUrl details)
     , insertNote =
       \note -> DB.withPool pool (insertNoteToDb (actorUrl details) note)
     }
@@ -84,6 +88,11 @@ getNotesFromDb :: Url -> DB.SQLite [Note]
 getNotesFromDb url =
   map decodeNoteRow <$> uncurry DB.runWith (getNotesSQL url)
 
+getNoteFromDb :: DB.Int64 -> Url -> DB.SQLite (Maybe Note)
+getNoteFromDb noteid url = do
+  n <- map decodeNoteRow <$> uncurry DB.runWith (getNoteSQL noteid url)
+  pure (listToMaybe n)
+
 insertNoteToDb :: Url -> NoteEntry -> DB.SQLite NoteId
 insertNoteToDb actor note = do
   [n] <- map decodeNoteIdRow <$> uncurry DB.runWith (insertNoteSQL actor note)
@@ -103,11 +112,30 @@ getNotesSQL url =
         inReplyTo,
         url
       FROM note
+      WHERE inReplyTo IS NULL
       ORDER BY published DESC
     |]
   , [DB.SQLText $ T.pack url]
   )
 
+getNoteSQL :: DB.Int64 -> Url -> (DB.SQL, [DB.SQLData])
+getNoteSQL noteid url =
+  ( [r|
+      SELECT
+        ? || '/notes/' || id,
+        published,
+        actor,
+        content,
+        name,
+        inReplyTo,
+        url
+      FROM note
+      WHERE note.id = ?
+      ORDER BY published DESC
+    |]
+  , [DB.SQLText $ T.pack url, DB.SQLInteger noteid]
+  )
+
 insertNoteSQL :: Url -> NoteEntry -> (DB.SQL, [DB.SQLData])
 insertNoteSQL actor note =
   ( [r|
diff --git a/app/Routes.hs b/app/Routes.hs
index ed16e42..8fbfcdc 100644
--- a/app/Routes.hs
+++ b/app/Routes.hs
@@ -1,5 +1,6 @@
 module Routes where
 
+import Data.Maybe (maybeToList)
 import Data.String (fromString)
 import Data.Aeson qualified as A
 import Web.Twain qualified as Twain
@@ -42,25 +43,18 @@ routes db detailsFile =
   , -- Match Note object
     Twain.get (Fedi.matchNote $ unsafePerformIO $ fetchUserDetails detailsFile) do
       details <- liftIO $ fetchUserDetails detailsFile
-      notes <- liftIO db.getNotes
+      noteId <- Twain.param "note_id"
+      mnote <- liftIO $ db.getNote noteId
 
       request <- Twain.request
       if Fedi.checkContentTypeAccept request
         then do
-          Fedi.handleNote details notes
+          Fedi.handleNote details (maybeToList mnote)
         else do
-          noteId <- Twain.param "note_id"
-          let
-            noteUrl =
-              "https://"
-              <> details.domain
-              <> "/"
-              <> details.username
-              <> "/notes/"
-              <> noteId
-            thenote = filter (\note -> note.id == noteUrl) notes
-
-          Twain.send $ Twain.html $ H.renderBS $ actorPage details thenote
+          case mnote of
+            Nothing -> Twain.next
+            Just thenote ->
+              Twain.send $ Twain.html $ H.renderBS $ actorPage details [thenote]
 
   , -- Match webfinger
     Twain.get Fedi.matchWebfinger do