From c17f1ef53e9a4cd006ad0515dfffe849ddfee8bc Mon Sep 17 00:00:00 2001
From: me <me@alloca.space>
Date: Tue, 17 Dec 2024 10:46:59 +0200
Subject: [PATCH] add follower db interaction

---
 app/DB.hs | 51 +++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 49 insertions(+), 2 deletions(-)

diff --git a/app/DB.hs b/app/DB.hs
index 03b415d..e65964d 100644
--- a/app/DB.hs
+++ b/app/DB.hs
@@ -16,6 +16,7 @@ data DB
   { getNotes :: IO [Note]
   , getNote :: DB.Int64 -> IO (Maybe Note)
   , insertNote :: NoteEntry -> IO ObjectId
+  , insertFollower :: FollowerEntry -> IO DB.Int64
   }
 
 -- * Data types
@@ -28,6 +29,12 @@ data NoteEntry
   , url :: Maybe Url
   }
 
+data FollowerEntry
+  = FollowerEntry
+  { followId :: T.Text
+  , actorId :: T.Text
+  }
+
 -----------------------
 
 -- * Handler smart constructor
@@ -44,6 +51,8 @@ mkDB connstr details = do
           \noteid -> DB.withPool pool (getNoteFromDb noteid $ actorUrl details)
       , insertNote =
           \note -> DB.withPool pool (insertNoteToDb (actorUrl details) note)
+      , insertFollower =
+          \follower -> DB.withPool pool (insertFollowerToDb follower)
       }
 
 -----------------------
@@ -56,6 +65,7 @@ runMigrations = DB.migrate migrations migrateUp migrateDown
 migrations :: [DB.MigrationName]
 migrations =
   [ "note"
+  , "follower"
   ]
 
 migrateUp :: (HasCallStack) => DB.MigrationName -> DB.SQLite ()
@@ -73,15 +83,29 @@ migrateUp = \case
           url text
         )
       |]
-
     pure ()
+
+  "follower" -> do
+    [] <-
+      DB.run
+        [r| create table follower(
+          id integer primary key autoincrement,
+          follow_id text not null unique,
+          actor text not null unique
+        )
+      |]
+    pure ()
+
   name -> error $ "unexpected migration: " <> show name
 
 migrateDown :: (HasCallStack) => DB.MigrationName -> DB.SQLite ()
 migrateDown = \case
-  "notes" -> do
+  "note" -> do
     [] <- DB.run "DROP TABLE note"
     pure ()
+  "follower" -> do
+    [] <- DB.run "DROP TABLE follower"
+    pure ()
   name -> error $ "unexpected migration: " <> show name
 
 -----------------------
@@ -102,6 +126,11 @@ insertNoteToDb actor note = do
   [n] <- map decodeNoteIdRow <$> uncurry DB.runWith (insertNoteSQL actor note)
   pure n
 
+insertFollowerToDb :: FollowerEntry -> DB.SQLite DB.Int64
+insertFollowerToDb follower = do
+  [n] <- map decodeIntRow <$> uncurry DB.runWith (insertFollowerSQL follower)
+  pure n
+
 -- ** SQL
 
 getNotesSQL :: Url -> (DB.SQL, [DB.SQLData])
@@ -156,6 +185,19 @@ insertNoteSQL actor note =
     ]
   )
 
+insertFollowerSQL :: FollowerEntry -> (DB.SQL, [DB.SQLData])
+insertFollowerSQL follower =
+  ( [r|
+      INSERT INTO note(follow_id, actor)
+      VALUES (?, ?)
+      RETURNING id
+    |]
+  ,
+    [ DB.SQLText follower.followId
+    , DB.SQLText follower.actorId
+    ]
+  )
+
 -----------------------
 
 -- ** Decode row
@@ -200,6 +242,11 @@ decodeNoteIdRow = \case
   [DB.SQLText noteid] -> ObjectId $ T.unpack noteid
   row -> error $ "Couldn't decode row as NoteId: " <> show row
 
+decodeIntRow :: [DB.SQLData] -> DB.Int64
+decodeIntRow = \case
+  [DB.SQLInteger fid] -> fid
+  row -> error $ "Couldn't decode row as NoteId: " <> show row
+
 nullableString :: DB.SQLData -> Maybe (Maybe String)
 nullableString = \case
   DB.SQLText text -> Just (Just $ T.unpack text)