diff --git a/app/DB.hs b/app/DB.hs index 671a483..497f00b 100644 --- a/app/DB.hs +++ b/app/DB.hs @@ -17,6 +17,7 @@ data DB , getNote :: DB.Int64 -> IO (Maybe Note) , insertNote :: NoteEntry -> IO (DB.Int64, Note) , insertFollower :: FollowerEntry -> IO DB.Int64 + , deleteFollower :: FollowerEntry -> IO DB.Int64 , getFollowers :: IO [Follower] } @@ -61,6 +62,8 @@ mkDB connstr details = do \note -> DB.withPool pool (insertNoteToDb (actorUrl details) note) , insertFollower = \follower -> DB.withPool pool (insertFollowerToDb follower) + , deleteFollower = + \follower -> DB.withPool pool (deleteFollowerFromDb follower) , getFollowers = DB.withPool pool (getFollowersFromDb $ actorUrl details) } @@ -139,6 +142,11 @@ insertFollowerToDb follower = do [n] <- map decodeIntRow <$> uncurry DB.runWith (insertFollowerSQL follower) pure n +deleteFollowerFromDb :: FollowerEntry -> DB.SQLite DB.Int64 +deleteFollowerFromDb follower = do + [n] <- map decodeIntRow <$> uncurry DB.runWith (deleteFollowerSQL follower) + pure n + getFollowersFromDb :: Url -> DB.SQLite [Follower] getFollowersFromDb url = map decodeFollowerRow <$> uncurry DB.runWith (getFollowersSQL url) @@ -211,7 +219,7 @@ insertNoteSQL actor note = insertFollowerSQL :: FollowerEntry -> (DB.SQL, [DB.SQLData]) insertFollowerSQL follower = ( [r| - INSERT INTO note(follow_id, actor) + INSERT INTO follower(follow_id, actor) VALUES (?, ?) RETURNING id |] @@ -221,6 +229,19 @@ insertFollowerSQL follower = ] ) +deleteFollowerSQL :: FollowerEntry -> (DB.SQL, [DB.SQLData]) +deleteFollowerSQL follower = + ( [r| + DELETE FROM follower + WHERE followId = ? AND actor = ? + RETURNING followId + |] + , + [ DB.SQLText follower.followId + , DB.SQLText follower.actorId + ] + ) + getFollowersSQL :: Url -> (DB.SQL, [DB.SQLData]) getFollowersSQL url = ( [r| diff --git a/app/Routes.hs b/app/Routes.hs index 1c6b6fb..32c6d7f 100644 --- a/app/Routes.hs +++ b/app/Routes.hs @@ -150,6 +150,32 @@ handleInbox db detailsFile activity = do else Twain.next Nothing -> Twain.next + Fedi.ActivityUndo + ( Fedi.Object + { otype = Fedi.TypeActivity + { atype = Fedi.TypeUndo + { object = Fedi.ActivityFollow follow + } + } + }) -> do + let + id' = follow.id + actor = follow.otype.actor + object = follow.otype.atype.object + case id' of + Just id'' -> do + if object == Fedi.LLink (Fedi.Link $ Fedi.actorUrl details) + then do + liftIO do + deletedId <- db.deleteFollower FollowerEntry + { actorId = fromString actor.unwrap + , followId = fromString id''.unwrap + } + print ("deleted follower: " <> show deletedId) + pure $ Fedi.jsonLD "{}" + else Twain.next + Nothing -> + Twain.next _ -> do liftIO (print activity) Twain.next diff --git a/src/Fedi/Types.hs b/src/Fedi/Types.hs index f65ed18..6b216bc 100644 --- a/src/Fedi/Types.hs +++ b/src/Fedi/Types.hs @@ -322,6 +322,30 @@ instance A.FromJSON TypeFollow where object <- value A..: "object" pure TypeFollow {..} +-- | Undo +type Undo = Activity TypeUndo + +data TypeUndo + = TypeUndo + { object :: AnyActivity + } + deriving (Show, Eq) + +instance ToObject TypeUndo where + toObject undo = + [ "type" A..= ("Undo" :: String) + , "object" A..= undo.object + ] + +instance A.FromJSON TypeUndo where + parseJSON = + A.withObject "TypeUndo" \value -> do + typ :: String <- value A..: "type" + guard (typ == "Undo") + object <- value A..: "object" + pure TypeUndo {..} + + -- type Like = Object (TypeActivity TypeLike) @@ -342,6 +366,7 @@ instance A.FromJSON TypeLike where data AnyActivity = -- ActivityAnnounce Announce ActivityCreate Create + | ActivityUndo Undo | ActivityFollow Follow | -- | ActivityLike Like ActivityAccept Accept @@ -352,6 +377,7 @@ instance A.ToJSON AnyActivity where toJSON = \case -- ActivityAnnounce obj -> A.toJSON obj ActivityCreate obj -> A.toJSON obj + ActivityUndo obj -> A.toJSON obj ActivityFollow obj -> A.toJSON obj -- ActivityLike obj -> A.toJSON obj ActivityAccept obj -> A.toJSON obj @@ -363,6 +389,7 @@ instance A.FromJSON AnyActivity where typ :: String <- v A..: "type" case typ of "Create" -> ActivityCreate <$> A.parseJSON value + "Undo" -> ActivityUndo <$> A.parseJSON value "Follow" -> ActivityFollow <$> A.parseJSON value "Accept" -> ActivityAccept <$> A.parseJSON value "Reject" -> ActivityReject <$> A.parseJSON value