refactor Fedi.Routes

app/Html.hs

@@ -6,6 +6,7 @@ import Data.String (fromString)
 import Data.Text qualified as T
 import Fedi qualified as Fedi
 import Lucid qualified as H
+import Text.RawString.QQ (r)
 
 -- * HTML
 
@@ -52,10 +53,12 @@ userHtml details = do
 notesHtml :: [Fedi.Note] -> Html
 notesHtml notes = do
   H.div_ [H.class_ "notes"] $ mapM_ noteHtml notes
+  H.script_ $ T.pack localDateJs
 
 -- | A single post as HTML.
 noteHtml :: Fedi.Note -> Html
 noteHtml note = do
+  let noteid = T.pack (maybe "" (\i -> i.unwrap) note.id)
   H.div_ [H.class_ "note"] $ do
     H.div_ [H.class_ "note-header"] $ do
       case note.name of
@@ -68,12 +71,13 @@ noteHtml note = do
           H.p_ $ H.a_ [H.href_ (T.pack url)] $ fromString url
         Nothing -> pure ()
 
-      H.a_
+      Fedi.for_ note.published \published ->
-        [ H.href_ (T.pack (maybe "" (\i -> i.unwrap) note.id))
+        H.a_
-        , H.class_ "note-time"
+          [ H.href_ noteid
-        , H.title_ "See note page"
+          , H.class_ "note-time"
-        ]
+          , H.title_ "See note page"
-        (H.toHtml (T.pack (show note.published)))
+          ]
+          (H.span_ [H.class_ $ "note-date-published"] $ H.toHtml (show published))
 
     H.div_ [H.class_ $ "note-content " <> checkDirection (maybe "" id note.content)] $ do
       H.toHtmlRaw (maybe "" id note.content)
@@ -127,3 +131,13 @@ newNoteHtml details = do
             , H.value_ "Post"
             ]
     )
+
+localDateJs :: String
+localDateJs = [r|
+let collection = document.querySelectorAll(".note-date-published");
+
+for (let i = 0; i < collection.length; i++) {
+  let date = new Date(collection[i].innerHTML);
+  collection[i].innerHTML = date.toLocaleString();
+}
+|]

app/Routes.hs

@@ -11,6 +11,16 @@ import Html
 import Lucid qualified as H
 import System.IO.Unsafe (unsafePerformIO)
 import Web.Twain qualified as Twain
+import Network.HTTP.Req
+  ( runReq
+  , defaultHttpConfig
+  , req
+  , POST(POST)
+  , ReqBodyJson(ReqBodyJson)
+  , jsonResponse
+  , responseBody
+  , https
+  )
 
 routes :: DB -> FilePath -> [Twain.Middleware]
 routes db detailsFile =
@@ -43,12 +53,8 @@ routes db detailsFile =
       Fedi.handleCreateNote details notes
   , -- Match inbox
     Twain.get (Fedi.matchInbox $ unsafePerformIO $ fetchUserDetails detailsFile) do
-      let
+      Fedi.handleInbox (handleInbox db detailsFile)
-        handle activity = do
-          liftIO (print activity)
-          pure $ Fedi.jsonLD $ A.encode activity
 
-      Fedi.handleInbox handle
   , -- Match Create object
     Twain.get (Fedi.matchCreateNote $ unsafePerformIO $ fetchUserDetails detailsFile) do
       details <- liftIO $ fetchUserDetails detailsFile
@@ -70,10 +76,20 @@ routes db detailsFile =
             Nothing -> Twain.next
             Just thenote ->
               Twain.send $ Twain.html $ H.renderBS $ actorPage details [thenote]
+
+  , -- Followers
+    Twain.get (Fedi.matchFollowers $ unsafePerformIO $ fetchUserDetails detailsFile) do
+      details <- liftIO $ fetchUserDetails detailsFile
+      Fedi.handleFollowers details
+  , -- Following
+    Twain.get (Fedi.matchFollowing $ unsafePerformIO $ fetchUserDetails detailsFile) do
+      details <- liftIO $ fetchUserDetails detailsFile
+      Fedi.handleFollowing details
   , -- Match webfinger
     Twain.get Fedi.matchWebfinger do
       details <- liftIO $ fetchUserDetails detailsFile
       Fedi.handleWebfinger details
+  --------------------------------------------------------------------------------------------
   , -- Admin page
     Twain.get (fromString $ "/" <> (unsafePerformIO $ fetchUserDetails detailsFile).username <> "/admin") do
       details <- liftIO $ fetchUserDetails detailsFile
@@ -109,3 +125,48 @@ fetchUserDetails detailsFile =
 
 noteToCreate :: Fedi.Note -> Fedi.Create
 noteToCreate note = Fedi.makeCreateNote note
+
+handleInbox :: DB -> FilePath -> Fedi.AnyActivity -> Twain.ResponderM Twain.Response
+handleInbox db detailsFile activity = do
+  details <- liftIO $ fetchUserDetails detailsFile
+  case activity of
+    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
+                insertId <- db.insertFollower FollowerEntry
+                  { actorId = fromString actor.unwrap
+                  , followId = fromString id''.unwrap
+                  }
+                (result :: A.Value) <- sendRequest
+                  (id''.unwrap <> "/inbox")
+                  ( Fedi.makeAccept
+                    follow
+                    (Fedi.actorUrl details <> "/accepts/follows/" <> show insertId)
+                  )
+                print result
+                pure $ Fedi.jsonLD "{}"
+            else Twain.next
+        Nothing ->
+          Twain.next
+    _ -> do
+      liftIO (print activity)
+      Twain.next
+
+sendRequest :: (A.ToJSON input, A.FromJSON output) => Fedi.Url -> input -> IO output
+sendRequest url payload = do
+  runReq defaultHttpConfig do
+    r <-
+      req
+        POST
+        (https $ fromString url)
+        (ReqBodyJson payload)
+        jsonResponse
+        mempty
+    pure $ responseBody r

fedi.cabal

@@ -18,10 +18,17 @@ library
   exposed-modules:
     Fedi
     Fedi.Helpers
-    Fedi.Routes
     Fedi.Types
     Fedi.UserDetails
     Fedi.Webfinger
+
+    Fedi.Routes
+    Fedi.Routes.Helpers
+    Fedi.Routes.User
+    Fedi.Routes.Inbox
+    Fedi.Routes.Outbox
+    Fedi.Routes.Notes
+    Fedi.Routes.Follow
   -- other-modules:
   -- other-extensions:
   build-depends:
@@ -77,6 +84,7 @@ executable fedi
     , raw-strings-qq
     , securemem
     , lucid2
+    , req
 
   hs-source-dirs: app
   default-language: GHC2021

src/Fedi/Helpers.hs

@@ -151,3 +151,18 @@ emptyOrderedCollectionPage url =
           , current = Nothing
           }
     }
+
+makeAccept :: Follow -> Url -> Accept
+makeAccept theirFollow myfollowId =
+  emptyObject
+    { id = Just $ ObjectId myfollowId
+    , otype =
+        TypeActivity
+          { actor = theirFollow.otype.actor
+          , atype = TypeAccept
+            { object = ActivityFollow theirFollow
+            }
+          , target = Nothing
+          , origin = Nothing
+          }
+    }

src/Fedi/Routes.hs

@@ -1,14 +1,18 @@
-module Fedi.Routes where
+module Fedi.Routes
+  ( module Fedi.Routes
+  , module Export
+  )
+where
 
-import Data.Aeson qualified as A
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy qualified as BSL
-import Fedi.Helpers
-import Fedi.Types
 import Fedi.UserDetails
-import Fedi.Webfinger
 import Web.Twain qualified as Twain
-import Web.Twain.Types qualified as Twain
+
+import Fedi.Routes.Helpers as Export
+import Fedi.Routes.User as Export
+import Fedi.Routes.Inbox as Export
+import Fedi.Routes.Outbox as Export
+import Fedi.Routes.Notes as Export
+import Fedi.Routes.Follow as Export
 
 -- * Routes
 
@@ -29,160 +33,3 @@ routes details =
   , Twain.get matchWebfinger do
       handleWebfinger details
   ]
-
-jsonLD :: BSL.ByteString -> Twain.Response
-jsonLD =
-  Twain.raw
-    Twain.status200
-    [(Twain.hContentType, "application/activity+json; charset=utf-8")]
-
--- * Create
-
-matchCreateNote :: UserDetails -> Twain.PathPattern
-matchCreateNote details = fromString ("/" <> details.username <> "/notes/:note_id/create")
-
-handleCreateNote :: UserDetails -> [Create] -> Twain.ResponderM a
-handleCreateNote details items = do
-  noteId <- Twain.param "note_id"
-  let
-    createUrl =
-      "https://"
-        <> details.domain
-        <> "/"
-        <> details.username
-        <> "/notes/"
-        <> noteId
-        <> "/create"
-  let
-    content =
-      find (\create -> create.id == Just (ObjectId createUrl)) items
-  Twain.send $ jsonLD (A.encode content)
-
--- * Note
-
-matchNote :: UserDetails -> Twain.PathPattern
-matchNote details = fromString ("/" <> details.username <> "/notes/:note_id")
-
-handleNote :: UserDetails -> [Note] -> Twain.ResponderM a
-handleNote details items = do
-  noteId <- Twain.param "note_id"
-  let
-    noteUrl =
-      "https://"
-        <> details.domain
-        <> "/"
-        <> details.username
-        <> "/notes/"
-        <> noteId
-  let
-    content =
-      find (\note -> note.id == Just (ObjectId noteUrl)) items
-  Twain.send $ jsonLD (A.encode content)
-
--- * User
-
-matchUser :: UserDetails -> Twain.PathPattern
-matchUser details = fromString ("/" <> details.username)
-
-handleUser :: UserDetails -> Twain.ResponderM a
-handleUser details = do
-  let
-    content = makeActor details
-  Twain.send $ jsonLD (A.encode content)
-
--- * Webfinger
-
-matchWebfinger :: Twain.PathPattern
-matchWebfinger = "/.well-known/webfinger"
-
-handleWebfinger :: UserDetails -> Twain.ResponderM b
-handleWebfinger details = do
-  resource <- Twain.param "resource"
-  let
-    webfinger = makeWebfinger details
-  if resource == ppSubject webfinger.subject
-    then do
-      Twain.send $ jsonLD (A.encode webfinger)
-    else do
-      Twain.next
-
--- * Outbox
-
-matchOutbox :: UserDetails -> Twain.PathPattern
-matchOutbox details =
-  fromString ("/" <> details.username <> "/outbox")
-
-handleOutbox :: UserDetails -> [AnyActivity] -> Twain.ResponderM b
-handleOutbox details items = do
-  isPage <- Twain.queryParamMaybe "page"
-  let
-    outboxUrl =
-      "https://"
-        <> details.domain
-        <> "/"
-        <> details.username
-        <> "/outbox"
-    response =
-      case isPage of
-        Just True ->
-          let
-            empty = emptyOrderedCollectionPage outboxUrl
-            content :: OutboxPage
-            content =
-              empty
-                { id = Just $ ObjectId $ outboxUrl <> "?page=true"
-                , otype =
-                    empty.otype
-                      { ctype =
-                          empty.otype.ctype
-                            { partOf = outboxUrl
-                            , porderedItems = items
-                            }
-                      }
-                }
-          in
-            A.encode content
-        _ ->
-          let
-            content :: Outbox
-            content =
-              emptyOrderedCollection
-                { id = Just $ ObjectId outboxUrl
-                , summary = Just $ fromString $ details.username <> "'s notes"
-                , otype =
-                    emptyOrderedCollection.otype
-                      { ctype =
-                          emptyOrderedCollection.otype.ctype
-                            { orderedItems = items
-                            }
-                      , first = Just $ outboxUrl <> "?page=true"
-                      , last = Just $ outboxUrl <> "?page=true"
-                      }
-                }
-          in
-            A.encode content
-  Twain.send $ jsonLD response
-
--- * Inbox
-
-matchInbox :: UserDetails -> Twain.PathPattern
-matchInbox details =
-  fromString ("/" <> details.username <> "/inbox")
-
-handleInbox :: (AnyActivity -> Twain.ResponderM Twain.Response) -> Twain.ResponderM b
-handleInbox handle = do
-  activity <- Twain.fromBody
-  response <- handle activity
-  Twain.send response
-
--- * Other stuff
-
-checkContentTypeAccept :: Twain.Request -> Bool
-checkContentTypeAccept request =
-  case lookup Twain.hAccept request.requestHeaders of
-    Just bs ->
-      ("application/activity+json" `BS.isInfixOf` bs)
-        || ( ("application/ld+json" `BS.isInfixOf` bs)
-              && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs)
-           )
-    Nothing -> False

src/Fedi/Routes/Follow.hs

@@ -0,0 +1,43 @@
+module Fedi.Routes.Follow where
+
+import Data.Aeson qualified as A
+import Fedi.Helpers
+import Fedi.Types
+import Fedi.UserDetails
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Followers
+
+matchFollowers :: UserDetails -> Twain.PathPattern
+matchFollowers details =
+  fromString ("/" <> details.username <> "/followers")
+
+handleFollowers :: UserDetails -> Twain.ResponderM b
+handleFollowers details = do
+  let
+    collection :: Collection ()
+    collection =
+      emptyUnorderedCollection
+      { id = Just $ ObjectId $ actorUrl details <> "/followers"
+      , summary = Just $ fromString $ details.username <> "'s followers"
+      }
+  Twain.send $ jsonLD (A.encode collection)
+
+-- * Following
+
+matchFollowing :: UserDetails -> Twain.PathPattern
+matchFollowing details =
+  fromString ("/" <> details.username <> "/following")
+
+handleFollowing :: UserDetails -> Twain.ResponderM b
+handleFollowing details = do
+  let
+    collection :: Collection ()
+    collection =
+      emptyUnorderedCollection
+      { id = Just $ ObjectId $ actorUrl details <> "/following"
+      , summary = Just $ fromString $ details.username <> " is following"
+      }
+  Twain.send $ jsonLD (A.encode collection)

src/Fedi/Routes/Helpers.hs

@@ -0,0 +1,21 @@
+module Fedi.Routes.Helpers where
+
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
+import Web.Twain qualified as Twain
+
+jsonLD :: BSL.ByteString -> Twain.Response
+jsonLD =
+  Twain.raw
+    Twain.status200
+    [(Twain.hContentType, "application/activity+json; charset=utf-8")]
+
+checkContentTypeAccept :: Twain.Request -> Bool
+checkContentTypeAccept request =
+  case lookup Twain.hAccept request.requestHeaders of
+    Just bs ->
+      ("application/activity+json" `BS.isInfixOf` bs)
+        || ( ("application/ld+json" `BS.isInfixOf` bs)
+              && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs)
+           )
+    Nothing -> False

src/Fedi/Routes/Inbox.hs

@@ -0,0 +1,19 @@
+module Fedi.Routes.Inbox where
+
+import Fedi.Types
+import Fedi.UserDetails
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Inbox
+
+matchInbox :: UserDetails -> Twain.PathPattern
+matchInbox details =
+  fromString ("/" <> details.username <> "/inbox")
+
+handleInbox :: (AnyActivity -> Twain.ResponderM Twain.Response) -> Twain.ResponderM b
+handleInbox handle = do
+  activity <- Twain.fromBody
+  -- sig <- Twain.header "Signature"
+  response <- handle activity
+  Twain.send response

src/Fedi/Routes/Notes.hs

@@ -0,0 +1,51 @@
+module Fedi.Routes.Notes where
+
+import Data.Aeson qualified as A
+import Fedi.Types
+import Fedi.UserDetails
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Create
+
+matchCreateNote :: UserDetails -> Twain.PathPattern
+matchCreateNote details = fromString ("/" <> details.username <> "/notes/:note_id/create")
+
+handleCreateNote :: UserDetails -> [Create] -> Twain.ResponderM a
+handleCreateNote details items = do
+  noteId <- Twain.param "note_id"
+  let
+    createUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/notes/"
+        <> noteId
+        <> "/create"
+  let
+    content =
+      find (\create -> create.id == Just (ObjectId createUrl)) items
+  Twain.send $ jsonLD (A.encode content)
+
+-- * Note
+
+matchNote :: UserDetails -> Twain.PathPattern
+matchNote details = fromString ("/" <> details.username <> "/notes/:note_id")
+
+handleNote :: UserDetails -> [Note] -> Twain.ResponderM a
+handleNote details items = do
+  noteId <- Twain.param "note_id"
+  let
+    noteUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/notes/"
+        <> noteId
+  let
+    content =
+      find (\note -> note.id == Just (ObjectId noteUrl)) items
+  Twain.send $ jsonLD (A.encode content)

src/Fedi/Routes/Outbox.hs

@@ -0,0 +1,66 @@
+module Fedi.Routes.Outbox where
+
+import Data.Aeson qualified as A
+import Fedi.Helpers
+import Fedi.Types
+import Fedi.UserDetails
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * Outbox
+
+matchOutbox :: UserDetails -> Twain.PathPattern
+matchOutbox details =
+  fromString ("/" <> details.username <> "/outbox")
+
+handleOutbox :: UserDetails -> [AnyActivity] -> Twain.ResponderM b
+handleOutbox details items = do
+  isPage <- Twain.queryParamMaybe "page"
+  let
+    outboxUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/outbox"
+    response =
+      case isPage of
+        Just True ->
+          let
+            empty = emptyOrderedCollectionPage outboxUrl
+            content :: OutboxPage
+            content =
+              empty
+                { id = Just $ ObjectId $ outboxUrl <> "?page=true"
+                , otype =
+                    empty.otype
+                      { ctype =
+                          empty.otype.ctype
+                            { partOf = outboxUrl
+                            , porderedItems = items
+                            }
+                      }
+                }
+          in
+            A.encode content
+        _ ->
+          let
+            content :: Outbox
+            content =
+              emptyOrderedCollection
+                { id = Just $ ObjectId outboxUrl
+                , summary = Just $ fromString $ details.username <> "'s notes"
+                , otype =
+                    emptyOrderedCollection.otype
+                      { ctype =
+                          emptyOrderedCollection.otype.ctype
+                            { orderedItems = items
+                            }
+                      , first = Just $ outboxUrl <> "?page=true"
+                      , last = Just $ outboxUrl <> "?page=true"
+                      }
+                }
+          in
+            A.encode content
+  Twain.send $ jsonLD response

src/Fedi/Routes/User.hs

@@ -0,0 +1,36 @@
+module Fedi.Routes.User where
+
+import Data.Aeson qualified as A
+import Fedi.Helpers
+import Fedi.UserDetails
+import Fedi.Webfinger
+import Fedi.Routes.Helpers
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
+
+-- * User
+
+matchUser :: UserDetails -> Twain.PathPattern
+matchUser details = fromString ("/" <> details.username)
+
+handleUser :: UserDetails -> Twain.ResponderM a
+handleUser details = do
+  let
+    content = makeActor details
+  Twain.send $ jsonLD (A.encode content)
+
+-- * Webfinger
+
+matchWebfinger :: Twain.PathPattern
+matchWebfinger = "/.well-known/webfinger"
+
+handleWebfinger :: UserDetails -> Twain.ResponderM b
+handleWebfinger details = do
+  resource <- Twain.param "resource"
+  let
+    webfinger = makeWebfinger details
+  if resource == ppSubject webfinger.subject
+    then do
+      Twain.send $ jsonLD (A.encode webfinger)
+    else do
+      Twain.next

src/Fedi/Types.hs

@@ -37,7 +37,7 @@ data Object typ
     mediaType :: Maybe MediaType
     -- , duration  :: Maybe String
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 class ToObject a where
   toObject :: a -> [A.Pair]
@@ -101,13 +101,13 @@ newtype ObjectId = ObjectId {unwrap :: String}
   deriving (Show, Eq, A.FromJSON, A.ToJSON) via String
 
 newtype Link = Link {unwrap :: Url}
-  deriving (Show, A.FromJSON, A.ToJSON) via Url
+  deriving (Show, Eq, A.FromJSON, A.ToJSON) via Url
 
 data LinkOrObject a
   = LLink Link
   | OObject (Object a)
   | CCollection [LinkOrObject a]
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance (A.FromJSON a) => A.FromJSON (LinkOrObject a) where
   parseJSON = \case
@@ -130,7 +130,7 @@ instance (ToObject o) => A.ToJSON (LinkOrObject o) where
 
 data AnyMedia
   = ImageMedia Image
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance A.ToJSON AnyMedia where
   toJSON = \case
@@ -142,7 +142,7 @@ instance A.FromJSON AnyMedia where
 
 type Image = Object TypeImage
 
-data TypeImage = TypeImage deriving (Show)
+data TypeImage = TypeImage deriving (Show, Eq)
 
 instance ToObject TypeImage where
   toObject TypeImage =
@@ -158,7 +158,7 @@ instance A.FromJSON TypeImage where
 data Name
   = StringName String
   | ObjectName (LinkOrObject Actor)
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance A.ToJSON Name where
   toJSON = \case
@@ -184,7 +184,7 @@ data TypeNote
   , replies :: Collection Note
   , sensitive :: Bool
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance ToObject TypeNote where
   toObject note =
@@ -209,16 +209,16 @@ data TypeTag
   = TypeTag
   { href :: Url
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 type Preview = Object TypePreview
 
 data TypePreview = TypePreview
-  deriving (Show)
+  deriving (Show, Eq)
 
 type Share = Object TypeShare
 
-data TypeShare = TypeShare deriving (Show)
+data TypeShare = TypeShare deriving (Show, Eq)
 
 instance ToObject TypeShare where
   toObject TypeShare =
@@ -230,7 +230,7 @@ instance A.FromJSON TypeShare where
     A.withObject "TypeShare" \value -> do
       typ :: String <- value A..: "type"
       guard (typ == "Share")
-      pure TypeShare {..}
+      pure TypeShare
 
 -- * Activities
 
@@ -248,7 +248,7 @@ data TypeActivity t
   -- , result :: Maybe String
   -- , instrument :: Maybe String
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance (ToObject t) => ToObject (TypeActivity t) where
   toObject activity =
@@ -284,7 +284,7 @@ data TypeCreate
   = TypeCreate
   { object :: Note
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance ToObject TypeCreate where
   toObject create =
@@ -304,9 +304,9 @@ type Follow = Object (TypeActivity TypeFollow)
 
 data TypeFollow
   = TypeFollow
-  { object :: Actor
+  { object :: LinkOrObject Actor
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance ToObject TypeFollow where
   toObject follow =
@@ -325,7 +325,7 @@ instance A.FromJSON TypeFollow where
 --
 type Like = Object (TypeActivity TypeLike)
 
-data TypeLike = TypeLike deriving (Show)
+data TypeLike = TypeLike deriving (Show, Eq)
 
 instance ToObject TypeLike where
   toObject TypeLike =
@@ -337,7 +337,7 @@ instance A.FromJSON TypeLike where
     A.withObject "TypeLike" \value -> do
       typ :: String <- value A..: "type"
       guard (typ == "Like")
-      pure TypeLike {..}
+      pure TypeLike
 
 data AnyActivity
   = -- ActivityAnnounce Announce
@@ -346,7 +346,7 @@ data AnyActivity
   | --  | ActivityLike Like
     ActivityAccept Accept
   | ActivityReject Reject
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance A.ToJSON AnyActivity where
   toJSON = \case
@@ -376,7 +376,7 @@ data TypeAccept
   = TypeAccept
   { object :: AnyActivity
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance ToObject TypeAccept where
   toObject obj =
@@ -398,7 +398,7 @@ data TypeReject
   = TypeReject
   { object :: AnyActivity
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance ToObject TypeReject where
   toObject obj =
@@ -418,7 +418,9 @@ instance A.FromJSON TypeReject where
 
 -- | An Actor is an object that has one of the following types.
 -- <https://www.w3.org/TR/activitystreams-vocabulary/#actor-types>
-data Actor = ActorPerson Person deriving (Show)
+data Actor
+  = ActorPerson Person
+  deriving (Show, Eq)
 
 instance A.FromJSON Actor where
   parseJSON =
@@ -457,7 +459,7 @@ data TypePerson
   , following :: Link
   , followers :: Link
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance ToObject TypePerson where
   toObject person =
@@ -476,7 +478,7 @@ data PublicKey
   , owner :: Url
   , publicKeyPem :: Pem
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance A.ToJSON PublicKey where
   toJSON pk =
@@ -513,7 +515,7 @@ data CollectionType t
   , last :: Maybe Url
   , current :: Maybe Url
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance (ToObject t) => ToObject (CollectionType t) where
   toObject collection =
@@ -539,7 +541,7 @@ data Unordered e
   = UnorderedCollectionType
   { items :: [e]
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance (A.ToJSON e) => ToObject (Unordered e) where
   toObject collection =
@@ -560,7 +562,7 @@ data Ordered e
   = OrderedCollectionType
   { orderedItems :: [e]
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance (A.ToJSON e) => ToObject (Ordered e) where
   toObject collection =
@@ -584,7 +586,7 @@ data OrderedPage e
   , next :: Maybe Url
   , porderedItems :: [e]
   }
-  deriving (Show)
+  deriving (Show, Eq)
 
 instance (A.ToJSON e) => ToObject (OrderedPage e) where
   toObject page =

src/Fedi/UserDetails.hs

@@ -20,7 +20,7 @@ type Domain = String
 type Username = String
 
 newtype Pem = Pem T.Text
-  deriving (Show)
+  deriving (Show, Eq)
   deriving (A.FromJSON) via T.Text
 
 instance A.ToJSON Pem where
@@ -37,7 +37,7 @@ data UserDetails
   , publicPem :: Pem
   , privatePem :: FilePath
   }
-  deriving (Show, Generic, A.FromJSON)
+  deriving (Show, Eq, Generic, A.FromJSON)
 
 actorUrl :: UserDetails -> Url
 actorUrl details =