module Routes where import Control.Logger.Simple qualified as Log import DB import Data.Aeson qualified as A import Data.Functor ((<&>)) import Data.Maybe (maybeToList) import Data.Text qualified as T import Fedi qualified as Fedi import Html import Lucid qualified as H import Routes.Inbox import System.IO.Unsafe (unsafePerformIO) import Web.Twain qualified as Twain routes :: DB -> FilePath -> [Twain.Middleware] routes db detailsFile = [ Twain.get "/" do details <- liftIO $ fetchUserDetails detailsFile Twain.send $ Twain.redirect302 $ fromString ("/" <> details.username) , -- 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 request <- Twain.request if Fedi.checkContentTypeAccept request then do details <- liftIO $ fetchUserDetails detailsFile notes <- map (Fedi.ActivityCreate . noteToCreate) <$> liftIO db.getNotes Fedi.handleOutbox details notes else Twain.next , -- Match Create object Twain.get (Fedi.matchCreateNote $ unsafePerformIO $ fetchUserDetails detailsFile) do details <- liftIO $ fetchUserDetails detailsFile notes <- map noteToCreate <$> liftIO db.getNotes Fedi.handleCreateNote details notes , -- Match inbox Twain.post (Fedi.matchInbox $ unsafePerformIO $ fetchUserDetails detailsFile) do Log.logTrace "Inbox" Fedi.handleInbox (handleInbox db detailsFile) , -- Match Create object Twain.get (Fedi.matchCreateNote $ unsafePerformIO $ fetchUserDetails detailsFile) do details <- liftIO $ fetchUserDetails detailsFile notes <- map noteToCreate <$> liftIO db.getNotes Fedi.handleCreateNote 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] , -- Followers Twain.get (Fedi.matchFollowers $ unsafePerformIO $ fetchUserDetails detailsFile) do details <- liftIO $ fetchUserDetails detailsFile followers <- liftIO db.getFollowers <&> map (\follower -> T.unpack follower.actorId) Fedi.handleFollowers details followers , -- Following Twain.get (Fedi.matchFollowing $ unsafePerformIO $ fetchUserDetails detailsFile) do details <- liftIO $ fetchUserDetails detailsFile Fedi.handleFollowing details , -- 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, note) <- 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 } liftIO $ sendFollowers details db (Fedi.ActivityCreate $ noteToCreate note) Twain.send $ Twain.redirect302 (fromString ("/" <> details.username <> "/notes/" <> show 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.Create noteToCreate note = Fedi.makeCreateNote note