From 5c9495bf0b0717ff17296371025645cb82a16b2a Mon Sep 17 00:00:00 2001
From: me <me@campxfire.space>
Date: Mon, 28 Oct 2024 16:45:14 +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