module Routes.Inbox where

import Control.Concurrent.Async qualified as Async
import Control.Logger.Simple qualified as Log
import DB
import Data.Text qualified as T
import Fedi qualified as Fedi
import Routes.Inbox.Follow
import Routes.Inbox.Like
import Web.Twain qualified as Twain

handleInbox :: DB -> FilePath -> Fedi.AnyActivity -> Twain.ResponderM Twain.Response
handleInbox db detailsFile activity = do
  details <- liftIO $ Fedi.readUserDetailsFile 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
    Fedi.ActivityLike like ->
      handleInboxLike db like
    Fedi.ActivityUndo
      ( Fedi.Object
          { otype =
            Fedi.TypeActivity
              { atype =
                Fedi.TypeUndo
                  { object = Fedi.ActivityLike like
                  }
              }
          }
        ) ->
      handleInboxUnlike db like
    _ -> 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)