Guild.hs

{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}


module Sigmacord.Internal.Rest.Guild
  ( GuildRequest(..)
  , CreateGuildChannelOpts(..)
  , ModifyGuildOpts(..)
  , AddGuildMemberOpts(..)
  , ModifyGuildMemberOpts(..)
  , GuildMembersTiming(..)
  , CreateGuildBanOpts(..)
  , ModifyGuildRoleOpts(..)
  , CreateGuildIntegrationOpts(..)
  , ModifyGuildIntegrationOpts(..)
  ) where


import Data.Aeson
import Network.HTTP.Req ((/:), (/~))
import qualified Network.HTTP.Req as R
import qualified Data.Text as T

import Sigmacord.Internal.Rest.Prelude
import Sigmacord.Internal.Types
import Data.Default (Default(..))

instance Request (GuildRequest a) where
  majorRoute = guildMajorRoute
  jsonRequest = guildJsonRequest


data GuildRequest a where
  
  

  
  GetGuild                 :: GuildId -> GuildRequest Guild
  
  
  ModifyGuild              :: GuildId -> ModifyGuildOpts -> GuildRequest Guild
  
  DeleteGuild              :: GuildId -> GuildRequest ()
  
  GetGuildChannels         :: GuildId -> GuildRequest [Channel]
  
  
  
  CreateGuildChannel       :: GuildId -> T.Text -> [Overwrite] -> CreateGuildChannelOpts -> GuildRequest Channel
  
  
  
  ModifyGuildChannelPositions      :: GuildId -> [(ChannelId,Int)] -> GuildRequest [Channel]
  
  GetGuildMember           :: GuildId -> UserId -> GuildRequest GuildMember
  
  ListGuildMembers         :: GuildId -> GuildMembersTiming -> GuildRequest [GuildMember]
  
  
  
  
  AddGuildMember           :: GuildId -> UserId -> AddGuildMemberOpts
                                      -> GuildRequest ()
  
  ModifyGuildMember        :: GuildId -> UserId -> ModifyGuildMemberOpts -> GuildRequest GuildMember
  
  ModifyCurrentUserNick    :: GuildId -> T.Text -> GuildRequest ()
  
  AddGuildMemberRole    :: GuildId -> UserId -> RoleId -> GuildRequest ()
  
  RemoveGuildMemberRole    :: GuildId -> UserId -> RoleId -> GuildRequest ()
  
  
  RemoveGuildMember        :: GuildId -> UserId -> GuildRequest ()
  
  
  GetGuildBans             :: GuildId -> GuildRequest [GuildBan]
  
  
  GetGuildBan              :: GuildId -> UserId -> GuildRequest GuildBan
  
  
  CreateGuildBan           :: GuildId -> UserId -> CreateGuildBanOpts -> GuildRequest ()
  
  
  RemoveGuildBan           :: GuildId -> UserId -> GuildRequest ()
  
  
  GetGuildRoles            :: GuildId -> GuildRequest [Role]
  
  
  CreateGuildRole          :: GuildId -> ModifyGuildRoleOpts -> GuildRequest Role
  
  
  
  ModifyGuildRolePositions :: GuildId -> [(RoleId, Integer)] -> GuildRequest [Role]
  
  
  ModifyGuildRole          :: GuildId -> RoleId -> ModifyGuildRoleOpts -> GuildRequest Role
  
  
  DeleteGuildRole          :: GuildId -> RoleId -> GuildRequest ()
  
  
  
  GetGuildPruneCount       :: GuildId -> Integer -> GuildRequest Object
  
  
  
  BeginGuildPrune          :: GuildId -> Integer -> GuildRequest Object
  
  
  GetGuildVoiceRegions     :: GuildId -> GuildRequest [VoiceRegion]
  
  
  GetGuildInvites          :: GuildId -> GuildRequest [Invite]
  
  
  GetGuildIntegrations     :: GuildId -> GuildRequest [Integration]
  
  
  CreateGuildIntegration   :: GuildId -> IntegrationId -> CreateGuildIntegrationOpts -> GuildRequest ()
  
  
  ModifyGuildIntegration   :: GuildId -> IntegrationId -> ModifyGuildIntegrationOpts
                                      -> GuildRequest ()
  
  
  DeleteGuildIntegration   :: GuildId -> IntegrationId -> GuildRequest ()
  
  SyncGuildIntegration     :: GuildId -> IntegrationId -> GuildRequest ()
  
  GetGuildWidget            :: GuildId -> GuildRequest GuildWidget
  
  
  
  ModifyGuildWidget         :: GuildId -> GuildWidget -> GuildRequest GuildWidget
  
  GetGuildVanityURL        :: GuildId -> GuildRequest T.Text


data ModifyGuildIntegrationOpts = ModifyGuildIntegrationOpts
  { modifyGuildIntegrationOptsExpireBehavior :: Integer
  , modifyGuildIntegrationOptsExpireGraceSeconds :: Integer
  , modifyGuildIntegrationOptsEmoticonsEnabled :: Bool
  } deriving (Show, Read, Eq, Ord)

instance ToJSON ModifyGuildIntegrationOpts where
  toJSON ModifyGuildIntegrationOpts{..} = objectFromMaybes
         [ "expire_grace_period" .== modifyGuildIntegrationOptsExpireGraceSeconds
         , "expire_behavior" .== modifyGuildIntegrationOptsExpireBehavior
         , "enable_emoticons" .== modifyGuildIntegrationOptsEmoticonsEnabled ]


newtype CreateGuildIntegrationOpts = CreateGuildIntegrationOpts
  { createGuildIntegrationOptsType :: T.Text
  } deriving (Show, Read, Eq, Ord)

instance ToJSON CreateGuildIntegrationOpts where
  toJSON CreateGuildIntegrationOpts{..} = objectFromMaybes
                       ["type" .== createGuildIntegrationOptsType]


data CreateGuildBanOpts = CreateGuildBanOpts
  { createGuildBanOptsDeleteLastNMessages :: Maybe Int
  , createGuildBanOptsReason              :: Maybe T.Text
  } deriving (Show, Read, Eq, Ord)

instance ToJSON CreateGuildBanOpts where
  toJSON CreateGuildBanOpts{..} = objectFromMaybes
                       [ "delete_message_days"
                           .=? createGuildBanOptsDeleteLastNMessages
                       , "reason" .=? createGuildBanOptsReason]


data ModifyGuildRoleOpts = ModifyGuildRoleOpts
  { modifyGuildRoleOptsName            :: Maybe T.Text
  , modifyGuildRoleOptsPermissions     :: Maybe RolePermissions
  , modifyGuildRoleOptsColor           :: Maybe SigmacordColor
  , modifyGuildRoleOptsSeparateSidebar :: Maybe Bool
  , modifyGuildRoleOptsMentionable     :: Maybe Bool
  , modifyGuildRoleOptsIcon            :: Maybe T.Text
  } deriving (Show, Read, Eq, Ord)

instance ToJSON ModifyGuildRoleOpts where
  toJSON ModifyGuildRoleOpts{..} = objectFromMaybes
                       ["name" .=? modifyGuildRoleOptsName,
                        "permissions" .=? modifyGuildRoleOptsPermissions,
                        "color" .=? modifyGuildRoleOptsColor,
                        "hoist" .=? modifyGuildRoleOptsSeparateSidebar,
                        "mentionable" .=? modifyGuildRoleOptsMentionable,
                        "icon" .=? modifyGuildRoleOptsIcon]


data AddGuildMemberOpts = AddGuildMemberOpts
  { addGuildMemberOptsAccessToken :: T.Text
  , addGuildMemberOptsNickname    :: Maybe T.Text
  , addGuildMemberOptsRoles       :: Maybe [RoleId]
  , addGuildMemberOptsIsMuted     :: Maybe Bool
  , addGuildMemberOptsIsDeafened  :: Maybe Bool
  } deriving (Show, Read, Eq, Ord)

instance ToJSON AddGuildMemberOpts where
  toJSON AddGuildMemberOpts{..} = objectFromMaybes
                                  ["access_token" .== addGuildMemberOptsAccessToken,
                                   "nick" .=? addGuildMemberOptsNickname,
                                   "roles" .=? addGuildMemberOptsRoles,
                                   "mute" .=? addGuildMemberOptsIsMuted,
                                   "deaf" .=? addGuildMemberOptsIsDeafened]


data ModifyGuildMemberOpts = ModifyGuildMemberOpts
  { modifyGuildMemberOptsNickname      :: Maybe T.Text
  , modifyGuildMemberOptsRoles         :: Maybe [RoleId]
  , modifyGuildMemberOptsIsMuted       :: Maybe Bool
  , modifyGuildMemberOptsIsDeafened    :: Maybe Bool
  , modifyGuildMemberOptsMoveToChannel :: Maybe ChannelId
  , modifyGuildMemberOptsTimeoutUntil  :: Maybe (Maybe UTCTime) 
  } deriving (Show, Read, Eq, Ord)

instance Default ModifyGuildMemberOpts where
  def = ModifyGuildMemberOpts Nothing Nothing Nothing Nothing Nothing Nothing

instance ToJSON ModifyGuildMemberOpts where
  toJSON ModifyGuildMemberOpts{..} = objectFromMaybes
                                  ["nick" .=? modifyGuildMemberOptsNickname,
                                   "roles" .=? modifyGuildMemberOptsRoles,
                                   "mute" .=? modifyGuildMemberOptsIsMuted,
                                   "deaf" .=? modifyGuildMemberOptsIsDeafened,
                                   "channel_id" .=? modifyGuildMemberOptsMoveToChannel,
                                   "communication_disabled_until" .=? modifyGuildMemberOptsTimeoutUntil]


data CreateGuildChannelOpts
  
  = CreateGuildChannelOptsText {
    createGuildChannelOptsTopic :: Maybe T.Text
  , createGuildChannelOptsUserMessageRateDelay :: Maybe Integer
  , createGuildChannelOptsIsNSFW :: Maybe Bool
  , createGuildChannelOptsCategoryId :: Maybe ChannelId }
  
  | CreateGuildChannelOptsVoice {
    createGuildChannelOptsBitrate :: Maybe Integer
  , createGuildChannelOptsMaxUsers :: Maybe Integer
  , createGuildChannelOptsCategoryId :: Maybe ChannelId }
  
  | CreateGuildChannelOptsCategory
  deriving (Show, Read, Eq, Ord)


createChannelOptsToJSON :: T.Text -> [Overwrite] -> CreateGuildChannelOpts -> Value
createChannelOptsToJSON name perms opts = objectFromMaybes optsJSON
  where
  optsJSON = case opts of
    CreateGuildChannelOptsText{..} ->
                          ["name" .== String name
                          ,"type" .== Number 0
                          ,"permission_overwrites" .== perms
                          ,"topic" .=? createGuildChannelOptsTopic
                          ,"rate_limit_per_user" .=? createGuildChannelOptsUserMessageRateDelay
                          ,"nsfw" .=? createGuildChannelOptsIsNSFW
                          ,"parent_id" .=? createGuildChannelOptsCategoryId]
    CreateGuildChannelOptsVoice{..} ->
                          ["name" .== String name
                          ,"type" .== Number 2
                          ,"permission_overwrites" .== perms
                          ,"bitrate" .=? createGuildChannelOptsBitrate
                          ,"user_limit" .=? createGuildChannelOptsMaxUsers
                          ,"parent_id" .=? createGuildChannelOptsCategoryId]
    CreateGuildChannelOptsCategory ->
                          ["name" .== String name
                          ,"type" .== Number 4
                          ,"permission_overwrites" .== perms]





data ModifyGuildOpts = ModifyGuildOpts
  { modifyGuildOptsName         :: Maybe T.Text
  , modifyGuildOptsAFKChannelId :: Maybe ChannelId
  , modifyGuildOptsIcon         :: Maybe T.Text
  , modifyGuildOptsOwnerId      :: Maybe UserId
   
   
   
   
  } deriving (Show, Read, Eq, Ord)

instance ToJSON ModifyGuildOpts where
  toJSON ModifyGuildOpts{..} = objectFromMaybes
                                  ["name" .=? modifyGuildOptsName,
                                   "afk_channel_id" .=? modifyGuildOptsAFKChannelId,
                                   "icon" .=? modifyGuildOptsIcon,
                                   "owner_id" .=? modifyGuildOptsOwnerId]

data GuildMembersTiming = GuildMembersTiming
                          { guildMembersTimingLimit :: Maybe Int
                          , guildMembersTimingAfter :: Maybe UserId
                          } deriving (Show, Read, Eq, Ord)

guildMembersTimingToQuery :: GuildMembersTiming -> R.Option 'R.Https
guildMembersTimingToQuery (GuildMembersTiming mLimit mAfter) =
  let limit = case mLimit of
              Nothing -> mempty
              Just lim -> "limit" R.=: lim
      after = case mAfter of
              Nothing -> mempty
              Just aft -> "after" R.=: show aft
  in limit <> after

guildMajorRoute :: GuildRequest a -> String
guildMajorRoute c = case c of
  (GetGuild g) ->                         "guild " <> show g
  (ModifyGuild g _) ->                    "guild " <> show g
  (DeleteGuild g) ->                      "guild " <> show g
  (GetGuildChannels g) ->            "guild_chan " <> show g
  (CreateGuildChannel g _ _ _) ->    "guild_chan " <> show g
  (ModifyGuildChannelPositions g _) -> "guild_chan " <> show g
  (GetGuildMember g _) ->            "guild_memb " <> show g
  (ListGuildMembers g _) ->         "guild_membs " <> show g
  (AddGuildMember g _ _) ->         "guild_membs " <> show g
  (ModifyGuildMember g _ _) ->      "guild_membs " <> show g
  (ModifyCurrentUserNick g _) ->    "guild_membs " <> show g
  (AddGuildMemberRole g _ _) ->     "guild_membs " <> show g
  (RemoveGuildMemberRole g _ _) ->  "guild_membs " <> show g
  (RemoveGuildMember g _) ->        "guild_membs " <> show g
  (GetGuildBan g _) ->               "guild_bans " <> show g
  (GetGuildBans g) ->                "guild_bans " <> show g
  (CreateGuildBan g _ _) ->           "guild_ban " <> show g
  (RemoveGuildBan g _) ->             "guild_ban " <> show g
  (GetGuildRoles g) ->              "guild_roles " <> show g
  (CreateGuildRole g _) ->          "guild_roles " <> show g
  (ModifyGuildRolePositions g _) -> "guild_roles " <> show g
  (ModifyGuildRole g _ _) ->         "guild_role " <> show g
  (DeleteGuildRole g _) ->           "guild_role " <> show g
  (GetGuildPruneCount g _) ->       "guild_prune " <> show g
  (BeginGuildPrune g _) ->          "guild_prune " <> show g
  (GetGuildVoiceRegions g) ->       "guild_voice " <> show g
  (GetGuildInvites g) ->            "guild_invit " <> show g
  (GetGuildIntegrations g) ->       "guild_integ " <> show g
  (CreateGuildIntegration g _ _) -> "guild_integ " <> show g
  (ModifyGuildIntegration g _ _) -> "guild_intgr " <> show g
  (DeleteGuildIntegration g _) ->   "guild_intgr " <> show g
  (SyncGuildIntegration g _) ->      "guild_sync " <> show g
  (GetGuildWidget g) ->            "guild_widget " <> show g
  (ModifyGuildWidget g _) ->       "guild_widget " <> show g
  (GetGuildVanityURL g) ->                "guild " <> show g


guilds :: R.Url 'R.Https
guilds = baseUrl /: "guilds"

guildJsonRequest :: GuildRequest r -> JsonRequest
guildJsonRequest c = case c of
  (GetGuild guild) ->
      Get (guilds /~ guild) mempty

  (ModifyGuild guild patch) ->
      Patch (guilds /~ guild) (pure (R.ReqBodyJson patch)) mempty

  (DeleteGuild guild) ->
      Delete (guilds /~ guild) mempty

  (GetGuildChannels guild) ->
      Get (guilds /~ guild /: "channels") mempty

  (CreateGuildChannel guild name perms patch) ->
      Post (guilds /~ guild /: "channels")
           (pure (R.ReqBodyJson (createChannelOptsToJSON name perms patch))) mempty

  (ModifyGuildChannelPositions guild newlocs) ->
      let patch = map (\(a, b) -> object [("id", toJSON a)
                                         ,("position", toJSON b)]) newlocs
      in Patch (guilds /~ guild /: "channels") (pure (R.ReqBodyJson patch)) mempty

  (GetGuildMember guild member) ->
      Get (guilds /~ guild /: "members" /~ member) mempty

  (ListGuildMembers guild range) ->
      Get (guilds /~ guild /: "members") (guildMembersTimingToQuery range)

  (AddGuildMember guild user patch) ->
      Put (guilds /~ guild /: "members" /~ user) (R.ReqBodyJson patch) mempty

  (ModifyGuildMember guild member patch) ->
      Patch (guilds /~ guild /: "members" /~ member) (pure (R.ReqBodyJson patch)) mempty

  (ModifyCurrentUserNick guild name) ->
      let patch = object ["nick" .= name]
      in Patch (guilds /~ guild /: "members/@me/nick") (pure (R.ReqBodyJson patch)) mempty

  (AddGuildMemberRole guild user role) ->
      let body = R.ReqBodyJson (object [])
      in Put (guilds /~ guild /: "members" /~ user /: "roles" /~ role) body mempty

  (RemoveGuildMemberRole guild user role) ->
      Delete (guilds /~ guild /: "members" /~ user /: "roles" /~ role) mempty

  (RemoveGuildMember guild user) ->
      Delete (guilds /~ guild /: "members" /~ user) mempty

  (GetGuildBan guild user) -> Get (guilds /~ guild /: "bans" /~ user) mempty

  (GetGuildBans guild) -> Get (guilds /~ guild /: "bans") mempty

  (CreateGuildBan guild user patch) ->
      Put (guilds /~ guild /: "bans" /~ user) (R.ReqBodyJson patch) mempty

  (RemoveGuildBan guild ban) ->
      Delete (guilds /~ guild /: "bans" /~ ban) mempty

  (GetGuildRoles guild) ->
      Get (guilds /~ guild /: "roles") mempty

  (CreateGuildRole guild patch) ->
      Post (guilds /~ guild /: "roles") (pure (R.ReqBodyJson patch)) mempty

  (ModifyGuildRolePositions guild patch) ->
      let body = map (\(role, pos) -> object ["id".=role, "position".=pos]) patch
      in Patch (guilds /~ guild /: "roles") (pure (R.ReqBodyJson body)) mempty

  (ModifyGuildRole guild role patch) ->
      Patch (guilds /~ guild /: "roles" /~ role) (pure (R.ReqBodyJson patch)) mempty

  (DeleteGuildRole guild role) ->
      Delete (guilds /~ guild /: "roles" /~ role) mempty

  (GetGuildPruneCount guild days) ->
      Get (guilds /~ guild /: "prune") ("days" R.=: days)

  (BeginGuildPrune guild days) ->
      Post (guilds /~ guild /: "prune") (pure R.NoReqBody) ("days" R.=: days)

  (GetGuildVoiceRegions guild) ->
      Get (guilds /~ guild /: "regions") mempty

  (GetGuildInvites guild) ->
      Get (guilds /~ guild /: "invites") mempty

  (GetGuildIntegrations guild) ->
      Get (guilds /~ guild /: "integrations") mempty

  (CreateGuildIntegration guild iid opts) ->
      let patch = object ["type" .= createGuildIntegrationOptsType opts, "id" .= iid]
      in Post (guilds /~ guild /: "integrations") (pure (R.ReqBodyJson patch)) mempty

  (ModifyGuildIntegration guild iid patch) ->
      let body = pure (R.ReqBodyJson patch)
      in Patch (guilds /~ guild /: "integrations" /~ iid) body mempty

  (DeleteGuildIntegration guild integ) ->
      Delete (guilds /~ guild /: "integrations" /~ integ) mempty

  (SyncGuildIntegration guild integ) ->
      Post (guilds /~ guild /: "integrations" /~ integ) (pure R.NoReqBody) mempty

  (GetGuildWidget guild) ->
      Get (guilds /~ guild /: "integrations") mempty

  (ModifyGuildWidget guild patch) ->
      Patch (guilds /~ guild /: "widget") (pure (R.ReqBodyJson patch)) mempty

  (GetGuildVanityURL guild) ->
      Get (guilds /~ guild /: "vanity-url") mempty