From 62917c3ce4eb8b6fa7f10b2028691b974d447397 Mon Sep 17 00:00:00 2001
From: me <me@alloca.space>
Date: Tue, 17 Dec 2024 10:46:59 +0200
Subject: [PATCH] rewrite api to be a bit richer

---
 app/Css.hs              |   3 +-
 app/DB.hs               | 117 ++++++------
 app/Html.hs             | 110 +++++------
 app/Main.hs             | 121 ++++++------
 app/Routes.hs           |  57 +++---
 fedi.cabal              |   4 +-
 fourmolu.yaml           |  16 ++
 src/Fedi.hs             |   4 +-
 src/Fedi/Activity.hs    | 168 -----------------
 src/Fedi/Actor.hs       |  80 --------
 src/Fedi/Helpers.hs     | 153 +++++++++++++++
 src/Fedi/Routes.hs      | 107 +++++++----
 src/Fedi/Types.hs       | 398 ++++++++++++++++++++++++++++++++++++----
 src/Fedi/UserDetails.hs |  46 +++++
 src/Fedi/Webfinger.hs   |  63 ++++---
 15 files changed, 897 insertions(+), 550 deletions(-)
 create mode 100644 fourmolu.yaml
 delete mode 100644 src/Fedi/Activity.hs
 delete mode 100644 src/Fedi/Actor.hs
 create mode 100644 src/Fedi/Helpers.hs
 create mode 100644 src/Fedi/UserDetails.hs

diff --git a/app/Css.hs b/app/Css.hs
index 2e275cd..10c77ae 100644
--- a/app/Css.hs
+++ b/app/Css.hs
@@ -4,7 +4,8 @@ import Data.Text qualified as T
 import Text.RawString.QQ
 
 css :: T.Text
-css = [r|
+css =
+  [r|
 body {
   margin: 40px auto;
   max-width: 650px;
diff --git a/app/DB.hs b/app/DB.hs
index 86302e3..03b415d 100644
--- a/app/DB.hs
+++ b/app/DB.hs
@@ -1,53 +1,56 @@
 -- | 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
-import Text.RawString.QQ
 import Fedi
+import GHC.Stack (HasCallStack)
+import Text.RawString.QQ
 
 -----------------------
+
 -- * Database handler API
 
 data DB
   = DB
-    { getNotes :: IO [Note]
-    , getNote :: DB.Int64 -> IO (Maybe Note)
-    , insertNote :: NoteEntry -> IO NoteId
-    }
+  { getNotes :: IO [Note]
+  , getNote :: DB.Int64 -> IO (Maybe Note)
+  , insertNote :: NoteEntry -> IO ObjectId
+  }
 
 -- * Data types
 
 data NoteEntry
   = NoteEntry
-    { inReplyTo :: Maybe Url
-    , content :: T.Text
-    , name :: Maybe String
-    , url :: Maybe Url
-    }
+  { inReplyTo :: Maybe Url
+  , content :: T.Text
+  , name :: Maybe String
+  , url :: Maybe Url
+  }
 
 -----------------------
+
 -- * Handler smart constructor
 
 mkDB :: DB.ConnectionString -> UserDetails -> IO DB
 mkDB connstr details = do
   pool <- DB.createSqlitePool connstr
   DB.withPool pool runMigrations
-  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)
-    }
+  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)
+      }
 
 -----------------------
+
 -- * Database migrations
 
-runMigrations :: HasCallStack => DB.SQLite ()
+runMigrations :: (HasCallStack) => DB.SQLite ()
 runMigrations = DB.migrate migrations migrateUp migrateDown
 
 migrations :: [DB.MigrationName]
@@ -55,11 +58,12 @@ migrations =
   [ "note"
   ]
 
-migrateUp :: HasCallStack => DB.MigrationName -> DB.SQLite ()
+migrateUp :: (HasCallStack) => DB.MigrationName -> DB.SQLite ()
 migrateUp = \case
   "note" -> do
-    [] <- DB.run
-      [r| create table note(
+    [] <-
+      DB.run
+        [r| create table note(
           id integer primary key autoincrement,
           published datetime default (datetime('now')),
           actor text not null,
@@ -71,10 +75,9 @@ migrateUp = \case
       |]
 
     pure ()
-
   name -> error $ "unexpected migration: " <> show name
 
-migrateDown :: HasCallStack => DB.MigrationName -> DB.SQLite ()
+migrateDown :: (HasCallStack) => DB.MigrationName -> DB.SQLite ()
 migrateDown = \case
   "notes" -> do
     [] <- DB.run "DROP TABLE note"
@@ -82,6 +85,7 @@ migrateDown = \case
   name -> error $ "unexpected migration: " <> show name
 
 -----------------------
+
 -- * Database actions
 
 getNotesFromDb :: Url -> DB.SQLite [Note]
@@ -93,7 +97,7 @@ getNoteFromDb noteid url = do
   n <- map decodeNoteRow <$> uncurry DB.runWith (getNoteSQL noteid url)
   pure (listToMaybe n)
 
-insertNoteToDb :: Url -> NoteEntry -> DB.SQLite NoteId
+insertNoteToDb :: Url -> NoteEntry -> DB.SQLite ObjectId
 insertNoteToDb actor note = do
   [n] <- map decodeNoteIdRow <$> uncurry DB.runWith (insertNoteSQL actor note)
   pure n
@@ -143,7 +147,8 @@ insertNoteSQL actor note =
       VALUES (?, ?, ?, ?, ?)
       RETURNING cast(id as text)
     |]
-  , [ DB.SQLText (T.pack actor)
+  ,
+    [ DB.SQLText (T.pack actor)
     , toNullableString note.inReplyTo
     , DB.SQLText note.content
     , toNullableString note.name
@@ -152,39 +157,47 @@ insertNoteSQL actor note =
   )
 
 -----------------------
+
 -- ** Decode row
 
 decodeNoteRow :: [DB.SQLData] -> Note
 decodeNoteRow = \case
-  [ DB.SQLText noteid,
-    DB.SQLText published,
-    DB.SQLText actor,
-    DB.SQLText content,
-    nullableString -> Just name,
-    nullableString -> Just inReplyTo,
-    nullableString -> Just url
+  [ DB.SQLText noteid
+    , DB.SQLText published
+    , DB.SQLText actor
+    , DB.SQLText content
+    , nullableString -> Just name
+    , nullableString -> Just inReplyTo
+    , nullableString -> Just url
     ] ->
-      Note
-        { id = T.unpack noteid
-        , published = read (T.unpack published)
-        , actor = T.unpack actor
-        , inReplyTo = inReplyTo
-        , content = content
-        , url = url
-        , name = name
-        , replies = Collection
-          { id = T.unpack noteid <> "/replies"
-          , summary = "Replies"
-          , items = []
-          , first = Nothing
-          , last = Nothing
+      let
+        emptyNote = emptyUserNote $ T.unpack actor
+      in
+        emptyNote
+          { id = Just $ ObjectId $ T.unpack noteid
+          , published = Just $ read (T.unpack published)
+          , attributedTo = Just $ LLink $ Link $ T.unpack actor
+          , inReplyTo = LLink . Link <$> inReplyTo
+          , content = Just content
+          , url = url
+          , name = StringName <$> name
+          , otype =
+              emptyNote.otype
+                { likes =
+                    emptyNote.otype.likes
+                      { id = Just $ ObjectId $ T.unpack noteid <> "/likes"
+                      }
+                , shares =
+                    emptyNote.otype.shares
+                      { id = Just $ ObjectId $ T.unpack noteid <> "/shares"
+                      }
+                }
           }
-        }
   row -> error $ "Couldn't decode row as Note: " <> show row
 
-decodeNoteIdRow :: [DB.SQLData] -> NoteId
+decodeNoteIdRow :: [DB.SQLData] -> ObjectId
 decodeNoteIdRow = \case
-  [ DB.SQLText noteid] -> T.unpack noteid
+  [DB.SQLText noteid] -> ObjectId $ T.unpack noteid
   row -> error $ "Couldn't decode row as NoteId: " <> show row
 
 nullableString :: DB.SQLData -> Maybe (Maybe String)
diff --git a/app/Html.hs b/app/Html.hs
index 2789832..e6037db 100644
--- a/app/Html.hs
+++ b/app/Html.hs
@@ -1,12 +1,11 @@
 module Html where
 
-import Data.String (fromString)
-import Data.Char (ord, isAlpha)
-import Data.Text qualified as T
-import Lucid qualified as H
-
-import Fedi qualified as Fedi
 import Css (css)
+import Data.Char (isAlpha, ord)
+import Data.String (fromString)
+import Data.Text qualified as T
+import Fedi qualified as Fedi
+import Lucid qualified as H
 
 -- * HTML
 
@@ -15,69 +14,69 @@ type Html = H.Html ()
 adminPage :: Fedi.UserDetails -> [Fedi.Note] -> Html
 adminPage details notes =
   template (T.pack $ Fedi.fullmention details) do
-  userHtml details
-  newNoteHtml details
-  notesHtml notes
+    userHtml details
+    newNoteHtml details
+    notesHtml notes
 
 actorPage :: Fedi.UserDetails -> [Fedi.Note] -> Html
 actorPage details notes =
   template (T.pack $ Fedi.fullmention details) do
-  userHtml details
-  notesHtml notes
+    userHtml details
+    notesHtml notes
 
 -- | HTML boilerplate template
 template :: T.Text -> Html -> Html
 template title content =
   H.doctypehtml_ $ do
     H.head_ $ do
-      H.meta_ [ H.charset_ "utf-8" ]
-      H.meta_ [ H.name_ "viewport", H.content_ "width=device-width initial_scale=1.0" ]
+      H.meta_ [H.charset_ "utf-8"]
+      H.meta_ [H.name_ "viewport", H.content_ "width=device-width initial_scale=1.0"]
       H.title_ (H.toHtml $ "Fediserve - " <> title)
       H.style_ css
     H.body_ $ do
-      H.div_ [ H.class_ "main" ] $ do
+      H.div_ [H.class_ "main"] $ do
         content
       H.footer_ ""
 
 userHtml :: Fedi.UserDetails -> Html
 userHtml details = do
-  H.div_ [ H.class_ "user-details" ] do
-    H.a_ [ H.href_ (T.pack $ "/" <> details.username) ] $
-      H.img_ [ H.class_ "avatar", H.src_ (T.pack details.icon) ]
-    H.div_ [ H.class_ "user-details-details" ] do
+  H.div_ [H.class_ "user-details"] do
+    H.a_ [H.href_ (T.pack $ "/" <> details.username)] $
+      H.img_ [H.class_ "avatar", H.src_ (T.pack details.icon)]
+    H.div_ [H.class_ "user-details-details"] do
       H.h2_ (fromString details.username)
-      H.a_ [ H.href_ (T.pack $ Fedi.actorUrl details) ] $
+      H.a_ [H.href_ (T.pack $ Fedi.actorUrl details)] $
         H.p_ (fromString $ Fedi.fullmention details)
       H.p_ (fromString details.summary)
 
 notesHtml :: [Fedi.Note] -> Html
 notesHtml notes = do
-  H.div_ [ H.class_ "notes" ] $ mapM_ noteHtml notes
+  H.div_ [H.class_ "notes"] $ mapM_ noteHtml notes
 
 -- | A single post as HTML.
 noteHtml :: Fedi.Note -> Html
 noteHtml note = do
-  H.div_ [ H.class_ "note" ] $ do
-    H.div_ [ H.class_ "note-header" ] $ do
+  H.div_ [H.class_ "note"] $ do
+    H.div_ [H.class_ "note-header"] $ do
       case note.name of
-        Just title ->
-          H.h2_ [ H.class_ (checkDirection $ T.pack title) ] (fromString title)
-        Nothing -> pure ()
+        Just (Fedi.StringName title) ->
+          H.h2_ [H.class_ (checkDirection $ T.pack title)] (fromString title)
+        _ -> pure ()
 
       case note.url of
         Just url ->
-          H.p_ $ H.a_ [ H.href_ (T.pack url) ] $ fromString url
+          H.p_ $ H.a_ [H.href_ (T.pack url)] $ fromString url
         Nothing -> pure ()
 
       H.a_
-        [ H.href_ (T.pack note.id)
+        [ H.href_ (T.pack (maybe "" (\i -> i.unwrap) note.id))
         , H.class_ "note-time"
         , H.title_ "See note page"
         ]
         (H.toHtml (T.pack (show note.published)))
 
-    H.div_ [H.class_ $ "note-content " <> checkDirection note.content] $ do
-      H.toHtmlRaw note.content
+    H.div_ [H.class_ $ "note-content " <> checkDirection (maybe "" id note.content)] $ do
+      H.toHtmlRaw (maybe "" id note.content)
 
 checkDirection :: T.Text -> T.Text
 checkDirection txt =
@@ -95,31 +94,36 @@ newNoteHtml details = do
     , H.class_ "new-note"
     ]
     ( do
-      H.div_ [ H.class_ "new-note-div" ] $ H.input_
-        [ H.class_ "new-note-text"
-        , H.autofocus_
-        , H.type_ "text"
-        , H.name_ "title"
-        , H.placeholder_ "A title (optional)"
-        ]
+        H.div_ [H.class_ "new-note-div"] $
+          H.input_
+            [ H.class_ "new-note-text"
+            , H.autofocus_
+            , H.type_ "text"
+            , H.name_ "title"
+            , H.placeholder_ "A title (optional)"
+            ]
 
-      H.div_ [ H.class_ "new-note-div" ] $ H.textarea_
-        [ H.class_ "new-note-content"
-        , H.name_ "content"
-        , H.placeholder_ "Yes?"
-        ] ""
+        H.div_ [H.class_ "new-note-div"] $
+          H.textarea_
+            [ H.class_ "new-note-content"
+            , H.name_ "content"
+            , H.placeholder_ "Yes?"
+            ]
+            ""
 
-      H.div_ [ H.class_ "new-note-div" ] $ H.input_
-        [ H.class_ "new-note-text"
-        , H.type_ "url"
-        , H.name_ "url"
-        , H.placeholder_ "A URL this note should link to (optional)"
-        ]
+        H.div_ [H.class_ "new-note-div"] $
+          H.input_
+            [ H.class_ "new-note-text"
+            , H.type_ "url"
+            , H.name_ "url"
+            , H.placeholder_ "A URL this note should link to (optional)"
+            ]
 
-      H.div_ [ H.class_ "new-note-div" ] $ H.input_
-        [ H.class_ "new-note-submit"
-        , H.type_ "submit"
-        , H.title_ "Add a new note"
-        , H.value_ "Post"
-        ]
+        H.div_ [H.class_ "new-note-div"] $
+          H.input_
+            [ H.class_ "new-note-submit"
+            , H.type_ "submit"
+            , H.title_ "Add a new note"
+            , H.value_ "Post"
+            ]
     )
diff --git a/app/Main.hs b/app/Main.hs
index 7afa3fc..c00b36a 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,23 +1,21 @@
 module Main where
 
+import DB
+import Data.Aeson qualified as A
+import Data.Functor ((<&>))
 import Data.SecureMem (secureMemFromByteString)
 import Data.String (fromString)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as T
+import Data.Text.IO qualified as T
 import Database.Sqlite.Easy qualified as Sqlite
-import Data.Aeson qualified as A
-import Network.Wai.Handler.Warp (run, Port)
-import Network.Wai.Middleware.Routed qualified as Wai
+import Network.Wai.Handler.Warp (Port, run)
 import Network.Wai.Middleware.HttpAuth (basicAuth)
 import Network.Wai.Middleware.RequestLogger qualified as Logger
-import System.Environment (getArgs)
-import System.Environment (lookupEnv)
-import Web.Twain qualified as Twain
-import Data.Functor ((<&>))
-import qualified Data.Text.Encoding as T
-import qualified Data.Text.IO as T
-import qualified Data.Text as T
-
-import DB
+import Network.Wai.Middleware.Routed qualified as Wai
 import Routes
+import System.Environment (getArgs, lookupEnv)
+import Web.Twain qualified as Twain
 
 data Command
   = Serve
@@ -25,10 +23,11 @@ data Command
 
 main :: IO ()
 main = do
-  command <- getArgs >>= \case
-    ["insert", file] -> pure (Insert file)
-    ["serve"] -> pure Serve
-    _ -> usageError
+  command <-
+    getArgs >>= \case
+      ["insert", file] -> pure (Insert file)
+      ["serve"] -> pure Serve
+      _ -> usageError
 
   case command of
     Insert file -> do
@@ -41,25 +40,28 @@ insertNoteFromFile file = do
   connStr <- maybe "/tmp/fediserve_sqlite_db.sqlite" fromString <$> lookupEnv "FEDI_CONN_STRING"
   content <- T.readFile file
 
-  detailsFile <- lookupEnv "FEDI_DETAILS"
-    <&> maybe (error "missing FEDI_DETAILS") id
+  detailsFile <-
+    lookupEnv "FEDI_DETAILS"
+      <&> maybe (error "missing FEDI_DETAILS") id
 
-  details <- A.eitherDecodeFileStrict detailsFile
-    <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
+  details <-
+    A.eitherDecodeFileStrict detailsFile
+      <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
 
   db <- mkDB connStr details
 
-  note <- db.insertNote NoteEntry
-    { content = content
-    , inReplyTo = Nothing
-    , name = Nothing
-    , url = Nothing
-    }
+  note <-
+    db.insertNote
+      NoteEntry
+        { content = content
+        , inReplyTo = Nothing
+        , name = Nothing
+        , url = Nothing
+        }
 
   putStrLn "Inserted."
   print note
 
-
 serve :: IO ()
 serve = do
   auth <- fmap (T.splitOn "," . T.pack) <$> lookupEnv "FEDI_AUTH"
@@ -73,13 +75,15 @@ serve = do
         let
           username = secureMemFromByteString $ T.encodeUtf8 user
           password = secureMemFromByteString $ T.encodeUtf8 pass
-        pure $ basicAuth
-          ( \u p -> pure $
-            secureMemFromByteString u == username
-            && secureMemFromByteString p == password
-          )
-          "My Fediserve"
-      Just{} -> usageError
+        pure $
+          basicAuth
+            ( \u p ->
+                pure $
+                  secureMemFromByteString u == username
+                    && secureMemFromByteString p == password
+            )
+            "My Fediserve"
+      Just {} -> usageError
 
   fediPort <- maybe 3001 read <$> lookupEnv "FEDI_PORT"
   conn <- maybe "/tmp/fediserve_sqlite_db.sqlite" fromString <$> lookupEnv "FEDI_CONN_STRING"
@@ -89,41 +93,46 @@ serve = do
 
 usageError :: err
 usageError =
-  errorWithoutStackTrace $ unlines
-    [ "Usage: fedi [ insert <FILE> | serve ]"
-    , "Env vars:"
-    , " - FEDI_PORT=<PORT>"
-    , " - FEDI_DETAILS=<FILE>"
-    , " - FEDI_CONN_STRING=<SQLITE_CONN_STR>"
-    , " - FEDI_AUTH=<user>,<password>"
-    ]
+  errorWithoutStackTrace $
+    unlines
+      [ "Usage: fedi [ insert <FILE> | serve ]"
+      , "Env vars:"
+      , " - FEDI_PORT=<PORT>"
+      , " - FEDI_DETAILS=<FILE>"
+      , " - FEDI_CONN_STRING=<SQLITE_CONN_STR>"
+      , " - FEDI_AUTH=<user>,<password>"
+      ]
 
 -- | Run server at at specific port.
 runServer :: Port -> Twain.Middleware -> Twain.Application -> IO ()
 runServer port authMiddleware app = do
-  putStrLn $ unwords
-    [ "Running fedi at"
-    , "http://localhost:" <> show port
-    , "(ctrl-c to quit)"
-    ]
+  putStrLn $
+    unwords
+      [ "Running fedi at"
+      , "http://localhost:" <> show port
+      , "(ctrl-c to quit)"
+      ]
   auth <- Wai.routedMiddleware matchAdmin <$> pure authMiddleware
   run port (Logger.logStdoutDev $ auth app)
 
-
 matchAdmin :: [T.Text] -> Bool
-matchAdmin = any (=="admin")
+matchAdmin = any (== "admin")
 
 -- | Application description.
 mkFediApp :: Sqlite.ConnectionString -> IO Twain.Application
 mkFediApp connStr = do
-  detailsFile <- lookupEnv "FEDI_DETAILS"
-    <&> maybe (error "missing FEDI_DETAILS") id
+  detailsFile <-
+    lookupEnv "FEDI_DETAILS"
+      <&> maybe (error "missing FEDI_DETAILS") id
 
-  details <- A.eitherDecodeFileStrict detailsFile
-    <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
+  details <-
+    A.eitherDecodeFileStrict detailsFile
+      <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
 
   db <- mkDB connStr details
 
-  pure $ foldr ($)
-    (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
-    (routes db detailsFile)
+  pure $
+    foldr
+      ($)
+      (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
+      (routes db detailsFile)
diff --git a/app/Routes.hs b/app/Routes.hs
index 8fbfcdc..17e9cb0 100644
--- a/app/Routes.hs
+++ b/app/Routes.hs
@@ -1,17 +1,16 @@
 module Routes where
 
+import Control.Monad.IO.Class (liftIO)
+import DB
+import Data.Aeson qualified as A
+import Data.Functor ((<&>))
 import Data.Maybe (maybeToList)
 import Data.String (fromString)
-import Data.Aeson qualified as A
-import Web.Twain qualified as Twain
 import Fedi qualified as Fedi
-import Data.Functor ((<&>))
-import System.IO.Unsafe (unsafePerformIO)
-import Control.Monad.IO.Class (liftIO)
-import Lucid qualified as H
-
 import Html
-import DB
+import Lucid qualified as H
+import System.IO.Unsafe (unsafePerformIO)
+import Web.Twain qualified as Twain
 
 routes :: DB -> FilePath -> [Twain.Middleware]
 routes db detailsFile =
@@ -26,20 +25,17 @@ routes db detailsFile =
           details <- liftIO $ fetchUserDetails detailsFile
           notes <- liftIO db.getNotes
           Twain.send $ Twain.html $ H.renderBS $ actorPage details notes
-
   , -- Match outbox
     Twain.get (Fedi.matchOutbox $ unsafePerformIO $ fetchUserDetails detailsFile) do
       details <- liftIO $ fetchUserDetails detailsFile
-      notes <- map noteToCreate <$> liftIO db.getNotes
+      notes <- map (Fedi.ActivityCreate . noteToCreate) <$> liftIO db.getNotes
       Fedi.handleOutbox details notes
-
   , -- Match Create object
-    Twain.get (Fedi.matchCreate $ unsafePerformIO $ fetchUserDetails detailsFile) do
+    Twain.get (Fedi.matchCreateNote $ unsafePerformIO $ fetchUserDetails detailsFile) do
       details <- liftIO $ fetchUserDetails detailsFile
       notes <- map noteToCreate <$> liftIO db.getNotes
 
-      Fedi.handleCreate details notes
-
+      Fedi.handleCreateNote details notes
   , -- Match Note object
     Twain.get (Fedi.matchNote $ unsafePerformIO $ fetchUserDetails detailsFile) do
       details <- liftIO $ fetchUserDetails detailsFile
@@ -55,18 +51,15 @@ routes db detailsFile =
             Nothing -> Twain.next
             Just thenote ->
               Twain.send $ Twain.html $ H.renderBS $ actorPage details [thenote]
-
   , -- Match webfinger
     Twain.get Fedi.matchWebfinger do
-    details <- liftIO $ fetchUserDetails detailsFile
-    Fedi.handleWebfinger details
-
+      details <- liftIO $ fetchUserDetails detailsFile
+      Fedi.handleWebfinger details
   , -- Admin page
     Twain.get (fromString $ "/" <> (unsafePerformIO $ fetchUserDetails detailsFile).username <> "/admin") do
       details <- liftIO $ fetchUserDetails detailsFile
       notes <- liftIO db.getNotes
       Twain.send $ Twain.html $ H.renderBS $ adminPage details notes
-
   , -- New post
     Twain.post (fromString $ "/" <> (unsafePerformIO $ fetchUserDetails detailsFile).username <> "/admin/new") do
       title <- Twain.param "title"
@@ -75,14 +68,16 @@ routes db detailsFile =
       details <- liftIO $ fetchUserDetails detailsFile
 
       noteid <-
-        liftIO $ db.insertNote NoteEntry
-          { content = content
-          , inReplyTo = Nothing
-          , name = if trim title == "" then Nothing else Just title
-          , url = if trim url == "" then Nothing else Just url
-          }
+        liftIO $
+          db.insertNote
+            NoteEntry
+              { content = content
+              , inReplyTo = Nothing
+              , name = if trim title == "" then Nothing else Just title
+              , url = if trim url == "" then Nothing else Just url
+              }
 
-      Twain.send $ Twain.redirect302 (fromString ("/" <> details.username <> "/notes/" <> noteid))
+      Twain.send $ Twain.redirect302 (fromString ("/" <> details.username <> "/notes/" <> noteid.unwrap))
   ]
 
 trim :: String -> String
@@ -93,11 +88,5 @@ fetchUserDetails detailsFile =
   A.eitherDecodeFileStrict detailsFile
     <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
 
-noteToCreate :: Fedi.Note -> Fedi.Activity
-noteToCreate note =
-    Fedi.Create
-      { id =
-        note.id <> "/create"
-      , actor = note.actor
-      , object = Fedi.NoteObject note
-      }
+noteToCreate :: Fedi.Note -> Fedi.Create
+noteToCreate note = Fedi.makeCreateNote note
diff --git a/fedi.cabal b/fedi.cabal
index a3d2efc..9798bbd 100644
--- a/fedi.cabal
+++ b/fedi.cabal
@@ -17,10 +17,10 @@ library
   import: warnings
   exposed-modules:
     Fedi
-    Fedi.Activity
-    Fedi.Actor
+    Fedi.Helpers
     Fedi.Routes
     Fedi.Types
+    Fedi.UserDetails
     Fedi.Webfinger
   -- other-modules:
   -- other-extensions:
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..685d4e3
--- /dev/null
+++ b/fourmolu.yaml
@@ -0,0 +1,16 @@
+indentation: 2
+column-limit: 150
+function-arrows: leading
+comma-style: leading
+import-export-style: diff-friendly
+indent-wheres: true
+record-brace-space: true
+newlines-between-decls: 1
+haddock-style: single-line
+haddock-style-module: single-line
+let-style: newline
+in-style: left-align
+single-constraint-parens: always
+unicode: never
+respectful: false
+fixities: []
diff --git a/src/Fedi.hs b/src/Fedi.hs
index 50d52ea..4d42414 100644
--- a/src/Fedi.hs
+++ b/src/Fedi.hs
@@ -1,7 +1,7 @@
 module Fedi (module Export) where
 
-import Fedi.Activity as Export
-import Fedi.Actor as Export
+import Fedi.Helpers as Export
 import Fedi.Routes as Export
 import Fedi.Types as Export
+import Fedi.UserDetails as Export
 import Fedi.Webfinger as Export
diff --git a/src/Fedi/Activity.hs b/src/Fedi/Activity.hs
deleted file mode 100644
index fc5a8ed..0000000
--- a/src/Fedi/Activity.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-module Fedi.Activity where
-
-import Data.Aeson qualified as A
-import Data.Text qualified as T
-import Fedi.Types
-import Fedi.Actor
-import Data.Time (UTCTime)
-
-data Activity
-  = Create
-    { id :: ActivityUrl
-    , actor :: ActorId
-    , object :: Object
-    }
-  deriving Show
-
-activityUrl :: Activity -> ActivityUrl
-activityUrl = \case
-  create@Create{} -> create.id
-
-type ActivityUrl = Url
-
-data Object
-  = NoteObject Note
-  deriving Show
-
-objectUrl :: Object -> Url
-objectUrl = \case
-  NoteObject note -> note.id
-
-data Note
-  = Note
-    { id :: NoteId
-    , published :: UTCTime
-    , inReplyTo :: Maybe Url
-    , actor :: ActorId
-    , content :: T.Text
-    , name :: Maybe String
-    , url :: Maybe Url
-    , replies :: Collection Unordered Note
-    }
-  deriving Show
-
-type NoteId = Url
-
-type Followers = [Actor]
-type Following = [Actor]
-
-type Inbox = Collection Ordered Activity
-type Outbox = Collection Ordered Activity
-type OutboxPage = OrderedCollectionPage Activity
-
-data Ordered
-data Unordered
-
-data OrderedCollectionPage a
-  = OrderedCollectionPage
-    { id :: Url
-    , partOf :: Url
-    , orderedItems :: [a]
-    }
-  deriving Show
-
-data Collection order a
-  = Collection
-    { id :: Url
-    , summary :: String
-    , items :: [a]
-    , first :: Maybe Url
-    , last :: Maybe Url
-    }
-  deriving Show
-
-instance A.ToJSON Note where
-  toJSON note =
-    A.object $
-        [ "@context" A..=
-          ( "https://www.w3.org/ns/activitystreams" :: String
-          )
-        , "id" A..= note.id
-        , "type" A..= ("Note" :: String)
-        , "summary" A..= (Nothing :: Maybe String)
-        , "inReplyTo" A..= note.inReplyTo
-        , "published" A..= note.published
-        , "attributedTo" A..= note.actor
-        , "content" A..= note.content
-        , "name" A..= note.name
-        , "replies" A..= note.replies
-        , "sensitive" A..= False
-        , "tag" A..= ([] :: [String])
-
-        , "to" A..= [
-            "https://www.w3.org/ns/activitystreams#Public" :: String
-          ]
-        , "cc" A..= [
-            note.actor <> "/followers" :: String
-          ]
-        , "likes" A..=
-          ( Collection
-            { id = note.id <> "/likes"
-            , summary = "likes"
-            , items = []
-            , first = Nothing
-            , last = Nothing
-            } :: Collection Unordered Activity
-          )
-        , "shares" A..= (Nothing :: Maybe String)
-        ]
-        <> [ "name" A..= name | Just name <- [note.name] ]
-        <> [ "url" A..= url | Just url <- [note.url] ]
-
-instance A.ToJSON Object where
-  toJSON = \case
-    NoteObject note -> A.toJSON note
-
-instance A.ToJSON Activity where
-  toJSON = \case
-    create@Create{} ->
-      A.object
-        [ "@context" A..=
-          ( "https://www.w3.org/ns/activitystreams" :: String
-          )
-        , "type" A..= ("Create" :: String)
-        , "id" A..= create.id
-        , "actor" A..= create.actor
-        , "object" A..= create.object
-        ]
-
-instance A.ToJSON a => A.ToJSON (Collection Ordered a) where
-  toJSON collection =
-    A.object
-      [ "@context" A..=
-        ( "https://www.w3.org/ns/activitystreams" :: String
-        )
-      , "id" A..= collection.id
-      , "type" A..= ("OrderedCollection" :: String)
-      , "summary" A..= collection.summary
-      , "totalItems" A..= length collection.items
-      , "orderedItems" A..= collection.items
-      , "first" A..= collection.first
-      , "last" A..= collection.last
-      ]
-
-instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
-  toJSON collection =
-    A.object
-      [ "@context" A..=
-        ( "https://www.w3.org/ns/activitystreams" :: String
-        )
-      , "id" A..= collection.id
-      , "type" A..= ("Collection" :: String)
-      , "summary" A..= collection.summary
-      , "totalItems" A..= length collection.items
-      , "items" A..= collection.items
-      , "first" A..= collection.first
-      , "last" A..= collection.last
-      ]
-
-instance A.ToJSON a => A.ToJSON (OrderedCollectionPage a) where
-  toJSON collection =
-    A.object
-      [ "@context" A..=
-        [ "https://www.w3.org/ns/activitystreams" :: String
-        ]
-      , "type" A..= ("OrderedCollectionPage" :: String)
-      , "partOf" A..= collection.partOf
-      , "orderedItems" A..= collection.orderedItems
-      ]
diff --git a/src/Fedi/Actor.hs b/src/Fedi/Actor.hs
deleted file mode 100644
index f194043..0000000
--- a/src/Fedi/Actor.hs
+++ /dev/null
@@ -1,80 +0,0 @@
-module Fedi.Actor where
-
-import Data.Aeson qualified as A
-import Fedi.Types
-
-data Actor
-  = Actor
-    { id :: Url
-    , name :: String
-    , preferredUsername :: String
-    , summary :: String
-    , icon :: Url
-    , publicKey :: PublicKey
-    }
-  deriving Show
-
-type ActorId = Url
-
-data ActorType
-  = Person
-  deriving Show
-
-data PublicKey
-  = PublicKey
-    { id :: Url
-    , owner :: Url
-    , publicKeyPem :: Pem
-    }
-  deriving Show
-
-makeActor :: UserDetails -> Actor
-makeActor details =
-  let
-    actor = actorUrl details
-  in Actor
-    { id = actor
-    , name = details.name
-    , preferredUsername = details.username
-    , summary = details.summary
-    , icon = details.icon
-    , publicKey =
-      PublicKey
-        { id = actor <> "#main-key"
-        , owner = actor
-        , publicKeyPem = details.publicPem
-        }
-    }
-
-instance A.ToJSON Actor where
-  toJSON actor =
-    A.object
-      [ "@context" A..=
-        [ "https://www.w3.org/ns/activitystreams" :: String
-        , "https://w3id.org/security/v1"
-        ]
-      , "id" A..= actor.id
-      , "type" A..= Person
-      , "name" A..= actor.name
-      , "preferredUsername" A..= actor.preferredUsername
-      , "summary" A..= actor.summary
-      , "icon" A..= A.object
-        [ "type" A..= ("Image" :: String)
-        , "mediaType" A..= ("image/png" :: String)
-        , "url" A..= actor.icon
-        ]
-      , "inbox" A..= (actor.id <> "/inbox")
-      , "outbox" A..= (actor.id <> "/outbox")
-      , "publicKey" A..= actor.publicKey
-      ]
-
-instance A.ToJSON ActorType where
-  toJSON Person = A.String "Person"
-
-instance A.ToJSON PublicKey where
-  toJSON pk =
-    A.object
-      [ "id" A..= pk.id
-      , "owner" A..= pk.owner
-      , "publicKeyPem" A..= pk.publicKeyPem
-      ]
diff --git a/src/Fedi/Helpers.hs b/src/Fedi/Helpers.hs
new file mode 100644
index 0000000..007a6d8
--- /dev/null
+++ b/src/Fedi/Helpers.hs
@@ -0,0 +1,153 @@
+module Fedi.Helpers where
+
+import Data.Text qualified as T
+import Fedi.Types
+import Fedi.UserDetails
+
+-- | An empty activitypub Object.
+emptyObject :: Object ()
+emptyObject =
+  Object
+    { id = Nothing
+    , otype = ()
+    , content = Nothing
+    , published = Nothing
+    , replies = Nothing
+    , attachment = Nothing
+    , attributedTo = Nothing
+    , tag = Nothing
+    , to = Nothing
+    , cc = Nothing
+    , inReplyTo = Nothing
+    , url = Nothing
+    , name = Nothing
+    , icon = Nothing
+    , image = Nothing
+    , preview = Nothing
+    , summary = Nothing
+    , updated = Nothing
+    , mediaType = Nothing
+    }
+
+-- | Create an activitypub Actor.
+makeActor :: UserDetails -> Actor
+makeActor details =
+  let
+    actor = actorUrl details
+  in
+    ActorPerson $
+      emptyObject
+        { id = Just $ ObjectId actor
+        , otype =
+            TypePerson
+              { preferredUsername = details.username
+              , inbox = Link $ actor <> "/inbox"
+              , outbox = Link $ actor <> "/outbox"
+              , following = Link $ actor <> "/following"
+              , followers = Link $ actor <> "/followers"
+              , publicKey =
+                  PublicKey
+                    { pkid = actor <> "#main-key"
+                    , owner = actor
+                    , publicKeyPem = details.publicPem
+                    }
+              }
+        , url = Nothing -- details.url
+        , name = Just $ StringName details.name
+        , icon = Just $ makeImage details.icon
+        , image = Just $ makeImage details.image
+        , summary = Just $ T.pack details.summary
+        }
+
+makeCreateNote :: Note -> Create
+makeCreateNote note =
+  emptyObject
+    { id = (\oid -> ObjectId $ oid.unwrap <> "/create") <$> note.id
+    , otype =
+        TypeActivity
+          { actor = maybe (Link "") getAttributedTo note.attributedTo
+          , atype = TypeCreate note
+          , target = Nothing
+          , origin = Nothing
+          }
+    }
+
+-- | Create an user's empty 'Note'.
+emptyUserNote :: Url -> Note
+emptyUserNote actor =
+  emptyObject
+    { otype = emptyTypeNote
+    , attributedTo = Just (LLink $ Link actor)
+    , to = Just [Link "https://www.w3.org/ns/activitystreams#Public"]
+    , cc = Just [Link $ actor <> "/followers"]
+    }
+
+-- | An empty 'Note'.
+emptyTypeNote :: TypeNote
+emptyTypeNote =
+  TypeNote
+    { likes = emptyUnorderedCollection
+    , shares = emptyUnorderedCollection
+    , replies = emptyUnorderedCollection
+    , sensitive = False
+    }
+
+-- | Create an activitypub Image.
+makeImage :: Url -> Image
+makeImage link =
+  emptyObject
+    { otype = TypeImage
+    , mediaType = Just ("image/png" :: MediaType)
+    , url = Just link
+    }
+
+-- | An empty 'Collection'.
+emptyUnorderedCollection :: Collection a
+emptyUnorderedCollection =
+  emptyObject
+    { otype =
+        CollectionType
+          { ctype =
+              UnorderedCollectionType
+                { items = []
+                }
+          , first = Nothing
+          , last = Nothing
+          , current = Nothing
+          }
+    }
+
+-- | An empty 'OrderedCollection'.
+emptyOrderedCollection :: OrderedCollection a
+emptyOrderedCollection =
+  emptyObject
+    { otype =
+        CollectionType
+          { ctype =
+              OrderedCollectionType
+                { totalItems = 0
+                }
+          , first = Nothing
+          , last = Nothing
+          , current = Nothing
+          }
+    }
+
+-- | Create an empty 'OrderedCollectionPage'.
+emptyOrderedCollectionPage :: Url -> OrderedCollectionPage a
+emptyOrderedCollectionPage url =
+  emptyObject
+    { otype =
+        CollectionType
+          { ctype =
+              OrderedCollectionPageType
+                { partOf = url
+                , prev = Nothing
+                , next = Nothing
+                , orderedItems = []
+                }
+          , first = Nothing
+          , last = Nothing
+          , current = Nothing
+          }
+    }
diff --git a/src/Fedi/Routes.hs b/src/Fedi/Routes.hs
index 67c903e..383f556 100644
--- a/src/Fedi/Routes.hs
+++ b/src/Fedi/Routes.hs
@@ -1,35 +1,32 @@
 module Fedi.Routes where
 
-import Data.List (find)
-import Web.Twain qualified as Twain
-import Web.Twain.Types qualified as Twain
-import Data.String (fromString)
 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.Activity
-import Fedi.Actor
+import Fedi.UserDetails
 import Fedi.Webfinger
+import Web.Twain qualified as Twain
+import Web.Twain.Types qualified as Twain
 
 -- * Routes
 
 routes :: UserDetails -> [Twain.Middleware]
 routes details =
   [ Twain.get (matchUser details) do
-    handleUser details
-
+      handleUser details
   , Twain.get (matchOutbox details) do
-    handleOutbox details []
-
-  , Twain.get (matchCreate details) do
-    handleUser details
-
+      handleOutbox details []
+  , Twain.get (matchCreateNote details) do
+      handleCreateNote details []
   , Twain.get (matchNote details) do
-    handleUser details
+      handleNote details []
+  , -- , Twain.post (matchInbox details) do
+    --   handleInbox details undefined
 
-  , Twain.get matchWebfinger do
-    handleWebfinger details
+    Twain.get matchWebfinger do
+      handleWebfinger details
   ]
 
 jsonLD :: BSL.ByteString -> Twain.Response
@@ -40,11 +37,11 @@ jsonLD =
 
 -- * Create
 
-matchCreate :: UserDetails -> Twain.PathPattern
-matchCreate details = fromString ("/" <> details.username <> "/notes/:note_id/create")
+matchCreateNote :: UserDetails -> Twain.PathPattern
+matchCreateNote details = fromString ("/" <> details.username <> "/notes/:note_id/create")
 
-handleCreate :: UserDetails -> [Activity] -> Twain.ResponderM a
-handleCreate details items = do
+handleCreateNote :: UserDetails -> [Create] -> Twain.ResponderM a
+handleCreateNote details items = do
   noteId <- Twain.param "note_id"
   let
     createUrl =
@@ -57,7 +54,7 @@ handleCreate details items = do
         <> "/create"
   let
     content =
-      find (\create -> create.id == createUrl) items
+      find (\create -> create.id == Just (ObjectId createUrl)) items
   Twain.send $ jsonLD (A.encode content)
 
 -- * Note
@@ -78,7 +75,7 @@ handleNote details items = do
         <> noteId
   let
     content =
-      find (\note -> note.id == noteUrl) items
+      find (\note -> note.id == Just (ObjectId noteUrl)) items
   Twain.send $ jsonLD (A.encode content)
 
 -- * User
@@ -88,7 +85,8 @@ matchUser details = fromString ("/" <> details.username)
 
 handleUser :: UserDetails -> Twain.ResponderM a
 handleUser details = do
-  let content = makeActor details
+  let
+    content = makeActor details
   Twain.send $ jsonLD (A.encode content)
 
 -- * Webfinger
@@ -99,7 +97,8 @@ matchWebfinger = "/.well-known/webfinger"
 handleWebfinger :: UserDetails -> Twain.ResponderM b
 handleWebfinger details = do
   resource <- Twain.param "resource"
-  let webfinger = makeWebfinger details
+  let
+    webfinger = makeWebfinger details
   if resource == ppSubject webfinger.subject
     then do
       Twain.send $ jsonLD (A.encode webfinger)
@@ -112,7 +111,7 @@ matchOutbox :: UserDetails -> Twain.PathPattern
 matchOutbox details =
   fromString ("/" <> details.username <> "/outbox")
 
-handleOutbox :: UserDetails -> [Activity] -> Twain.ResponderM b
+handleOutbox :: UserDetails -> [AnyActivity] -> Twain.ResponderM b
 handleOutbox details items = do
   isPage <- Twain.queryParamMaybe "page"
   let
@@ -126,34 +125,62 @@ handleOutbox details items = do
       case isPage of
         Just True ->
           let
+            empty = emptyOrderedCollectionPage outboxUrl
             content :: OutboxPage
             content =
-              OrderedCollectionPage
-                { id = outboxUrl <> "?page=true"
-                , partOf = outboxUrl
-                , orderedItems = items
+              empty
+                { id = Just $ ObjectId $ outboxUrl <> "?page=true"
+                , otype =
+                    empty.otype
+                      { ctype =
+                          empty.otype.ctype
+                            { partOf = outboxUrl
+                            , orderedItems = items
+                            }
+                      }
                 }
-          in A.encode content
+          in
+            A.encode content
         _ ->
           let
             content :: Outbox
             content =
-              Collection
-                { id = outboxUrl
-                , summary = details.username <> "'s notes"
-                , items = items
-                , first = Just $ outboxUrl <> "?page=true"
-                , last = Just $ outboxUrl <> "?page=true"
+              emptyOrderedCollection
+                { id = Just $ ObjectId outboxUrl
+                , summary = Just $ fromString $ details.username <> "'s notes"
+                , otype =
+                    emptyOrderedCollection.otype
+                      { ctype =
+                          emptyOrderedCollection.otype.ctype
+                            { totalItems = fromIntegral $ length items
+                            }
+                      , first = Just $ outboxUrl <> "?page=true"
+                      , last = Just $ outboxUrl <> "?page=true"
+                      }
                 }
-          in A.encode content
+          in
+            A.encode content
   Twain.send $ jsonLD response
 
+-- * Inbox
+
+-- matchInbox :: UserDetails -> Twain.PathPattern
+-- matchInbox details =
+--   fromString ("/" <> details.username <> "/inbox")
+--
+-- handleInbox :: UserDetails -> (Activity -> Twain.ResponderM b) -> Twain.ResponderM b
+-- handleInbox _details _handle = do
+--   let response = undefined
+--   Twain.send $ jsonLD 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/activity+json" `BS.isInfixOf` bs)
-           && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs)
-         )
+        || ( ("application/activity+json" `BS.isInfixOf` bs)
+              && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs)
+           )
     Nothing -> False
diff --git a/src/Fedi/Types.hs b/src/Fedi/Types.hs
index c77ae79..42ac98e 100644
--- a/src/Fedi/Types.hs
+++ b/src/Fedi/Types.hs
@@ -1,48 +1,380 @@
 module Fedi.Types where
 
-import GHC.Generics (Generic)
 import Data.Aeson qualified as A
+import Data.Aeson.Types qualified as A
 import Data.Text qualified as T
+import Fedi.UserDetails
 
-data Rel = Self
-  deriving Show
+-- | An Object is what everything is here.
+-- <https://www.w3.org/TR/activitystreams-vocabulary/#object-types>
+data Object typ
+  = Object
+  { id :: Maybe ObjectId
+  , otype :: typ
+  , content :: Maybe Content
+  , published :: Maybe UTCTime
+  , replies :: Maybe [Link]
+  , attachment :: Maybe [AnyMedia]
+  , attributedTo :: Maybe (LinkOrObject Actor)
+  , -- , audience :: Maybe String
+    tag :: Maybe [Tag]
+  , to :: Maybe [Link]
+  , cc :: Maybe [Link]
+  , inReplyTo :: Maybe (LinkOrObject Actor)
+  , url :: Maybe Url -- revisit
+  , name :: Maybe Name
+  , icon :: Maybe Image
+  , image :: Maybe Image
+  , preview :: Maybe Preview
+  , summary :: Maybe T.Text
+  , updated :: Maybe UTCTime
+  , -- , bto :: Maybe String
+    -- , bcc :: Maybe String
+    mediaType :: Maybe MediaType
+    -- , duration  :: Maybe String
+  }
+  deriving (Show)
 
-instance A.ToJSON Rel where
-  toJSON Self = A.String "self"
+class ToObject a where
+  toObject :: a -> [A.Pair]
 
+instance (ToObject a) => A.ToJSON (Object a) where
+  toJSON = A.object . toObject
 
-data LinkType = ActivityJson
-  deriving Show
+instance (ToObject a) => ToObject (Object a) where
+  toObject object =
+    [ "@context"
+        A..= ("https://www.w3.org/ns/activitystreams" :: String)
+    ]
+      <> toObject object.otype
+      <> [ assignment
+         | Just assignment <-
+            [ fmap ("id" A..=) object.id
+            , fmap ("content" A..=) object.content
+            , fmap ("attachement" A..=) object.attachment
+            , fmap ("attributedTo" A..=) object.attributedTo
+            , fmap ("published" A..=) object.published
+            , fmap ("inReplyTo" A..=) object.inReplyTo
+            , fmap ("url" A..=) object.url
+            , fmap ("name" A..=) object.name
+            , fmap ("icon" A..=) object.icon
+            , fmap ("image" A..=) object.image
+            , -- , fmap ("preview" A..=  ) object.preview
+              fmap ("summary" A..=) object.summary
+            , fmap ("updated" A..=) object.updated
+            , fmap ("mediaType" A..=) object.mediaType
+            , fmap ("to" A..=) object.to
+            , fmap ("cc" A..=) object.cc
+            , fmap ("replies" A..=) object.replies
+            ]
+         ]
 
-instance A.ToJSON LinkType where
-  toJSON ActivityJson = A.String "application/activity+json"
+newtype ObjectId = ObjectId {unwrap :: String}
+  deriving (Show, Eq, A.FromJSON, A.ToJSON) via String
 
-type Url = String
-type Domain = String
-type Username = String
+newtype Link = Link {unwrap :: Url}
+  deriving (Show, A.FromJSON, A.ToJSON) via Url
 
-newtype Pem = Pem T.Text
-  deriving Show
-  deriving A.FromJSON via T.Text
+data LinkOrObject a
+  = LLink Link
+  | OObject (Object a)
+  | CCollection [LinkOrObject a]
+  deriving (Show)
 
-instance A.ToJSON Pem where
-  toJSON (Pem pem) = A.String pem
+getAttributedTo :: LinkOrObject a -> Link
+getAttributedTo = \case
+  LLink link -> link
+  OObject obj -> Link (maybe (ObjectId "") id obj.id).unwrap
+  CCollection list ->
+    maybe (Link "") getAttributedTo (listToMaybe list)
 
-data UserDetails
-  = UserDetails
-    { domain :: Domain
-    , username :: String
-    , name :: String
-    , summary :: String
-    , icon :: Url
-    , publicPem :: Pem
-    , privatePem :: FilePath
-    }
-  deriving (Show, Generic, A.FromJSON)
+instance (ToObject o) => A.ToJSON (LinkOrObject o) where
+  toJSON = \case
+    LLink link -> A.toJSON link
+    OObject ob -> A.toJSON ob
+    CCollection loos -> A.toJSON loos
 
-actorUrl :: UserDetails -> Url
-actorUrl details =
-  "https://" <> details.domain <> "/" <> details.username
+data AnyMedia
+  = ImageMedia Image
+  deriving (Show)
 
-fullmention :: UserDetails -> String
-fullmention details = "@" <> details.username <> "@" <> details.domain
+instance A.ToJSON AnyMedia where
+  toJSON = \case
+    ImageMedia obj -> A.toJSON obj
+
+type Image = Object TypeImage
+
+data TypeImage = TypeImage deriving (Show)
+
+instance ToObject TypeImage where
+  toObject TypeImage =
+    ["type" A..= ("Image" :: String)]
+
+data Name
+  = StringName String
+  | ObjectName (LinkOrObject Actor)
+  deriving (Show)
+
+instance A.ToJSON Name where
+  toJSON = \case
+    StringName str -> A.toJSON str
+    ObjectName loo -> A.toJSON loo
+
+type Content = T.Text
+
+type MediaType = String
+
+-- | A Note is an object that has the type 'Note'.
+type Note = Object TypeNote
+
+data TypeNote
+  = TypeNote
+  { likes :: Collection Like
+  , shares :: Collection Share
+  , replies :: Collection Note
+  , sensitive :: Bool
+  }
+  deriving (Show)
+
+instance ToObject TypeNote where
+  toObject note =
+    [ "type" A..= ("Note" :: String)
+    , "likes" A..= note.likes
+    , "shares" A..= note.shares
+    , "sensitive" A..= note.sensitive
+    ]
+
+type Tag = Object TypeTag
+
+data TypeTag
+  = TypeTag
+  { href :: Url
+  }
+  deriving (Show)
+
+type Preview = Object TypePreview
+
+data TypePreview = TypePreview
+  deriving (Show)
+
+type Share = Object TypeShare
+
+data TypeShare = TypeShare deriving (Show)
+
+instance ToObject TypeShare where
+  toObject TypeShare =
+    [ "type" A..= ("Share" :: String)
+    ]
+
+-- * Activities
+
+-- | An Activity is a superset of an Object with one of the following types,
+-- <https://www.w3.org/TR/activitystreams-vocabulary/#activity-types>
+-- and some additional fields.
+type Activity t = Object (TypeActivity t)
+
+data TypeActivity t
+  = TypeActivity
+  { actor :: Link
+  , atype :: t
+  , target :: Maybe AnyActivity
+  , origin :: Maybe AnyActivity
+  -- , result :: Maybe String
+  -- , instrument :: Maybe String
+  }
+  deriving (Show)
+
+instance (ToObject t) => ToObject (TypeActivity t) where
+  toObject activity =
+    [ "actor" A..= activity.actor
+    ]
+      <> [ pair
+         | Just pair <-
+            [ fmap ("target" A..=) activity.target
+            , fmap ("origin" A..=) activity.origin
+            ]
+         ]
+      <> toObject activity.atype
+
+-- type Announce = Object (TypeActivity TypeAnnounce)
+-- data TypeAnnounce = TypeAnnounce deriving Show
+-- instance ToObject TypeAnnounce where
+--   toObject TypeAnnounce =
+--     [ "type" A..= ("Announce" :: String)
+--     ]
+
+type Create = Activity TypeCreate
+
+data TypeCreate
+  = TypeCreate
+  { object :: Note
+  }
+  deriving (Show)
+
+instance ToObject TypeCreate where
+  toObject create =
+    [ "type" A..= ("Create" :: String)
+    , "object" A..= create.object
+    ]
+
+-- type Follow = Object (TypeActivity TypeFollow)
+-- data TypeFollow = TypeFollow deriving Show
+-- instance ToObject TypeFollow where
+--   toObject TypeFollow =
+--     [ "type" A..= ("Follow" :: String)
+--     ]
+--
+type Like = Object (TypeActivity TypeLike)
+
+data TypeLike = TypeLike deriving (Show)
+
+instance ToObject TypeLike where
+  toObject TypeLike =
+    [ "type" A..= ("Like" :: String)
+    ]
+
+data AnyActivity
+  = -- ActivityAnnounce Announce
+    ActivityCreate Create
+  --  | ActivityFollow Follow
+  --  | ActivityLike Like
+  deriving (Show)
+
+instance A.ToJSON AnyActivity where
+  toJSON = \case
+    --    ActivityAnnounce obj -> A.toJSON obj
+    ActivityCreate obj -> A.toJSON obj
+
+--    ActivityFollow obj -> A.toJSON obj
+--    ActivityLike obj -> A.toJSON obj
+
+-- * Actors
+
+-- | 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)
+
+instance A.ToJSON Actor where
+  toJSON = \case
+    ActorPerson obj -> A.toJSON obj
+
+instance ToObject Actor where
+  toObject = \case
+    ActorPerson obj -> toObject obj
+
+-- | A Person is an object that has the type 'Person'.
+type Person = Object TypePerson
+
+data TypePerson
+  = TypePerson
+  { preferredUsername :: String
+  , publicKey :: PublicKey
+  , inbox :: Link
+  , outbox :: Link
+  , following :: Link
+  , followers :: Link
+  }
+  deriving (Show)
+
+instance ToObject TypePerson where
+  toObject person =
+    [ "type" A..= ("Person" :: String)
+    , "preferredUsername" A..= person.preferredUsername
+    , "publicKey" A..= person.publicKey
+    , "inbox" A..= person.inbox
+    , "outbox" A..= person.outbox
+    , "following" A..= person.following
+    , "followers" A..= person.followers
+    ]
+
+data PublicKey
+  = PublicKey
+  { pkid :: Url
+  , owner :: Url
+  , publicKeyPem :: Pem
+  }
+  deriving (Show)
+
+instance A.ToJSON PublicKey where
+  toJSON pk =
+    A.object
+      [ "id" A..= pk.pkid
+      , "owner" A..= pk.owner
+      , "publicKeyPem" A..= pk.publicKeyPem
+      ]
+
+-- * Collections
+
+type Collection e = Object (CollectionType (Unordered e))
+
+type OrderedCollection e = Object (CollectionType (Ordered e))
+
+type OrderedCollectionPage e = Object (CollectionType (OrderedPage e))
+
+type Outbox = OrderedCollection AnyActivity
+
+type OutboxPage = OrderedCollectionPage AnyActivity
+
+data CollectionType t
+  = CollectionType
+  { ctype :: t
+  , first :: Maybe Url
+  , last :: Maybe Url
+  , current :: Maybe Url
+  }
+  deriving (Show)
+
+instance (ToObject t) => ToObject (CollectionType t) where
+  toObject collection =
+    toObject collection.ctype
+      <> [ pair
+         | Just pair <-
+            [ fmap ("first" A..=) collection.first
+            , fmap ("last" A..=) collection.last
+            , fmap ("current" A..=) collection.current
+            ]
+         ]
+
+data Unordered e
+  = UnorderedCollectionType
+  { items :: [e]
+  }
+  deriving (Show)
+
+instance (A.ToJSON e) => ToObject (Unordered e) where
+  toObject collection =
+    [ "type" A..= ("Collection" :: String)
+    , "totalItems" A..= length collection.items
+    , "items" A..= collection.items
+    ]
+
+data Ordered e
+  = OrderedCollectionType
+  { totalItems :: Integer
+  }
+  deriving (Show)
+
+instance (A.ToJSON e) => ToObject (Ordered e) where
+  toObject collection =
+    [ "type" A..= ("OrderedCollection" :: String)
+    , "totalItems" A..= collection.totalItems
+    ]
+
+data OrderedPage e
+  = OrderedCollectionPageType
+  { partOf :: Url
+  , prev :: Maybe Url
+  , next :: Maybe Url
+  , orderedItems :: [e]
+  }
+  deriving (Show)
+
+instance (A.ToJSON e) => ToObject (OrderedPage e) where
+  toObject page =
+    [ "type" A..= ("OrderedCollectionPage" :: String)
+    , "totalItems" A..= length page.orderedItems
+    , "orderedItems" A..= page.orderedItems
+    , "partOf" A..= page.partOf
+    , "prev" A..= page.prev
+    , "next" A..= page.next
+    ]
diff --git a/src/Fedi/UserDetails.hs b/src/Fedi/UserDetails.hs
new file mode 100644
index 0000000..3e2c2f7
--- /dev/null
+++ b/src/Fedi/UserDetails.hs
@@ -0,0 +1,46 @@
+module Fedi.UserDetails (
+  module Fedi.UserDetails,
+  module Export,
+) where
+
+import Data.Aeson qualified as A
+import Data.List as Export (find)
+import Data.Maybe as Export (fromMaybe, listToMaybe, maybeToList)
+import Data.String as Export (fromString)
+import Data.Text as Export (Text)
+import Data.Text qualified as T
+import Data.Time as Export (UTCTime)
+import GHC.Generics as Export (Generic)
+
+type Url = String
+
+type Domain = String
+
+type Username = String
+
+newtype Pem = Pem T.Text
+  deriving (Show)
+  deriving (A.FromJSON) via T.Text
+
+instance A.ToJSON Pem where
+  toJSON (Pem pem) = A.String pem
+
+data UserDetails
+  = UserDetails
+  { domain :: Domain
+  , username :: String
+  , name :: String
+  , summary :: String
+  , icon :: Url
+  , image :: Url
+  , publicPem :: Pem
+  , privatePem :: FilePath
+  }
+  deriving (Show, Generic, A.FromJSON)
+
+actorUrl :: UserDetails -> Url
+actorUrl details =
+  "https://" <> details.domain <> "/" <> details.username
+
+fullmention :: UserDetails -> String
+fullmention details = "@" <> details.username <> "@" <> details.domain
diff --git a/src/Fedi/Webfinger.hs b/src/Fedi/Webfinger.hs
index 3a85b14..a4267f3 100644
--- a/src/Fedi/Webfinger.hs
+++ b/src/Fedi/Webfinger.hs
@@ -1,34 +1,38 @@
 module Fedi.Webfinger where
 
-import Data.String (fromString)
 import Data.Aeson qualified as A
-import Fedi.Types
+import Fedi.UserDetails
 
 data Webfinger
   = Webfinger
-    { subject :: Subject
-    , links :: [Link]
-    }
-  deriving Show
+  { subject :: Subject
+  , links :: [WfLink]
+  }
+  deriving (Show)
 
 data Subject
   = Subject
-    { username :: Username
-    , domain :: Domain
-    }
-  deriving Show
+  { username :: Username
+  , domain :: Domain
+  }
+  deriving (Show)
 
 ppSubject :: Subject -> String
 ppSubject subject =
   "acct:" <> subject.username <> "@" <> subject.domain
 
-data Link
-  = Link
-    { rel :: Rel
-    , type_ :: LinkType
-    , href :: Url
-    }
-  deriving Show
+data WfLink
+  = WfLink
+  { type_ :: WfLinkType
+  , href :: Url
+  }
+  deriving (Show)
+
+data WfLinkType = ActivityJson
+  deriving (Show)
+
+instance A.ToJSON WfLinkType where
+  toJSON ActivityJson = A.String "application/activity+json"
 
 makeWebfinger :: UserDetails -> Webfinger
 makeWebfinger details =
@@ -36,20 +40,21 @@ makeWebfinger details =
     url = "https://" <> details.domain
   in
     Webfinger
-      { subject = Subject
-        { username = details.username
-        , domain = details.domain
-        }
+      { subject =
+          Subject
+            { username = details.username
+            , domain = details.domain
+            }
       , links =
-        [ Link
-          { rel = Self
-          , type_ = ActivityJson
-          , href = url <> "/" <> details.username
-          }
-        ]
+          [ WfLink
+              { type_ = ActivityJson
+              , href = url <> "/" <> details.username
+              }
+          ]
       }
 
 -- * -------------------------
+
 ---
 
 instance A.ToJSON Webfinger where
@@ -63,10 +68,10 @@ instance A.ToJSON Subject where
   toJSON subject =
     fromString $ ppSubject subject
 
-instance A.ToJSON Link where
+instance A.ToJSON WfLink where
   toJSON link =
     A.object
-      [ "rel" A..= link.rel
+      [ "rel" A..= ("self" :: String)
       , "type" A..= link.type_
       , "href" A..= link.href
       ]