module Fedi.Routes where import Data.Aeson qualified as A import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL import Fedi.Helpers import Fedi.Types import Fedi.UserDetails import Fedi.Webfinger import Web.Twain qualified as Twain import Web.Twain.Types qualified as Twain -- * Routes routes :: UserDetails -> [Twain.Middleware] routes details = [ Twain.get (matchUser details) do handleUser details , Twain.get (matchOutbox details) do handleOutbox details [] , Twain.get (matchCreateNote details) do handleCreateNote details [] , Twain.get (matchNote details) do handleNote details [] , -- , Twain.post (matchInbox details) do -- handleInbox details undefined 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 matchCreateNote :: UserDetails -> Twain.PathPattern matchCreateNote details = fromString ("/" <> details.username <> "/notes/:note_id/create") handleCreateNote :: UserDetails -> [Create] -> Twain.ResponderM a handleCreateNote details items = do noteId <- Twain.param "note_id" let createUrl = "https://" <> details.domain <> "/" <> details.username <> "/notes/" <> noteId <> "/create" let content = find (\create -> create.id == Just (ObjectId 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 == Just (ObjectId 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 -> [AnyActivity] -> 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 empty = emptyOrderedCollectionPage outboxUrl content :: OutboxPage content = empty { id = Just $ ObjectId $ outboxUrl <> "?page=true" , otype = empty.otype { ctype = empty.otype.ctype { partOf = outboxUrl , porderedItems = items } } } in A.encode content _ -> let content :: Outbox content = emptyOrderedCollection { id = Just $ ObjectId outboxUrl , summary = Just $ fromString $ details.username <> "'s notes" , otype = emptyOrderedCollection.otype { ctype = emptyOrderedCollection.otype.ctype { orderedItems = items } , first = Just $ outboxUrl <> "?page=true" , last = Just $ outboxUrl <> "?page=true" } } in A.encode content Twain.send $ jsonLD response -- * Inbox -- matchInbox :: UserDetails -> Twain.PathPattern -- matchInbox details = -- fromString ("/" <> details.username <> "/inbox") -- -- handleInbox :: UserDetails -> (Activity -> Twain.ResponderM b) -> Twain.ResponderM b -- handleInbox _details _handle = do -- let response = undefined -- Twain.send $ jsonLD response -- * Other stuff checkContentTypeAccept :: Twain.Request -> Bool checkContentTypeAccept request = case lookup Twain.hAccept request.requestHeaders of Just bs -> ("application/activity+json" `BS.isInfixOf` bs) || ( ("application/ld+json" `BS.isInfixOf` bs) && ("profile=\"https://www.w3.org/ns/activitystreams\"" `BS.isInfixOf` bs) ) Nothing -> False