{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad (void, when)
import Data.Text (Text, isPrefixOf, pack, strip, toLower, unpack)
import Data.Text.IO as TIO
import Data.Word
import Discord
import Discord.Internal.Types.ApplicationCommands
import Discord.Internal.Types.Interactions
import Discord.Requests as R
import Discord.Types
import UnliftIO.Concurrent

main :: IO ()
main = do
  tokenRaw <- TIO.readFile "/run/secrets/env"
  let token = strip tokenRaw
  userFacingError <-
    runDiscord $
      def
        { discordToken = token,
          discordOnStart = do
            let appId = botId
            let guildId = serverId
            void $ restCall (CreateGuildApplicationCommand appId guildId baboonCommand)
            void $ restCall (CreateGuildApplicationCommand appId guildId unbaboonCommand),
          discordOnEvent = eventHandler,
          discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
        }
  TIO.putStrLn userFacingError

baboonCommand :: CreateApplicationCommand
baboonCommand =
  CreateApplicationCommandChatInput
    { createName = "baboon",
      createLocalizedName = Nothing,
      createDescription = "Make someone a baboon",
      createLocalizedDescription = Nothing,
      createOptions =
        Just $
          OptionsValues
            [ OptionValueUser
                { optionValueName = "target",
                  optionValueLocalizedName = Nothing,
                  optionValueDescription = "Send a baboon to the safari",
                  optionValueLocalizedDescription = Nothing,
                  optionValueRequired = True
                }
            ],
      createDefaultMemberPermissions = Nothing,
      createDMPermission = Nothing
    }

unbaboonCommand :: CreateApplicationCommand
unbaboonCommand =
  CreateApplicationCommandChatInput
    { createName = "unbaboon",
      createLocalizedName = Nothing,
      createDescription = "Return a baboon to the wild",
      createLocalizedDescription = Nothing,
      createOptions =
        Just $
          OptionsValues
            [ OptionValueUser
                { optionValueName = "target",
                  optionValueLocalizedName = Nothing,
                  optionValueDescription = "The baboon to rewild",
                  optionValueLocalizedDescription = Nothing,
                  optionValueRequired = True
                }
            ],
      createDefaultMemberPermissions = Nothing,
      createDMPermission = Nothing
    }

eventHandler :: Event -> DiscordHandler ()
eventHandler event = case event of
  InteractionCreate interaction -> do
    case interaction of
      InteractionApplicationCommand
        { interactionId = iId,
          interactionApplicationId = _appId,
          applicationCommandData = cmd,
          interactionGuildId = guildId,
          interactionChannelId = _chanId,
          interactionUser = user,
          interactionToken = iToken
        } -> do
          let invokerUid = case user of
                MemberOrUser (Left guildMember) ->
                  maybe (error "No user") userId (memberUser guildMember)
                MemberOrUser (Right plainUser) -> userId plainUser

          let invokerRoles = case user of
                MemberOrUser (Left guildMember) -> memberRoles guildMember
                MemberOrUser (Right _) -> []

          let hasPermission = any (\r -> unSnowflake (unId r) == ownerRoleId || unSnowflake (unId r) == moderatorRoleId) invokerRoles

          when (applicationCommandDataName cmd == "baboon") $ do
            if not hasPermission
              then do
                let response =
                      InteractionResponseChannelMessage $
                        InteractionResponseMessage
                          { interactionResponseMessageTTS = Nothing,
                            interactionResponseMessageContent = Just "You don't have permission to baboonify!",
                            interactionResponseMessageEmbeds = Nothing,
                            interactionResponseMessageAllowedMentions = Nothing,
                            interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                            interactionResponseMessageComponents = Nothing,
                            interactionResponseMessageAttachments = Nothing
                          }
                void $ restCall (CreateInteractionResponse iId iToken response)
              else do
                let options = optionsData cmd
                let targetUid = case options of
                      Just (OptionsDataValues opts) -> extractUserOption opts "target"
                      _ -> error "No target specified"

                if invokerUid == targetUid
                  then do
                    let response =
                          InteractionResponseChannelMessage $
                            InteractionResponseMessage
                              { interactionResponseMessageTTS = Nothing,
                                interactionResponseMessageContent = Just "You can't baboonify yourself!",
                                interactionResponseMessageEmbeds = Nothing,
                                interactionResponseMessageAllowedMentions = Nothing,
                                interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                                interactionResponseMessageComponents = Nothing,
                                interactionResponseMessageAttachments = Nothing
                              }
                    void $ restCall (CreateInteractionResponse iId iToken response)
                  else do
                    case guildId of
                      Just gid -> do
                        targetMemberRes <- restCall (GetGuildMember gid targetUid)
                        case targetMemberRes of
                          Right targetMember -> do
                            let targetRoles = memberRoles targetMember
                            let isImmune = any (\r -> unSnowflake (unId r) `elem` immuneRoles) targetRoles

                            if isImmune
                              then do
                                let response =
                                      InteractionResponseChannelMessage $
                                        InteractionResponseMessage
                                          { interactionResponseMessageTTS = Nothing,
                                            interactionResponseMessageContent = Just "That user is immune to baboonification!",
                                            interactionResponseMessageEmbeds = Nothing,
                                            interactionResponseMessageAllowedMentions = Nothing,
                                            interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                                            interactionResponseMessageComponents = Nothing,
                                            interactionResponseMessageAttachments = Nothing
                                          }
                                void $ restCall (CreateInteractionResponse iId iToken response)
                              else do
                                let targetRoles = memberRoles targetMember
                                mapM_ (\roleId -> restCall (RemoveGuildMemberRole gid targetUid roleId)) targetRoles
                                void $ restCall (AddGuildMemberRole gid targetUid (DiscordId (Snowflake baboonRoleId)))
                                let response =
                                      InteractionResponseChannelMessage $
                                        InteractionResponseMessage
                                          { interactionResponseMessageTTS = Nothing,
                                            interactionResponseMessageContent = Just $ "<@" <> pack (show (unId targetUid)) <> "> has become a baboon!",
                                            interactionResponseMessageEmbeds = Nothing,
                                            interactionResponseMessageAllowedMentions = Nothing,
                                            interactionResponseMessageFlags = Nothing,
                                            interactionResponseMessageComponents = Nothing,
                                            interactionResponseMessageAttachments = Nothing
                                          }
                                void $ restCall (CreateInteractionResponse iId iToken response)
                          Left _ -> do
                            let response =
                                  InteractionResponseChannelMessage $
                                    InteractionResponseMessage
                                      { interactionResponseMessageTTS = Nothing,
                                        interactionResponseMessageContent = Just "Failed to get target member info!",
                                        interactionResponseMessageEmbeds = Nothing,
                                        interactionResponseMessageAllowedMentions = Nothing,
                                        interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                                        interactionResponseMessageComponents = Nothing,
                                        interactionResponseMessageAttachments = Nothing
                                      }
                            void $ restCall (CreateInteractionResponse iId iToken response)
                      Nothing -> return ()

          when (applicationCommandDataName cmd == "unbaboon") $ do
            if not hasPermission
              then do
                let response =
                      InteractionResponseChannelMessage $
                        InteractionResponseMessage
                          { interactionResponseMessageTTS = Nothing,
                            interactionResponseMessageContent = Just "You don't have permission to use this command!",
                            interactionResponseMessageEmbeds = Nothing,
                            interactionResponseMessageAllowedMentions = Nothing,
                            interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                            interactionResponseMessageComponents = Nothing,
                            interactionResponseMessageAttachments = Nothing
                          }
                void $ restCall (CreateInteractionResponse iId iToken response)
              else do
                let options = optionsData cmd
                let targetUid = case options of
                      Just (OptionsDataValues opts) -> extractUserOption opts "target"
                      _ -> error "No target specified"

                if invokerUid == targetUid
                  then do
                    let response =
                          InteractionResponseChannelMessage $
                            InteractionResponseMessage
                              { interactionResponseMessageTTS = Nothing,
                                interactionResponseMessageContent = Just "You can't unbaboonify yourself!",
                                interactionResponseMessageEmbeds = Nothing,
                                interactionResponseMessageAllowedMentions = Nothing,
                                interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                                interactionResponseMessageComponents = Nothing,
                                interactionResponseMessageAttachments = Nothing
                              }
                    void $ restCall (CreateInteractionResponse iId iToken response)
                  else do
                    case guildId of
                      Just gid -> do
                        targetMemberRes <- restCall (GetGuildMember gid targetUid)
                        case targetMemberRes of
                          Right targetMember -> do
                            let targetRoles = memberRoles targetMember
                            let hasBaboonRole = any (\r -> unSnowflake (unId r) == baboonRoleId) targetRoles

                            if not hasBaboonRole
                              then do
                                let response =
                                      InteractionResponseChannelMessage $
                                        InteractionResponseMessage
                                          { interactionResponseMessageTTS = Nothing,
                                            interactionResponseMessageContent = Just "That user is not a baboon!",
                                            interactionResponseMessageEmbeds = Nothing,
                                            interactionResponseMessageAllowedMentions = Nothing,
                                            interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                                            interactionResponseMessageComponents = Nothing,
                                            interactionResponseMessageAttachments = Nothing
                                          }
                                void $ restCall (CreateInteractionResponse iId iToken response)
                              else do
                                void $ restCall (AddGuildMemberRole gid targetUid (DiscordId (Snowflake defaultRoleId)))
                                void $ restCall (RemoveGuildMemberRole gid targetUid (DiscordId (Snowflake baboonRoleId)))
                                let response =
                                      InteractionResponseChannelMessage $
                                        InteractionResponseMessage
                                          { interactionResponseMessageTTS = Nothing,
                                            interactionResponseMessageContent = Just $ "<@" <> pack (show (unId targetUid)) <> "> is no longer a baboon!",
                                            interactionResponseMessageEmbeds = Nothing,
                                            interactionResponseMessageAllowedMentions = Nothing,
                                            interactionResponseMessageFlags = Nothing,
                                            interactionResponseMessageComponents = Nothing,
                                            interactionResponseMessageAttachments = Nothing
                                          }
                                void $ restCall (CreateInteractionResponse iId iToken response)
                          Left _ -> do
                            let response =
                                  InteractionResponseChannelMessage $
                                    InteractionResponseMessage
                                      { interactionResponseMessageTTS = Nothing,
                                        interactionResponseMessageContent = Just "Failed to get target member info!",
                                        interactionResponseMessageEmbeds = Nothing,
                                        interactionResponseMessageAllowedMentions = Nothing,
                                        interactionResponseMessageFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral],
                                        interactionResponseMessageComponents = Nothing,
                                        interactionResponseMessageAttachments = Nothing
                                      }
                            void $ restCall (CreateInteractionResponse iId iToken response)
                      Nothing -> return ()
      _ -> return ()
  MessageCreate m -> do
    when (isPing m && not (fromBot m)) $ do
      void $ restCall (R.CreateReaction (messageChannelId m, messageId m) "eyes")
      threadDelay standardPause
      void $ restCall (R.CreateMessage (messageChannelId m) "Pong!")
  _ -> return ()

extractUserOption :: [OptionDataValue] -> Text -> UserId
extractUserOption opts name =
  case [v | OptionDataValueUser n v <- opts, n == name] of
    (uid : _) -> uid
    [] -> error $ "Option not found: " <> unpack name

-- Role IDs

botId :: ApplicationId
botId = DiscordId (Snowflake 1428951383494623262)

serverId :: GuildId
serverId = DiscordId (Snowflake 692563032546476062)

baboonRoleId :: Word64
baboonRoleId = 1160622954082738347

ownerRoleId :: Word64
ownerRoleId = 827332588803850270

moderatorRoleId :: Word64
moderatorRoleId = 827303828884946944

patronRoleId :: Word64
patronRoleId = 827404707843538975

youTubeRoleId :: Word64
youTubeRoleId = 993361806141706310

defaultRoleId :: Word64
defaultRoleId = 964354344948494416

immuneRoles :: [Word64]
immuneRoles = [ownerRoleId, moderatorRoleId, patronRoleId, youTubeRoleId]

fromBot :: Message -> Bool
fromBot = userIsBot . messageAuthor

isPing :: Message -> Bool
isPing = ("ping" `isPrefixOf`) . toLower . messageContent

standardPause :: Int
standardPause = (2 * 5 ^ 3)
