get note sql

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|

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