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

-- | Provides actions for Channel API interactions
module Discord.Internal.Rest.Emoji
  ( EmojiRequest(..)
  , ModifyGuildEmojiOpts(..)
  , parseEmojiImage
  ) where

import Data.Aeson
import Codec.Picture
import Network.HTTP.Req ((/:))
import qualified Network.HTTP.Req as R
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64

import Discord.Internal.Rest.Prelude
import Discord.Internal.Types

instance Request (EmojiRequest a) where
  majorRoute :: EmojiRequest a -> String
majorRoute = EmojiRequest a -> String
forall a. EmojiRequest a -> String
emojiMajorRoute
  jsonRequest :: EmojiRequest a -> JsonRequest
jsonRequest = EmojiRequest a -> JsonRequest
forall a. EmojiRequest a -> JsonRequest
emojiJsonRequest


-- | Data constructor for requests. See <https://discord.com/developers/docs/resources/ API>
data EmojiRequest a where
  -- | List of emoji objects for the given guild. Requires MANAGE_EMOJIS permission.
  ListGuildEmojis :: GuildId -> EmojiRequest [Emoji]
  -- | Emoji object for the given guild and emoji ID
  GetGuildEmoji :: GuildId -> EmojiId -> EmojiRequest Emoji
  -- | Create a new guild emoji (static&animated). Requires MANAGE_EMOJIS permission.
  CreateGuildEmoji :: GuildId -> T.Text -> EmojiImageParsed -> EmojiRequest Emoji
  -- | Requires MANAGE_EMOJIS permission
  ModifyGuildEmoji :: GuildId -> EmojiId -> ModifyGuildEmojiOpts -> EmojiRequest Emoji
  -- | Requires MANAGE_EMOJIS permission
  DeleteGuildEmoji :: GuildId -> EmojiId -> EmojiRequest ()

data ModifyGuildEmojiOpts = ModifyGuildEmojiOpts
     { ModifyGuildEmojiOpts -> Text
modifyGuildEmojiName  :: T.Text
     , ModifyGuildEmojiOpts -> [RoleId]
modifyGuildEmojiRoles :: [RoleId]
     } deriving (Int -> ModifyGuildEmojiOpts -> ShowS
[ModifyGuildEmojiOpts] -> ShowS
ModifyGuildEmojiOpts -> String
(Int -> ModifyGuildEmojiOpts -> ShowS)
-> (ModifyGuildEmojiOpts -> String)
-> ([ModifyGuildEmojiOpts] -> ShowS)
-> Show ModifyGuildEmojiOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyGuildEmojiOpts] -> ShowS
$cshowList :: [ModifyGuildEmojiOpts] -> ShowS
show :: ModifyGuildEmojiOpts -> String
$cshow :: ModifyGuildEmojiOpts -> String
showsPrec :: Int -> ModifyGuildEmojiOpts -> ShowS
$cshowsPrec :: Int -> ModifyGuildEmojiOpts -> ShowS
Show, ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
(ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool)
-> (ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool)
-> Eq ModifyGuildEmojiOpts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
$c/= :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
== :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
$c== :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
Eq, Eq ModifyGuildEmojiOpts
Eq ModifyGuildEmojiOpts
-> (ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Ordering)
-> (ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool)
-> (ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool)
-> (ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool)
-> (ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool)
-> (ModifyGuildEmojiOpts
    -> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts)
-> (ModifyGuildEmojiOpts
    -> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts)
-> Ord ModifyGuildEmojiOpts
ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Ordering
ModifyGuildEmojiOpts
-> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ModifyGuildEmojiOpts
-> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts
$cmin :: ModifyGuildEmojiOpts
-> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts
max :: ModifyGuildEmojiOpts
-> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts
$cmax :: ModifyGuildEmojiOpts
-> ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts
>= :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
$c>= :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
> :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
$c> :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
<= :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
$c<= :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
< :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
$c< :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Bool
compare :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Ordering
$ccompare :: ModifyGuildEmojiOpts -> ModifyGuildEmojiOpts -> Ordering
$cp1Ord :: Eq ModifyGuildEmojiOpts
Ord)

instance ToJSON ModifyGuildEmojiOpts where
  toJSON :: ModifyGuildEmojiOpts -> Value
toJSON (ModifyGuildEmojiOpts Text
name [RoleId]
roles) =
    [Pair] -> Value
object [ Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name, Key
"roles" Key -> [RoleId] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [RoleId]
roles ]


data EmojiImageParsed = EmojiImageParsed T.Text
  deriving (Int -> EmojiImageParsed -> ShowS
[EmojiImageParsed] -> ShowS
EmojiImageParsed -> String
(Int -> EmojiImageParsed -> ShowS)
-> (EmojiImageParsed -> String)
-> ([EmojiImageParsed] -> ShowS)
-> Show EmojiImageParsed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmojiImageParsed] -> ShowS
$cshowList :: [EmojiImageParsed] -> ShowS
show :: EmojiImageParsed -> String
$cshow :: EmojiImageParsed -> String
showsPrec :: Int -> EmojiImageParsed -> ShowS
$cshowsPrec :: Int -> EmojiImageParsed -> ShowS
Show, EmojiImageParsed -> EmojiImageParsed -> Bool
(EmojiImageParsed -> EmojiImageParsed -> Bool)
-> (EmojiImageParsed -> EmojiImageParsed -> Bool)
-> Eq EmojiImageParsed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmojiImageParsed -> EmojiImageParsed -> Bool
$c/= :: EmojiImageParsed -> EmojiImageParsed -> Bool
== :: EmojiImageParsed -> EmojiImageParsed -> Bool
$c== :: EmojiImageParsed -> EmojiImageParsed -> Bool
Eq, Eq EmojiImageParsed
Eq EmojiImageParsed
-> (EmojiImageParsed -> EmojiImageParsed -> Ordering)
-> (EmojiImageParsed -> EmojiImageParsed -> Bool)
-> (EmojiImageParsed -> EmojiImageParsed -> Bool)
-> (EmojiImageParsed -> EmojiImageParsed -> Bool)
-> (EmojiImageParsed -> EmojiImageParsed -> Bool)
-> (EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed)
-> (EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed)
-> Ord EmojiImageParsed
EmojiImageParsed -> EmojiImageParsed -> Bool
EmojiImageParsed -> EmojiImageParsed -> Ordering
EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed
$cmin :: EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed
max :: EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed
$cmax :: EmojiImageParsed -> EmojiImageParsed -> EmojiImageParsed
>= :: EmojiImageParsed -> EmojiImageParsed -> Bool
$c>= :: EmojiImageParsed -> EmojiImageParsed -> Bool
> :: EmojiImageParsed -> EmojiImageParsed -> Bool
$c> :: EmojiImageParsed -> EmojiImageParsed -> Bool
<= :: EmojiImageParsed -> EmojiImageParsed -> Bool
$c<= :: EmojiImageParsed -> EmojiImageParsed -> Bool
< :: EmojiImageParsed -> EmojiImageParsed -> Bool
$c< :: EmojiImageParsed -> EmojiImageParsed -> Bool
compare :: EmojiImageParsed -> EmojiImageParsed -> Ordering
$ccompare :: EmojiImageParsed -> EmojiImageParsed -> Ordering
$cp1Ord :: Eq EmojiImageParsed
Ord)

parseEmojiImage :: B.ByteString -> Either T.Text EmojiImageParsed
parseEmojiImage :: ByteString -> Either Text EmojiImageParsed
parseEmojiImage ByteString
bs =
  if ByteString -> Int
B.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
256000
  then Text -> Either Text EmojiImageParsed
forall a b. a -> Either a b
Left Text
"Cannot create emoji - File is larger than 256kb"
  else case (ByteString -> Either String [DynamicImage]
decodeGifImages ByteString
bs, ByteString -> Either String DynamicImage
decodeImage ByteString
bs) of
         (Left String
e1, Left String
e2) -> Text -> Either Text EmojiImageParsed
forall a b. a -> Either a b
Left (Text
"Could not parse image or gif: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e1
                                                           Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" and " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
e2)
         (Right [DynamicImage]
ims, Either String DynamicImage
_) -> if (DynamicImage -> Bool) -> [DynamicImage] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all DynamicImage -> Bool
is128 [DynamicImage]
ims
                           then EmojiImageParsed -> Either Text EmojiImageParsed
forall a b. b -> Either a b
Right (Text -> EmojiImageParsed
EmojiImageParsed (Text
"data:text/plain;"
                                                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"base64,"
                                                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
B64.encode ByteString
bs)))
                           else Text -> Either Text EmojiImageParsed
forall a b. a -> Either a b
Left Text
"The frames are not all 128x128"
         (Either String [DynamicImage]
_, Right DynamicImage
im) -> if DynamicImage -> Bool
is128 DynamicImage
im
                          then EmojiImageParsed -> Either Text EmojiImageParsed
forall a b. b -> Either a b
Right (Text -> EmojiImageParsed
EmojiImageParsed (Text
"data:text/plain;"
                                                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"base64,"
                                                     Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
B64.encode ByteString
bs)))
                          else Text -> Either Text EmojiImageParsed
forall a b. a -> Either a b
Left Text
"Image is not 128x128"
  where
    is128 :: DynamicImage -> Bool
is128 DynamicImage
im = let i :: Image PixelRGB8
i = DynamicImage -> Image PixelRGB8
convertRGB8 DynamicImage
im
               in Image PixelRGB8 -> Int
forall a. Image a -> Int
imageWidth Image PixelRGB8
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128 Bool -> Bool -> Bool
&& Image PixelRGB8 -> Int
forall a. Image a -> Int
imageHeight Image PixelRGB8
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128


emojiMajorRoute :: EmojiRequest a -> String
emojiMajorRoute :: EmojiRequest a -> String
emojiMajorRoute EmojiRequest a
c = case EmojiRequest a
c of
  (ListGuildEmojis RoleId
g) ->      String
"emoji " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RoleId -> String
forall a. Show a => a -> String
show RoleId
g
  (GetGuildEmoji RoleId
g RoleId
_) ->      String
"emoji " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RoleId -> String
forall a. Show a => a -> String
show RoleId
g
  (CreateGuildEmoji RoleId
g Text
_ EmojiImageParsed
_) -> String
"emoji " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RoleId -> String
forall a. Show a => a -> String
show RoleId
g
  (ModifyGuildEmoji RoleId
g RoleId
_ ModifyGuildEmojiOpts
_) -> String
"emoji " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RoleId -> String
forall a. Show a => a -> String
show RoleId
g
  (DeleteGuildEmoji RoleId
g RoleId
_)   -> String
"emoji " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RoleId -> String
forall a. Show a => a -> String
show RoleId
g

guilds :: R.Url 'R.Https
guilds :: Url 'Https
guilds = Url 'Https
baseUrl Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"guilds"

emojiJsonRequest :: EmojiRequest r -> JsonRequest
emojiJsonRequest :: EmojiRequest r -> JsonRequest
emojiJsonRequest EmojiRequest r
c = case EmojiRequest r
c of
  (ListGuildEmojis RoleId
g) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
g Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"emojis") Option 'Https
forall a. Monoid a => a
mempty
  (GetGuildEmoji RoleId
g RoleId
e) -> Url 'Https -> Option 'Https -> JsonRequest
Get (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
g Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"emojis" Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
e) Option 'Https
forall a. Monoid a => a
mempty
  (CreateGuildEmoji RoleId
g Text
name (EmojiImageParsed Text
im)) ->
                   Url 'Https
-> RestIO (ReqBodyJson Value) -> Option 'Https -> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Post (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
g Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"emojis")
                        (ReqBodyJson Value -> RestIO (ReqBodyJson Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ReqBodyJson Value
forall a. a -> ReqBodyJson a
R.ReqBodyJson ([Pair] -> Value
object [ Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
name
                                                     , Key
"image" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
im
                                                     -- todo , "roles" .= ...
                                                     ])))
                        Option 'Https
forall a. Monoid a => a
mempty
  (ModifyGuildEmoji RoleId
g RoleId
e ModifyGuildEmojiOpts
o) -> Url 'Https
-> RestIO (ReqBodyJson ModifyGuildEmojiOpts)
-> Option 'Https
-> JsonRequest
forall a.
HttpBody a =>
Url 'Https -> RestIO a -> Option 'Https -> JsonRequest
Patch (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
g Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"emojis" Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
e)
                                    (ReqBodyJson ModifyGuildEmojiOpts
-> RestIO (ReqBodyJson ModifyGuildEmojiOpts)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModifyGuildEmojiOpts -> ReqBodyJson ModifyGuildEmojiOpts
forall a. a -> ReqBodyJson a
R.ReqBodyJson ModifyGuildEmojiOpts
o))
                                    Option 'Https
forall a. Monoid a => a
mempty
  (DeleteGuildEmoji RoleId
g RoleId
e) -> Url 'Https -> Option 'Https -> JsonRequest
Delete (Url 'Https
guilds Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
g Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"emojis" Url 'Https -> RoleId -> Url 'Https
forall a (scheme :: Scheme).
Show a =>
Url scheme -> a -> Url scheme
// RoleId
e) Option 'Https
forall a. Monoid a => a
mempty