content: {-# LANGUAGE TemplateHaskell #-}
  {-# OPTIONS_GHC -Wno-partial-type-signatures #-}
  
  -- | Channel endpoints
  module Calamity.HTTP.Channel (
    ChannelRequest (..),
    CreateMessageAttachment (..),
    CreateMessageOptions (..),
    EditMessageData (..),
    editMessageContent,
    editMessageEmbeds,
    editMessageFlags,
    editMessageAllowedMentions,
    editMessageComponents,
    ChannelUpdate (..),
    AllowedMentionType (..),
    AllowedMentions (..),
    ChannelMessagesFilter (..),
    ChannelMessagesLimit (..),
    GetReactionsOptions (..),
    CreateChannelInviteOptions (..),
    GroupDMAddRecipientOptions (..),
  ) where
  
  import Calamity.HTTP.Internal.Request
  import Calamity.HTTP.Internal.Route
  import Calamity.Internal.Utils (CalamityToJSON (..), CalamityToJSON' (..), (.=), (.?=))
  import Calamity.Types.Model.Channel
  import Calamity.Types.Model.Guild.Emoji (RawEmoji (..))
  import Calamity.Types.Model.Guild.Invite (Invite)
  import Calamity.Types.Model.Guild.Overwrite (Overwrite)
  import Calamity.Types.Model.Guild.Role (Role)
  import Calamity.Types.Model.User
  import Calamity.Types.Snowflake
  import Data.Aeson qualified as Aeson
  import Data.Aeson.KeyMap qualified as K
  import Data.Default.Class
  import Data.Maybe (fromMaybe)
  import Data.Text (Text)
  import Data.Text qualified as T
  import Data.Word
  import Network.HTTP.Client (RequestBody)
  import Network.HTTP.Client.MultipartFormData
  import Network.HTTP.Req
  import Network.Mime
  import Optics
  import TextShow
  
  data CreateMessageAttachment = CreateMessageAttachment
    { filename :: Text
    , description :: Maybe Text
    , content :: RequestBody
    }
  
  instance Show CreateMessageAttachment where
    show (CreateMessageAttachment filename description _) =
      mconcat
        [ "CreateMessageAttachment {filename = "
        , show filename
        , ", description = "
        , show description
        , ", content = <body>}"
        ]
  
  data CreateMessageOptions = CreateMessageOptions
    { content :: Maybe Text
    , nonce :: Maybe Text
    , tts :: Maybe Bool
    , attachments :: Maybe [CreateMessageAttachment]
    , embeds :: Maybe [Embed]
    , allowedMentions :: Maybe AllowedMentions
    , messageReference :: Maybe MessageReference
    , components :: Maybe [Component]
    }
    deriving (Show)
  
  instance Default CreateMessageOptions where
    def = CreateMessageOptions Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
  
  data CreateMessageAttachmentJson = CreateMessageAttachmentJson
    { id :: Int
    , filename :: Text
    , description :: Maybe Text
    }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON CreateMessageAttachmentJson
  
  instance CalamityToJSON' CreateMessageAttachmentJson where
    toPairs CreateMessageAttachmentJson {..} =
      [ "filename" .= filename
      , "description" .?= description
      , "id" .= id
      ]
  
  data CreateMessageJson = CreateMessageJson
    { content :: Maybe Text
    , nonce :: Maybe Text
    , tts :: Maybe Bool
    , embeds :: Maybe [Embed]
    , allowedMentions :: Maybe AllowedMentions
    , messageReference :: Maybe MessageReference
    , components :: Maybe [Component]
    , attachments :: Maybe [CreateMessageAttachmentJson]
    }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON CreateMessageJson
  
  instance CalamityToJSON' CreateMessageJson where
    toPairs CreateMessageJson {..} =
      [ "content" .?= content
      , "nonce" .?= nonce
      , "tts" .?= tts
      , "embeds" .?= embeds
      , "allowed_mentions" .?= allowedMentions
      , "message_reference" .?= messageReference
      , "components" .?= components
      , "attachments" .?= attachments
      ]
  
  data AllowedMentionType
    = AllowedMentionRoles
    | AllowedMentionUsers
    | AllowedMentionEveryone
    deriving (Show)
  
  instance Aeson.ToJSON AllowedMentionType where
    toJSON AllowedMentionRoles = Aeson.String "roles"
    toJSON AllowedMentionUsers = Aeson.String "users"
    toJSON AllowedMentionEveryone = Aeson.String "everyone"
  
  data AllowedMentions = AllowedMentions
    { parse :: [AllowedMentionType]
    , roles :: [Snowflake Role]
    , users :: [Snowflake User]
    , repliedUser :: Bool
    }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON AllowedMentions
  
  instance CalamityToJSON' AllowedMentions where
    toPairs AllowedMentions {..} =
      [ "parse" .= parse
      , "roles" .= roles
      , "users" .= users
      , "replied_user" .= repliedUser
      ]
  
  instance Default AllowedMentions where
    def = AllowedMentions def def def False
  
  instance Semigroup AllowedMentions where
    AllowedMentions p0 r0 u0 ru0 <> AllowedMentions p1 r1 u1 ru1 =
      AllowedMentions (p0 <> p1) (r0 <> r1) (u0 <> u1) (ru0 || ru1)
  
  instance Monoid AllowedMentions where
    mempty = def
  
  {- | Parameters to the Edit Message endpoint.
  
   Use the provided methods (@editMessageX@) to create a value with the
   field set, use the Semigroup instance to union the values.
  
   ==== Examples
  
   >>> encode $ editMessageContent (Just "test") <> editMessageFlags Nothing
   "{\"nick\":\"test\",\"deaf\":null}"
  -}
  newtype EditMessageData = EditMessageData Aeson.Object
    deriving stock (Show)
    deriving newtype (Aeson.ToJSON, Semigroup, Monoid)
  
  editMessageContent :: Maybe Text -> EditMessageData
  editMessageContent v = EditMessageData $ K.fromList [("content", Aeson.toJSON v)]
  
  editMessageEmbeds :: [Embed] -> EditMessageData
  editMessageEmbeds v = EditMessageData $ K.fromList [("embeds", Aeson.toJSON v)]
  
  editMessageFlags :: Maybe Word64 -> EditMessageData
  editMessageFlags v = EditMessageData $ K.fromList [("flags", Aeson.toJSON v)]
  
  editMessageAllowedMentions :: Maybe AllowedMentions -> EditMessageData
  editMessageAllowedMentions v = EditMessageData $ K.fromList [("allowed_mentions", Aeson.toJSON v)]
  
  editMessageComponents :: [Component] -> EditMessageData
  editMessageComponents v = EditMessageData $ K.fromList [("components", Aeson.toJSON v)]
  
  data ChannelUpdate = ChannelUpdate
    { name :: Maybe Text
    , position :: Maybe Int
    , topic :: Maybe Text
    , nsfw :: Maybe Bool
    , rateLimitPerUser :: Maybe Int
    , bitrate :: Maybe Int
    , userLimit :: Maybe Int
    , permissionOverwrites :: Maybe [Overwrite]
    , parentID :: Maybe (Snowflake Channel)
    }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON ChannelUpdate
  
  instance Default ChannelUpdate where
    def = ChannelUpdate Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
  
  instance CalamityToJSON' ChannelUpdate where
    toPairs ChannelUpdate {..} =
      [ "name" .?= name
      , "position" .?= position
      , "topic" .?= topic
      , "nsfw" .?= nsfw
      , "rate_limit_per_user" .?= rateLimitPerUser
      , "bitrate" .?= bitrate
      , "user_limit" .?= userLimit
      , "permission_overwrites" .?= permissionOverwrites
      , "parent_id" .?= parentID
      ]
  
  data ChannelMessagesFilter
    = ChannelMessagesAround
        { around :: Snowflake Message
        }
    | ChannelMessagesBefore
        { before :: Snowflake Message
        }
    | ChannelMessagesAfter
        { after :: Snowflake Message
        }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON ChannelMessagesFilter
  
  instance CalamityToJSON' ChannelMessagesFilter where
    toPairs ChannelMessagesAround {around} = ["around" .= around]
    toPairs ChannelMessagesBefore {before} = ["before" .= before]
    toPairs ChannelMessagesAfter {after} = ["after" .= after]
  
  newtype ChannelMessagesLimit = ChannelMessagesLimit
    { limit :: Integer
    }
    deriving stock (Show)
  
  data GetReactionsOptions = GetReactionsOptions
    { before :: Maybe (Snowflake User)
    , after :: Maybe (Snowflake User)
    , limit :: Maybe Integer
    }
    deriving (Show)
  
  instance Default GetReactionsOptions where
    def = GetReactionsOptions Nothing Nothing Nothing
  
  data CreateChannelInviteOptions = CreateChannelInviteOptions
    { maxAge :: Maybe Int
    , maxUses :: Maybe Int
    , temporary :: Maybe Bool
    , unique :: Maybe Bool
    }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON CreateChannelInviteOptions
  
  instance Default CreateChannelInviteOptions where
    def = CreateChannelInviteOptions Nothing Nothing Nothing Nothing
  
  instance CalamityToJSON' CreateChannelInviteOptions where
    toPairs CreateChannelInviteOptions {..} =
      [ "max_age" .?= maxAge
      , "max_uses" .?= maxUses
      , "temporary" .?= temporary
      , "unique" .?= unique
      ]
  
  data GroupDMAddRecipientOptions = GroupDMAddRecipientOptions
    { accessToken :: Text
    , nick :: Text
    }
    deriving (Show)
    deriving (Aeson.ToJSON) via CalamityToJSON GroupDMAddRecipientOptions
  
  instance CalamityToJSON' GroupDMAddRecipientOptions where
    toPairs GroupDMAddRecipientOptions {..} =
      [ "access_token" .= accessToken
      , "nick" .= nick
      ]
  
  $(makeFieldLabelsNoPrefix ''CreateMessageAttachment)
  $(makeFieldLabelsNoPrefix ''CreateMessageOptions)
  $(makeFieldLabelsNoPrefix ''CreateMessageAttachmentJson)
  $(makeFieldLabelsNoPrefix ''AllowedMentions)
  $(makeFieldLabelsNoPrefix ''ChannelUpdate)
  $(makeFieldLabelsNoPrefix ''ChannelMessagesFilter)
  $(makeFieldLabelsNoPrefix ''ChannelMessagesLimit)
  $(makeFieldLabelsNoPrefix ''GetReactionsOptions)
  $(makeFieldLabelsNoPrefix ''CreateChannelInviteOptions)
  $(makeFieldLabelsNoPrefix ''GroupDMAddRecipientOptions)
  
  data ChannelRequest a where
    CreateMessage :: (HasID Channel c) => c -> CreateMessageOptions -> ChannelRequest Message
    CrosspostMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest Message
    GetMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest Message
    EditMessage :: (HasID Channel c, HasID Message m) => c -> m -> EditMessageData -> ChannelRequest Message
    DeleteMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
    BulkDeleteMessages :: (HasID Channel c, HasID Message m) => c -> [m] -> ChannelRequest ()
    GetChannel :: (HasID Channel c) => c -> ChannelRequest Channel
    ModifyChannel :: (HasID Channel c) => c -> ChannelUpdate -> ChannelRequest Channel
    DeleteChannel :: (HasID Channel c) => c -> ChannelRequest ()
    GetChannelMessages :: (HasID Channel c) => c -> Maybe ChannelMessagesFilter -> Maybe ChannelMessagesLimit -> ChannelRequest [Message]
    CreateReaction :: (HasID Channel c, HasID Message m) => c -> m -> RawEmoji -> ChannelRequest ()
    DeleteOwnReaction :: (HasID Channel c, HasID Message m) => c -> m -> RawEmoji -> ChannelRequest ()
    DeleteUserReaction :: (HasID Channel c, HasID Message m, HasID User u) => c -> m -> RawEmoji -> u -> ChannelRequest ()
    GetReactions :: (HasID Channel c, HasID Message m) => c -> m -> RawEmoji -> GetReactionsOptions -> ChannelRequest [User]
    DeleteAllReactions :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
    GetChannelInvites :: (HasID Channel c) => c -> ChannelRequest [Invite]
    CreateChannelInvite :: (HasID Channel c) => c -> CreateChannelInviteOptions -> ChannelRequest Invite
    EditChannelPermissions :: (HasID Channel c) => c -> Overwrite -> ChannelRequest ()
    DeleteChannelPermission :: (HasID Channel c, HasID Overwrite o) => c -> o -> ChannelRequest ()
    TriggerTyping :: (HasID Channel c) => c -> ChannelRequest ()
    GetPinnedMessages :: (HasID Channel c) => c -> ChannelRequest [Message]
    AddPinnedMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
    DeletePinnedMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest ()
    GroupDMAddRecipient :: (HasID Channel c, HasID User u) => c -> u -> GroupDMAddRecipientOptions -> ChannelRequest ()
    GroupDMRemoveRecipient :: (HasID Channel c, HasID User u) => c -> u -> ChannelRequest ()
  
  baseRoute :: Snowflake Channel -> RouteBuilder _
  baseRoute id =
    mkRouteBuilder
      // S "channels"
      // ID @Channel
        & giveID id
  
  renderEmoji :: RawEmoji -> Text
  renderEmoji (UnicodeEmoji e) = e
  renderEmoji (CustomEmoji e) = e ^. #name <> ":" <> showt (e ^. #id)
  
  instance Request (ChannelRequest a) where
    type Result (ChannelRequest a) = a
  
    route (CreateMessage (getID -> id) _) =
      baseRoute id
        // S "messages"
          & buildRoute
    route (CrosspostMessage (getID -> id) (getID @Message -> mid)) =
      baseRoute id
        // S "messages"
        // ID @Message
          & giveID mid
          & buildRoute
    route (GetChannel (getID -> id)) =
      baseRoute id
        & buildRoute
    route (ModifyChannel (getID -> id) _) =
      baseRoute id
        & buildRoute
    route (DeleteChannel (getID -> id)) =
      baseRoute id
        & buildRoute
    route (GetChannelMessages (getID -> id) _ _) =
      baseRoute id
        // S "messages"
          & buildRoute
    route (GetMessage (getID -> cid) (getID @Message -> mid)) =
      baseRoute cid
        // S "messages"
        // ID @Message
          & giveID mid
          & buildRoute
    route (CreateReaction (getID -> cid) (getID @Message -> mid) emoji) =
      baseRoute cid
        // S "messages"
        // ID @Message
        // S "reactions"
        // PS @"emoji"
        // S "@me"
          & giveID mid
          & giveParam @"emoji" (renderEmoji emoji)
          & buildRoute
    route (DeleteOwnReaction (getID -> cid) (getID @Message -> mid) emoji) =
      baseRoute cid
        // S "messages"
        // ID @Message
        // S "reactions"
        // PS @"emoji"
        // S "@me"
          & giveID mid
          & giveParam @"emoji" (renderEmoji emoji)
          & buildRoute
    route (DeleteUserReaction (getID -> cid) (getID @Message -> mid) emoji (getID @User -> uid)) =
      baseRoute cid
        // S "messages"
        // ID @Message
        // S "reactions"
        // PS @"emoji"
        // ID @User
          & giveID mid
          & giveID uid
          & giveParam @"emoji" (renderEmoji emoji)
          & buildRoute
    route (GetReactions (getID -> cid) (getID @Message -> mid) emoji _) =
      baseRoute cid
        // S "messages"
        // ID @Message
        // S "reactions"
        // PS @"emoji"
          & giveID mid
          & giveParam @"emoji" (renderEmoji emoji)
          & buildRoute
    route (DeleteAllReactions (getID -> cid) (getID @Message -> mid)) =
      baseRoute cid
        // S "messages"
        // ID @Message
        // S "reactions"
          & giveID mid
          & buildRoute
    route (EditMessage (getID -> cid) (getID @Message -> mid) _) =
      baseRoute cid
        // S "messages"
        // ID @Message
          & giveID mid
          & buildRoute
    route (DeleteMessage (getID -> cid) (getID @Message -> mid)) =
      baseRoute cid
        // S "messages"
        // ID @Message
          & giveID mid
          & buildRoute
    route (BulkDeleteMessages (getID -> cid) _) =
      baseRoute cid
        // S "messages"
        // S "bulk-delete"
          & buildRoute
    route (GetChannelInvites (getID -> cid)) =
      baseRoute cid
        // S "invites"
          & buildRoute
    route (CreateChannelInvite (getID -> cid) _) =
      baseRoute cid
        // S "invites"
          & buildRoute
    route (EditChannelPermissions (getID -> cid) (getID @Overwrite -> oid)) =
      baseRoute cid
        // S "permissions"
        // ID @Overwrite
          & giveID oid
          & buildRoute
    route (DeleteChannelPermission (getID -> cid) (getID @Overwrite -> oid)) =
      baseRoute cid
        // S "permissions"
        // ID @Overwrite
          & giveID oid
          & buildRoute
    route (TriggerTyping (getID -> cid)) =
      baseRoute cid
        // S "typing"
          & buildRoute
    route (GetPinnedMessages (getID -> cid)) =
      baseRoute cid
        // S "pins"
          & buildRoute
    route (AddPinnedMessage (getID -> cid) (getID @Message -> mid)) =
      baseRoute cid
        // S "pins"
        // ID @Message
          & giveID mid
          & buildRoute
    route (DeletePinnedMessage (getID -> cid) (getID @Message -> mid)) =
      baseRoute cid
        // S "pins"
        // ID @Message
          & giveID mid
          & buildRoute
    route (GroupDMAddRecipient (getID -> cid) (getID @User -> uid) _) =
      baseRoute cid
        // S "recipients"
        // ID @User
          & giveID uid
          & buildRoute
    route (GroupDMRemoveRecipient (getID -> cid) (getID @User -> uid)) =
      baseRoute cid
        // S "recipients"
        // ID @User
          & giveID uid
          & buildRoute
    action (CreateMessage _ cm) = \u o -> do
      let filePart CreateMessageAttachment {filename, content} n =
            (partFileRequestBody @IO (T.pack $ "files[" <> show n <> "]") "" content)
              { partFilename = Just (T.unpack filename)
              , partContentType = Just (defaultMimeLookup filename)
              }
          attachmentPart CreateMessageAttachment {filename, description} n =
            CreateMessageAttachmentJson n filename description
          files = zipWith filePart (fromMaybe [] $ cm ^. #attachments) [(0 :: Int) ..]
          attachments = (\a -> zipWith attachmentPart a [0 ..]) <$> cm ^. #attachments
          jsonBody =
            CreateMessageJson
              { content = cm ^. #content
              , nonce = cm ^. #nonce
              , tts = cm ^. #tts
              , embeds = cm ^. #embeds
              , allowedMentions = cm ^. #allowedMentions
              , messageReference = cm ^. #messageReference
              , components = cm ^. #components
              , attachments = attachments
              }
      body <- reqBodyMultipart (partLBS "payload_json" (Aeson.encode jsonBody) : files)
      postWith' body u o
    action (CrosspostMessage _ _) = postEmpty
    action (GetChannel _) = getWith
    action (ModifyChannel _ p) = patchWith' (ReqBodyJson p)
    action (DeleteChannel _) = deleteWith
    action (GetChannelMessages _ (Just (ChannelMessagesAround (fromSnowflake -> a))) l) =
      getWithP ("around" =: a <> "limit" =:? (l ^? _Just % #limit))
    action (GetChannelMessages _ (Just (ChannelMessagesBefore (fromSnowflake -> a))) l) =
      getWithP ("before" =: a <> "limit" =:? (l ^? _Just % #limit))
    action (GetChannelMessages _ (Just (ChannelMessagesAfter (fromSnowflake -> a))) l) =
      getWithP ("after" =: a <> "limit" =:? (l ^? _Just % #limit))
    action (GetChannelMessages _ Nothing l) = getWithP ("limit" =:? (l ^? _Just % #limit))
    action (GetMessage _ _) = getWith
    action CreateReaction {} = putEmpty
    action DeleteOwnReaction {} = deleteWith
    action DeleteUserReaction {} = deleteWith
    action (GetReactions _ _ _ GetReactionsOptions {before, after, limit}) =
      getWithP
        ( "before" =:? (fromSnowflake <$> before)
            <> "after" =:? (fromSnowflake <$> after)
            <> "limit" =:? limit
        )
    action (DeleteAllReactions _ _) = deleteWith
    action (EditMessage _ _ o) = patchWith' (ReqBodyJson o)
    action (DeleteMessage _ _) = deleteWith
    action (BulkDeleteMessages _ (map (getID @Message) -> ids)) = postWith' (ReqBodyJson $ Aeson.object ["messages" Aeson..= ids])
    action (GetChannelInvites _) = getWith
    action (CreateChannelInvite _ o) = postWith' (ReqBodyJson o)
    action (EditChannelPermissions _ o) = putWith' (ReqBodyJson o)
    action (DeleteChannelPermission _ _) = deleteWith
    action (TriggerTyping _) = postEmpty
    action (GetPinnedMessages _) = getWith
    action (AddPinnedMessage _ _) = putEmpty
    action (DeletePinnedMessage _ _) = deleteWith
    action (GroupDMAddRecipient _ _ o) = putWith' (ReqBodyJson o)
    action (GroupDMRemoveRecipient _ _) = deleteWith
  