159 lines
4.1 KiB
Haskell
159 lines
4.1 KiB
Haskell
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.Types
|
|
import Fedi.Activity
|
|
import Fedi.Actor
|
|
import Fedi.Webfinger
|
|
|
|
-- * Routes
|
|
|
|
routes :: UserDetails -> [Twain.Middleware]
|
|
routes details =
|
|
[ Twain.get (matchUser details) do
|
|
handleUser 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
|
|
]
|
|
|
|
jsonLD :: BSL.ByteString -> Twain.Response
|
|
jsonLD =
|
|
Twain.raw
|
|
Twain.status200
|
|
[(Twain.hContentType, "application/activity+json; charset=utf-8")]
|
|
|
|
-- * Create
|
|
|
|
matchCreate :: UserDetails -> Twain.PathPattern
|
|
matchCreate details = fromString ("/" <> details.username <> "/notes/:note_id/create")
|
|
|
|
handleCreate :: UserDetails -> [Activity] -> Twain.ResponderM a
|
|
handleCreate details items = do
|
|
noteId <- Twain.param "note_id"
|
|
let
|
|
createUrl =
|
|
"https://"
|
|
<> details.domain
|
|
<> "/"
|
|
<> details.username
|
|
<> "/notes/"
|
|
<> noteId
|
|
<> "/create"
|
|
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 -> [Note] -> Twain.ResponderM a
|
|
handleNote details items = do
|
|
noteId <- Twain.param "note_id"
|
|
let
|
|
noteUrl =
|
|
"https://"
|
|
<> details.domain
|
|
<> "/"
|
|
<> details.username
|
|
<> "/notes/"
|
|
<> noteId
|
|
let
|
|
content =
|
|
find (\note -> note.id == noteUrl) items
|
|
Twain.send $ jsonLD (A.encode content)
|
|
|
|
-- * User
|
|
|
|
matchUser :: UserDetails -> Twain.PathPattern
|
|
matchUser details = fromString ("/" <> details.username)
|
|
|
|
handleUser :: UserDetails -> Twain.ResponderM a
|
|
handleUser details = do
|
|
let content = makeActor details
|
|
Twain.send $ jsonLD (A.encode content)
|
|
|
|
-- * Webfinger
|
|
|
|
matchWebfinger :: Twain.PathPattern
|
|
matchWebfinger = "/.well-known/webfinger"
|
|
|
|
handleWebfinger :: UserDetails -> Twain.ResponderM b
|
|
handleWebfinger details = do
|
|
resource <- Twain.param "resource"
|
|
let webfinger = makeWebfinger details
|
|
if resource == ppSubject webfinger.subject
|
|
then do
|
|
Twain.send $ jsonLD (A.encode webfinger)
|
|
else do
|
|
Twain.next
|
|
|
|
-- * Outbox
|
|
|
|
matchOutbox :: UserDetails -> Twain.PathPattern
|
|
matchOutbox details =
|
|
fromString ("/" <> details.username <> "/outbox")
|
|
|
|
handleOutbox :: UserDetails -> [Activity] -> Twain.ResponderM b
|
|
handleOutbox details items = do
|
|
isPage <- Twain.queryParamMaybe "page"
|
|
let
|
|
outboxUrl =
|
|
"https://"
|
|
<> details.domain
|
|
<> "/"
|
|
<> details.username
|
|
<> "/outbox"
|
|
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
|
|
{ id = outboxUrl
|
|
, summary = details.username <> "'s notes"
|
|
, items = items
|
|
, first = Just $ outboxUrl <> "?page=true"
|
|
, last = Just $ outboxUrl <> "?page=true"
|
|
}
|
|
in A.encode content
|
|
Twain.send $ jsonLD response
|
|
|
|
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)
|
|
)
|
|
Nothing -> False
|