diff --git a/src/Fedi/Activity.hs b/src/Fedi/Activity.hs index cd259b6..6b4ee9c 100644 --- a/src/Fedi/Activity.hs +++ b/src/Fedi/Activity.hs @@ -22,6 +22,10 @@ type ActivityUrl = Url data Object = NoteObject Note +objectUrl :: Object -> Url +objectUrl = \case + NoteObject note -> note.id + data Note = Note { id :: NoteId @@ -32,6 +36,7 @@ data Note , url :: Maybe Url , replies :: Collection Unordered Note } + type NoteId = Url type Followers = [Actor] diff --git a/src/Fedi/Routes.hs b/src/Fedi/Routes.hs index 7c0130c..46225b1 100644 --- a/src/Fedi/Routes.hs +++ b/src/Fedi/Routes.hs @@ -1,6 +1,6 @@ module Fedi.Routes where -import Data.Maybe (listToMaybe) +import Data.List (find) import Web.Twain qualified as Twain import Web.Twain.Types qualified as Twain import Data.String (fromString) @@ -10,6 +10,7 @@ import Fedi.Types import Fedi.Activity import Fedi.Actor import Fedi.Webfinger +import Data.Functor ((<&>)) -- * Routes @@ -21,6 +22,12 @@ routes details = , Twain.get (matchOutbox details) do handleOutbox details [] + , Twain.get (matchCreate details) do + handleUser details + + , Twain.get (matchNote details) do + handleUser details + , Twain.get matchWebfinger do handleWebfinger details ] @@ -31,6 +38,49 @@ jsonLD = Twain.status200 [(Twain.hContentType, "application/activity+json; charset=utf-8")] +-- * Create + +matchCreate :: UserDetails -> Twain.PathPattern +matchCreate details = fromString ("/" <> details.username <> "/notes/create/:create_id") + +handleCreate :: UserDetails -> [Activity] -> Twain.ResponderM a +handleCreate details items = do + noteId <- Twain.param "create_id" + let + createUrl = + "https://" + <> details.domain + <> "/" + <> details.username + <> "/notes/create/" + <> noteId + let + content = + find (\create -> create.id == createUrl) items + Twain.send $ jsonLD (A.encode content) + +-- * Note + +matchNote :: UserDetails -> Twain.PathPattern +matchNote details = fromString ("/" <> details.username <> "/notes/:note_id") + +handleNote :: UserDetails -> [Activity] -> Twain.ResponderM a +handleNote details items = do + noteId <- Twain.param "note_id" + let + createUrl = + "https://" + <> details.domain + <> "/" + <> details.username + <> "/notes/" + <> noteId + let + content = + find (\create -> objectUrl (create.object) == createUrl) items + <&> \create -> create.object + Twain.send $ jsonLD (A.encode content) + -- * User matchUser :: UserDetails -> Twain.PathPattern @@ -72,7 +122,6 @@ handleOutbox details items = do <> "/" <> details.username <> "/outbox" - let response = case isPage of Just True ->