introduce outbox page
This commit is contained in:
parent
a36f3a2bed
commit
a0bdd57e83
3 changed files with 60 additions and 8 deletions
|
@ -41,8 +41,8 @@ mkFediApp :: IO Twain.Application
|
||||||
mkFediApp = do
|
mkFediApp = do
|
||||||
detailsFile <- lookupEnv "FEDI_DETAILS"
|
detailsFile <- lookupEnv "FEDI_DETAILS"
|
||||||
<&> maybe (error "missing FEDI_DETAILS") id
|
<&> maybe (error "missing FEDI_DETAILS") id
|
||||||
details <- A.decodeFileStrict detailsFile
|
details <- A.eitherDecodeFileStrict detailsFile
|
||||||
<&> maybe (error $ "could not read file '" <> detailsFile <> "'.") id
|
<&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
|
||||||
|
|
||||||
pure $ foldr ($)
|
pure $ foldr ($)
|
||||||
(Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
|
(Twain.notFound $ Twain.send $ Twain.text "Error: not found.")
|
||||||
|
|
|
@ -1,5 +1,6 @@
|
||||||
module Fedi.Activity where
|
module Fedi.Activity where
|
||||||
|
|
||||||
|
import Data.Maybe (listToMaybe)
|
||||||
import Data.Aeson qualified as A
|
import Data.Aeson qualified as A
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Fedi.Types
|
import Fedi.Types
|
||||||
|
@ -35,11 +36,18 @@ type Following = [Actor]
|
||||||
|
|
||||||
type Inbox = Collection Ordered Activity
|
type Inbox = Collection Ordered Activity
|
||||||
type Outbox = Collection Unordered Activity
|
type Outbox = Collection Unordered Activity
|
||||||
type OutboxPage = Collection Unordered Activity
|
type OutboxPage = OrderedCollectionPage Activity
|
||||||
|
|
||||||
data Ordered
|
data Ordered
|
||||||
data Unordered
|
data Unordered
|
||||||
|
|
||||||
|
data OrderedCollectionPage a
|
||||||
|
= OrderedCollectionPage
|
||||||
|
{ id :: Url
|
||||||
|
, partOf :: Url
|
||||||
|
, orderedItems :: [a]
|
||||||
|
}
|
||||||
|
|
||||||
data Collection order a
|
data Collection order a
|
||||||
= Collection
|
= Collection
|
||||||
{ summary :: String
|
{ summary :: String
|
||||||
|
@ -87,6 +95,8 @@ instance A.ToJSON a => A.ToJSON (Collection Ordered a) where
|
||||||
, "summary" A..= collection.summary
|
, "summary" A..= collection.summary
|
||||||
, "totalItems" A..= length collection.items
|
, "totalItems" A..= length collection.items
|
||||||
, "orderedItems" A..= 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
|
instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
|
||||||
|
@ -99,4 +109,17 @@ instance A.ToJSON a => A.ToJSON (Collection Unordered a) where
|
||||||
, "summary" A..= collection.summary
|
, "summary" A..= collection.summary
|
||||||
, "totalItems" A..= length collection.items
|
, "totalItems" A..= length collection.items
|
||||||
, "items" A..= collection.items
|
, "items" A..= collection.items
|
||||||
|
, "first" A..= listToMaybe (take 1 collection.items)
|
||||||
|
, "last" A..= listToMaybe (take 1 $ reverse collection.items)
|
||||||
|
]
|
||||||
|
|
||||||
|
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
|
||||||
]
|
]
|
||||||
|
|
|
@ -18,7 +18,7 @@ routes details =
|
||||||
handleUser details
|
handleUser details
|
||||||
|
|
||||||
, Twain.get (matchOutbox details) do
|
, Twain.get (matchOutbox details) do
|
||||||
handleOutbox details
|
handleOutbox details []
|
||||||
|
|
||||||
, Twain.get matchWebfinger do
|
, Twain.get matchWebfinger do
|
||||||
handleWebfinger details
|
handleWebfinger details
|
||||||
|
@ -61,7 +61,36 @@ matchOutbox :: UserDetails -> Twain.PathPattern
|
||||||
matchOutbox details =
|
matchOutbox details =
|
||||||
fromString ("/" <> details.username <> "/outbox")
|
fromString ("/" <> details.username <> "/outbox")
|
||||||
|
|
||||||
handleOutbox :: UserDetails -> Twain.ResponderM b
|
handleOutbox :: UserDetails -> [Activity] -> Twain.ResponderM b
|
||||||
handleOutbox details = do
|
handleOutbox details items = do
|
||||||
let content = Collection { summary = details.username <> "'s notes", items = [] } :: Outbox
|
isPage <- Twain.queryParamMaybe "page"
|
||||||
Twain.send $ jsonLD (A.encode content)
|
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
|
||||||
|
|
Loading…
Add table
Reference in a new issue