fedi/app/Routes.hs

module Routes where

import Control.Concurrent.Async qualified as Async
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.Follow
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

handleInbox :: DB -> FilePath -> Fedi.AnyActivity -> Twain.ResponderM Twain.Response
handleInbox db detailsFile activity = do
  details <- liftIO $ fetchUserDetails detailsFile
  Log.logDebug $ "Inbox request: " <> Fedi.pJson activity
  case activity of
    Fedi.ActivityFollow follow ->
      handleInboxFollow details db activity follow
    Fedi.ActivityUndo
      ( Fedi.Object
          { otype =
            Fedi.TypeActivity
              { atype =
                Fedi.TypeUndo
                  { object = Fedi.ActivityFollow follow
                  }
              }
          }
        ) ->
        handleInboxUnfollow details db activity follow
    _ -> do
      Log.logError $ "Unsupported activity: " <> Fedi.pShow activity
      Twain.next

sendFollowers :: Fedi.UserDetails -> DB -> Fedi.AnyActivity -> IO ()
sendFollowers details db message = do
  Log.logDebug $ "Sending to followers: " <> Fedi.pJson message
  followers <- db.getFollowers
  Fedi.for_ followers \follower -> do
    Async.async $ do
      Log.logDebug $ "Sending to follower: " <> Fedi.pShow follower.actorId
      bs <- Fedi.sendPost details (T.unpack follower.actorId <> "/inbox") message
      Log.logDebug $ "Sent to follower: " <> Fedi.pShow (follower.actorId, bs)