Route to note and create
This commit is contained in:
parent
931e075067
commit
462d9d52c5
2 changed files with 56 additions and 2 deletions
|
@ -22,6 +22,10 @@ type ActivityUrl = Url
|
||||||
data Object
|
data Object
|
||||||
= NoteObject Note
|
= NoteObject Note
|
||||||
|
|
||||||
|
objectUrl :: Object -> Url
|
||||||
|
objectUrl = \case
|
||||||
|
NoteObject note -> note.id
|
||||||
|
|
||||||
data Note
|
data Note
|
||||||
= Note
|
= Note
|
||||||
{ id :: NoteId
|
{ id :: NoteId
|
||||||
|
@ -32,6 +36,7 @@ data Note
|
||||||
, url :: Maybe Url
|
, url :: Maybe Url
|
||||||
, replies :: Collection Unordered Note
|
, replies :: Collection Unordered Note
|
||||||
}
|
}
|
||||||
|
|
||||||
type NoteId = Url
|
type NoteId = Url
|
||||||
|
|
||||||
type Followers = [Actor]
|
type Followers = [Actor]
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module Fedi.Routes where
|
module Fedi.Routes where
|
||||||
|
|
||||||
import Data.Maybe (listToMaybe)
|
import Data.List (find)
|
||||||
import Web.Twain qualified as Twain
|
import Web.Twain qualified as Twain
|
||||||
import Web.Twain.Types qualified as Twain
|
import Web.Twain.Types qualified as Twain
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
|
@ -10,6 +10,7 @@ import Fedi.Types
|
||||||
import Fedi.Activity
|
import Fedi.Activity
|
||||||
import Fedi.Actor
|
import Fedi.Actor
|
||||||
import Fedi.Webfinger
|
import Fedi.Webfinger
|
||||||
|
import Data.Functor ((<&>))
|
||||||
|
|
||||||
-- * Routes
|
-- * Routes
|
||||||
|
|
||||||
|
@ -21,6 +22,12 @@ routes details =
|
||||||
, Twain.get (matchOutbox details) do
|
, Twain.get (matchOutbox details) do
|
||||||
handleOutbox details []
|
handleOutbox details []
|
||||||
|
|
||||||
|
, Twain.get (matchCreate details) do
|
||||||
|
handleUser details
|
||||||
|
|
||||||
|
, Twain.get (matchNote details) do
|
||||||
|
handleUser details
|
||||||
|
|
||||||
, Twain.get matchWebfinger do
|
, Twain.get matchWebfinger do
|
||||||
handleWebfinger details
|
handleWebfinger details
|
||||||
]
|
]
|
||||||
|
@ -31,6 +38,49 @@ jsonLD =
|
||||||
Twain.status200
|
Twain.status200
|
||||||
[(Twain.hContentType, "application/activity+json; charset=utf-8")]
|
[(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
|
-- * User
|
||||||
|
|
||||||
matchUser :: UserDetails -> Twain.PathPattern
|
matchUser :: UserDetails -> Twain.PathPattern
|
||||||
|
@ -72,7 +122,6 @@ handleOutbox details items = do
|
||||||
<> "/"
|
<> "/"
|
||||||
<> details.username
|
<> details.username
|
||||||
<> "/outbox"
|
<> "/outbox"
|
||||||
let
|
|
||||||
response =
|
response =
|
||||||
case isPage of
|
case isPage of
|
||||||
Just True ->
|
Just True ->
|
||||||
|
|
Loading…
Add table
Reference in a new issue