109 lines
3.6 KiB
Haskell
109 lines
3.6 KiB
Haskell
module Routes where
|
|
|
|
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
|
|
notes <- liftIO db.getNotes
|
|
|
|
request <- Twain.request
|
|
if Fedi.checkContentTypeAccept request
|
|
then do
|
|
Fedi.handleNote details notes
|
|
else do
|
|
noteId <- Twain.param "note_id"
|
|
let
|
|
noteUrl =
|
|
"https://"
|
|
<> details.domain
|
|
<> "/"
|
|
<> details.username
|
|
<> "/notes/"
|
|
<> noteId
|
|
thenote = filter (\note -> note.id == noteUrl) notes
|
|
|
|
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
|
|
}
|