From fa05ae4bf2a2388e63bc7aa03dbf040644293ac5 Mon Sep 17 00:00:00 2001 From: me Date: Tue, 17 Dec 2024 10:46:59 +0200 Subject: [PATCH] separate routes --- app/Main.hs | 105 +----------------------------------------------- app/Routes.hs | 109 ++++++++++++++++++++++++++++++++++++++++++++++++++ fedi.cabal | 1 + 3 files changed, 111 insertions(+), 104 deletions(-) create mode 100644 app/Routes.hs diff --git a/app/Main.hs b/app/Main.hs index c3afc49..7afa3fc 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,17 +11,13 @@ import Network.Wai.Middleware.RequestLogger qualified as Logger import System.Environment (getArgs) import System.Environment (lookupEnv) import Web.Twain qualified as Twain -import Fedi qualified as Fedi import Data.Functor ((<&>)) import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import qualified Data.Text as T -import System.IO.Unsafe (unsafePerformIO) -import Control.Monad.IO.Class (liftIO) -import Lucid qualified as H -import Html import DB +import Routes data Command = Serve @@ -131,102 +127,3 @@ mkFediApp connStr = do pure $ foldr ($) (Twain.notFound $ Twain.send $ Twain.text "Error: not found.") (routes db detailsFile) - - --- * Routes - -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 - } diff --git a/app/Routes.hs b/app/Routes.hs new file mode 100644 index 0000000..ed16e42 --- /dev/null +++ b/app/Routes.hs @@ -0,0 +1,109 @@ +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 + } diff --git a/fedi.cabal b/fedi.cabal index 3cee6d6..a3d2efc 100644 --- a/fedi.cabal +++ b/fedi.cabal @@ -62,6 +62,7 @@ executable fedi DB Html Css + Routes -- other-extensions: build-depends: aeson