introduce outbox page

app/Main.hs

@@ -41,8 +41,8 @@ mkFediApp :: IO Twain.Application
 mkFediApp = do
   detailsFile <- lookupEnv "FEDI_DETAILS"
     <&> maybe (error "missing FEDI_DETAILS") id
-  details <- A.decodeFileStrict detailsFile
-    <&> maybe (error $ "could not read file '" <> detailsFile <> "'.") id
+  details <- A.eitherDecodeFileStrict detailsFile
+    <&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
 
   pure $ foldr ($)
     (Twain.notFound $ Twain.send $ Twain.text "Error: not found.")

fedi.cabal

@@ -52,6 +52,7 @@ library
     GeneralizedNewtypeDeriving
     DeriveAnyClass
     DerivingStrategies
+    DuplicateRecordFields
 
 executable fedi
   import: warnings

src/Fedi/Activity.hs

@@ -1,5 +1,6 @@
 module Fedi.Activity where
 
+import Data.Maybe (listToMaybe)
 import Data.Aeson qualified as A
 import Data.Text qualified as T
 import Fedi.Types
@@ -8,7 +9,7 @@ import Data.Time (UTCTime)
 
 data Activity
   = Create
-    { createId :: ActivityUrl
+    { id :: ActivityUrl
     , actor :: ActorId
     , object :: Object
     }
@@ -20,13 +21,13 @@ data Object
 
 data Note
   = Note
-    { noteId :: NoteId
-    , notePublished :: UTCTime
-    , noteActor :: ActorId
-    , noteContent :: T.Text
-    , noteName :: Maybe String
-    , noteUrl :: Maybe Url
-    , noteReplies :: Collection Unordered Note
+    { id :: NoteId
+    , published :: UTCTime
+    , actor :: ActorId
+    , content :: T.Text
+    , name :: Maybe String
+    , url :: Maybe Url
+    , replies :: Collection Unordered Note
     }
 type NoteId = Url
 
@@ -35,29 +36,37 @@ type Following = [Actor]
 
 type Inbox = Collection Ordered Activity
 type Outbox = Collection Unordered Activity
+type OutboxPage = OrderedCollectionPage Activity
 
 data Ordered
 data Unordered
 
+data OrderedCollectionPage a
+  = OrderedCollectionPage
+    { id :: Url
+    , partOf :: Url
+    , orderedItems :: [a]
+    }
+
 data Collection order a
   = Collection
-    { collectionSummary :: String
-    , collectionItems :: [a]
+    { summary :: String
+    , items :: [a]
     }
 
 instance A.ToJSON Note where
   toJSON note =
     A.object $
         [ "type" A..= ("Note" :: String)
-        , "id" A..= note.noteId
-        , "published" A..= note.notePublished
-        , "attributedTo" A..= note.noteActor
-        , "content" A..= note.noteContent
-        , "name" A..= note.noteName
-        , "replies" A..= note.noteReplies
+        , "id" A..= note.id
+        , "published" A..= note.published
+        , "attributedTo" A..= note.actor
+        , "content" A..= note.content
+        , "name" A..= note.name
+        , "replies" A..= note.replies
         ]
-        <> [ "name" A..= name | Just name <- [note.noteName] ]
-        <> [ "url" A..= url | Just url <- [note.noteUrl] ]
+        <> [ "name" A..= name | Just name <- [note.name] ]
+        <> [ "url" A..= url | Just url <- [note.url] ]
 
 instance A.ToJSON Object where
   toJSON = \case
@@ -71,7 +80,7 @@ instance A.ToJSON Activity where
           [ "https://www.w3.org/ns/activitystreams" :: String
           ]
         , "type" A..= ("Create" :: String)
-        , "id" A..= create.createId
+        , "id" A..= create.id
         , "actor" A..= create.actor
         , "object" A..= create.object
         ]
@@ -83,9 +92,11 @@ instance A.ToJSON a => A.ToJSON (Collection Ordered a) where
         [ "https://www.w3.org/ns/activitystreams" :: String
         ]
       , "type" A..= ("OrderedCollection" :: String)
-      , "summary" A..= collection.collectionSummary
-      , "totalItems" A..= length collection.collectionItems
-      , "orderedItems" A..= collection.collectionItems
+      , "summary" A..= collection.summary
+      , "totalItems" A..= length collection.items
+      , "orderedItems" A..= collection.items
+      , "first" A..= listToMaybe (take 1 collection.items)
+      , "last" A..= listToMaybe (take 1 $ reverse collection.items)
       ]
 
 instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
@@ -95,24 +106,20 @@ instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
         [ "https://www.w3.org/ns/activitystreams" :: String
         ]
       , "type" A..= ("Collection" :: String)
-      , "summary" A..= collection.collectionSummary
-      , "totalItems" A..= length collection.collectionItems
-      , "items" A..= collection.collectionItems
+      , "summary" A..= collection.summary
+      , "totalItems" A..= length collection.items
+      , "items" A..= collection.items
+      , "first" A..= listToMaybe (take 1 collection.items)
+      , "last" A..= listToMaybe (take 1 $ reverse collection.items)
       ]
 
-{-
-  "@context": "https://www.w3.org/ns/activitystreams",
-  "summary": "Sally's notes",
-  "type": "OrderedCollection",
-  "totalItems": 2,
-  "orderedItems": [
-    {
-      "type": "Note",
-      "name": "A Simple Note"
-    },
-    {
-      "type": "Note",
-      "name": "Another Simple Note"
-    }
-  ]
--}
+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
+      ]

src/Fedi/Actor.hs

@@ -5,12 +5,12 @@ import Fedi.Types
 
 data Actor
   = Actor
-    { actorId :: Url
-    , actorName :: String
-    , actorPreferredUsername :: String
-    , actorSummary :: String
-    , actorIcon :: Url
-    , actorPublicKey :: PublicKey
+    { id :: Url
+    , name :: String
+    , preferredUsername :: String
+    , summary :: String
+    , icon :: Url
+    , publicKey :: PublicKey
     }
   deriving Show
 
@@ -22,9 +22,9 @@ data ActorType
 
 data PublicKey
   = PublicKey
-    { pkId :: Url
-    , pkOwner :: Url
-    , pkPublicKeyPem :: Pem
+    { id :: Url
+    , owner :: Url
+    , publicKeyPem :: Pem
     }
   deriving Show
 
@@ -34,16 +34,16 @@ makeActor details =
     url = "https://" <> details.domain
     actorUrl = url <> "/" <> details.username
   in Actor
-    { actorId = actorUrl
-    , actorName = details.name
-    , actorPreferredUsername = details.username
-    , actorSummary = details.summary
-    , actorIcon = details.icon
-    , actorPublicKey =
+    { id = actorUrl
+    , name = details.name
+    , preferredUsername = details.username
+    , summary = details.summary
+    , icon = details.icon
+    , publicKey =
       PublicKey
-        { pkId = actorUrl <> "#main-key"
-        , pkOwner = actorUrl
-        , pkPublicKeyPem = details.publicPem
+        { id = actorUrl <> "#main-key"
+        , owner = actorUrl
+        , publicKeyPem = details.publicPem
         }
     }
 
@@ -54,19 +54,19 @@ instance A.ToJSON Actor where
         [ "https://www.w3.org/ns/activitystreams" :: String
         , "https://w3id.org/security/v1"
         ]
-      , "id" A..= actor.actorId
+      , "id" A..= actor.id
       , "type" A..= Person
-      , "name" A..= actor.actorName
-      , "preferredUsername" A..= actor.actorPreferredUsername
-      , "summary" A..= actor.actorSummary
+      , "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.actorIcon
+        , "url" A..= actor.icon
         ]
-      , "inbox" A..= (actor.actorId <> "/inbox")
-      , "outbox" A..= (actor.actorId <> "/outbox")
-      , "publicKey" A..= actor.actorPublicKey
+      , "inbox" A..= (actor.id <> "/inbox")
+      , "outbox" A..= (actor.id <> "/outbox")
+      , "publicKey" A..= actor.publicKey
       ]
 
 instance A.ToJSON ActorType where
@@ -75,7 +75,7 @@ instance A.ToJSON ActorType where
 instance A.ToJSON PublicKey where
   toJSON pk =
     A.object
-      [ "id" A..= pk.pkId
-      , "owner" A..= pk.pkOwner
-      , "publicKeyPem" A..= pk.pkPublicKeyPem
+      [ "id" A..= pk.id
+      , "owner" A..= pk.owner
+      , "publicKeyPem" A..= pk.publicKeyPem
       ]

src/Fedi/Routes.hs

@@ -18,7 +18,7 @@ routes details =
     handleUser details
 
   , Twain.get (matchOutbox details) do
-    handleOutbox details
+    handleOutbox details []
 
   , Twain.get matchWebfinger do
     handleWebfinger details
@@ -49,7 +49,7 @@ handleWebfinger :: UserDetails -> Twain.ResponderM b
 handleWebfinger details = do
   resource <- Twain.param "resource"
   let webfinger = makeWebfinger details
-  if resource == ppSubject webfinger.wfSubject
+  if resource == ppSubject webfinger.subject
     then do
       Twain.send $ jsonLD (A.encode webfinger)
     else do
@@ -61,7 +61,36 @@ matchOutbox :: UserDetails -> Twain.PathPattern
 matchOutbox details =
   fromString ("/" <> details.username <> "/outbox")
 
-handleOutbox :: UserDetails -> Twain.ResponderM b
-handleOutbox details = do
-  let content = Collection { collectionSummary = details.username <> "'s notes", collectionItems = [] } :: Outbox
-  Twain.send $ jsonLD (A.encode content)
+handleOutbox :: UserDetails -> [Activity] -> Twain.ResponderM b
+handleOutbox details items = do
+  isPage <- Twain.queryParamMaybe "page"
+  let
+    outboxUrl =
+      "https://"
+        <> details.domain
+        <> "/"
+        <> details.username
+        <> "/outbox"
+  let
+    response =
+      case isPage of
+        Just True ->
+          let
+            content :: OutboxPage
+            content =
+              OrderedCollectionPage
+                { id = outboxUrl <> "?page=true"
+                , partOf = outboxUrl
+                , orderedItems = items
+                }
+          in A.encode content
+        _ ->
+          let
+            content :: Outbox
+            content =
+              Collection
+                { summary = details.username <> "'s notes"
+                , items = items
+                }
+          in A.encode content
+  Twain.send $ jsonLD response

src/Fedi/Webfinger.hs

@@ -6,27 +6,27 @@ import Fedi.Types
 
 data Webfinger
   = Webfinger
-    { wfSubject :: Subject
-    , wfLinks :: [Link]
+    { subject :: Subject
+    , links :: [Link]
     }
   deriving Show
 
 data Subject
   = Subject
-    { subjectUsername :: Username
-    , subjectDomain :: Domain
+    { username :: Username
+    , domain :: Domain
     }
   deriving Show
 
 ppSubject :: Subject -> String
 ppSubject subject =
-  "acct:" <> subject.subjectUsername <> "@" <> subject.subjectDomain
+  "acct:" <> subject.username <> "@" <> subject.domain
 
 data Link
   = Link
-    { linkRel :: Rel
-    , linkType :: LinkType
-    , linkHref :: Url
+    { rel :: Rel
+    , type_ :: LinkType
+    , href :: Url
     }
   deriving Show
 
@@ -36,15 +36,15 @@ makeWebfinger details =
     url = "https://" <> details.domain
   in
     Webfinger
-      { wfSubject = Subject
-        { subjectUsername = details.username
-        , subjectDomain = details.domain
+      { subject = Subject
+        { username = details.username
+        , domain = details.domain
         }
-      , wfLinks =
+      , links =
         [ Link
-          { linkRel = Self
-          , linkType = ActivityJson
-          , linkHref = url <> "/" <> details.username
+          { rel = Self
+          , type_ = ActivityJson
+          , href = url <> "/" <> details.username
           }
         ]
       }
@@ -55,8 +55,8 @@ makeWebfinger details =
 instance A.ToJSON Webfinger where
   toJSON webfinger =
     A.object
-      [ "subject" A..= webfinger.wfSubject
-      , "links" A..= webfinger.wfLinks
+      [ "subject" A..= webfinger.subject
+      , "links" A..= webfinger.links
       ]
 
 instance A.ToJSON Subject where
@@ -66,7 +66,7 @@ instance A.ToJSON Subject where
 instance A.ToJSON Link where
   toJSON link =
     A.object
-      [ "rel" A..= link.linkRel
-      , "type" A..= link.linkType
-      , "href" A..= link.linkHref
+      [ "rel" A..= link.rel
+      , "type" A..= link.type_
+      , "href" A..= link.href
       ]