103 lines
3.4 KiB
Haskell
103 lines
3.4 KiB
Haskell
module Routes where
|
|
|
|
import Data.Maybe (maybeToList)
|
|
import Data.String (fromString)
|
|
import Data.Aeson qualified as A
|
|
import Web.Twain qualified as Twain
|
|
import Fedi qualified as Fedi
|
|
import Data.Functor ((<&>))
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Lucid qualified as H
|
|
|
|
import Html
|
|
import DB
|
|
|
|
routes :: DB -> FilePath -> [Twain.Middleware]
|
|
routes db detailsFile =
|
|
[ -- Match actor
|
|
Twain.get (Fedi.matchUser $ unsafePerformIO $ fetchUserDetails detailsFile) do
|
|
request <- Twain.request
|
|
if Fedi.checkContentTypeAccept request
|
|
then do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
Fedi.handleUser details
|
|
else do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
notes <- liftIO db.getNotes
|
|
Twain.send $ Twain.html $ H.renderBS $ actorPage details notes
|
|
|
|
, -- Match outbox
|
|
Twain.get (Fedi.matchOutbox $ unsafePerformIO $ fetchUserDetails detailsFile) do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
notes <- map noteToCreate <$> liftIO db.getNotes
|
|
Fedi.handleOutbox details notes
|
|
|
|
, -- Match Create object
|
|
Twain.get (Fedi.matchCreate $ unsafePerformIO $ fetchUserDetails detailsFile) do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
notes <- map noteToCreate <$> liftIO db.getNotes
|
|
|
|
Fedi.handleCreate details notes
|
|
|
|
, -- Match Note object
|
|
Twain.get (Fedi.matchNote $ unsafePerformIO $ fetchUserDetails detailsFile) do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
noteId <- Twain.param "note_id"
|
|
mnote <- liftIO $ db.getNote noteId
|
|
|
|
request <- Twain.request
|
|
if Fedi.checkContentTypeAccept request
|
|
then do
|
|
Fedi.handleNote details (maybeToList mnote)
|
|
else do
|
|
case mnote of
|
|
Nothing -> Twain.next
|
|
Just thenote ->
|
|
Twain.send $ Twain.html $ H.renderBS $ actorPage details [thenote]
|
|
|
|
, -- Match webfinger
|
|
Twain.get Fedi.matchWebfinger do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
Fedi.handleWebfinger details
|
|
|
|
, -- Admin page
|
|
Twain.get (fromString $ "/" <> (unsafePerformIO $ fetchUserDetails detailsFile).username <> "/admin") do
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
notes <- liftIO db.getNotes
|
|
Twain.send $ Twain.html $ H.renderBS $ adminPage details notes
|
|
|
|
, -- New post
|
|
Twain.post (fromString $ "/" <> (unsafePerformIO $ fetchUserDetails detailsFile).username <> "/admin/new") do
|
|
title <- Twain.param "title"
|
|
content <- Twain.param "content"
|
|
url <- Twain.param "url"
|
|
details <- liftIO $ fetchUserDetails detailsFile
|
|
|
|
noteid <-
|
|
liftIO $ db.insertNote NoteEntry
|
|
{ content = content
|
|
, inReplyTo = Nothing
|
|
, name = if trim title == "" then Nothing else Just title
|
|
, url = if trim url == "" then Nothing else Just url
|
|
}
|
|
|
|
Twain.send $ Twain.redirect302 (fromString ("/" <> details.username <> "/notes/" <> noteid))
|
|
]
|
|
|
|
trim :: String -> String
|
|
trim = unwords . words
|
|
|
|
fetchUserDetails :: FilePath -> IO Fedi.UserDetails
|
|
fetchUserDetails detailsFile =
|
|
A.eitherDecodeFileStrict detailsFile
|
|
<&> either (\err -> error $ "could not read file '" <> detailsFile <> "'.\n" <> err) id
|
|
|
|
noteToCreate :: Fedi.Note -> Fedi.Activity
|
|
noteToCreate note =
|
|
Fedi.Create
|
|
{ id =
|
|
note.id <> "/create"
|
|
, actor = note.actor
|
|
, object = Fedi.NoteObject note
|
|
}
|