calamity 0.1.23.1 → 0.1.24.0

raw patch · 22 files changed

+960/−863 lines, 22 filesdep +http-clientdep +reqdep −wreqsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-client, req

Dependencies removed: wreq

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• Setup.hs +0/−2
• calamity.cabal +4/−3
• src/Calamity/Client/Client.hs +6/−12
• src/Calamity/Client/Types.hs +0/−3
• src/Calamity/Commands/Parser.hs +12/−2
• src/Calamity/Gateway/Shard.hs +12/−14
• src/Calamity/Gateway/Types.hs +0/−2
• src/Calamity/HTTP/AuditLog.hs +29/−29
• src/Calamity/HTTP/Channel.hs +204/−191
• src/Calamity/HTTP/Emoji.hs +43/−40
• src/Calamity/HTTP/Guild.hs +237/−211
• src/Calamity/HTTP/Internal/Ratelimit.hs +101/−94
• src/Calamity/HTTP/Internal/Request.hs +89/−75
• src/Calamity/HTTP/Internal/Route.hs +7/−4
• src/Calamity/HTTP/Invite.hs +15/−17
• src/Calamity/HTTP/MiscRoutes.hs +11/−12
• src/Calamity/HTTP/Reason.hs +12/−12
• src/Calamity/HTTP/User.hs +58/−52
• src/Calamity/HTTP/Webhook.hs +97/−87
• src/Calamity/Internal/SnowflakeMap.hs +1/−1
• src/Calamity/Types/Upgradeable.hs +15/−0

@@ -1,5 +1,12 @@ # Changelog for Calamity +## 0.1.24.0+++ Switch from using Wreq to Req++ The `session` parameter has been removed from `runBotIO'`++ Add an `Upgradeable` instance for `Role`s++ Add a command `Parser` instance for `Role`s+ ## 0.1.23.1  + Fix some more json parsing issues

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 0772994714492feed4b5b795eb15b0795c3b76609b3e5675079f5b442d29687f+-- hash: 00a40615c76f1d2bb08dcb114163494c4189aa1e755216a1553cacaeba8bb83f  name:           calamity-version:        0.1.23.1+version:        0.1.24.0 synopsis:       A library for writing discord bots in haskell description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web@@ -158,6 +158,7 @@     , generic-override >=0.0.0.0 && <0.0.1     , generic-override-aeson >=0.0.0.0 && <0.0.1     , hashable >=1.2 && <2+    , http-client >=0.5 && <0.8     , http-date >=0.0.8 && <0.1     , http-types >=0.12 && <0.13     , lens >=4.18 && <5@@ -168,6 +169,7 @@     , polysemy >=1.3 && <2     , polysemy-plugin >=0.2 && <0.3     , reflection >=2.1 && <3+    , req >=3.1 && <3.9     , safe-exceptions >=0.1 && <2     , scientific >=0.3 && <0.4     , stm >=2.5 && <3@@ -182,6 +184,5 @@     , unordered-containers >=0.2 && <0.3     , vector >=0.12 && <0.13     , websockets >=0.12 && <0.13-    , wreq >=0.5 && <0.6     , wuss >=1.1 && <2   default-language: Haskell2010

@@ -57,8 +57,6 @@ import qualified Df1 import qualified DiPolysemy                        as Di -import           Network.Wreq.Session            ( Session, newAPISession )- import           Fmt  import qualified Polysemy                          as P@@ -80,8 +78,8 @@   pure (duration, res)  -newClient :: Token -> Session -> Maybe (DC.Di Df1.Level Df1.Path Df1.Message) -> IO Client-newClient token session initialDi = do+newClient :: Token -> Maybe (DC.Di Df1.Level Df1.Path Df1.Message) -> IO Client+newClient token initialDi = do   shards'        <- newTVarIO []   numShards'     <- newEmptyMVar   rlState'       <- newRateLimitState@@ -95,7 +93,6 @@                 inc                 outc                 ehidCounter-                session                 initialDi  -- | Create a bot, run your setup action, and then loop until the bot closes.@@ -106,7 +103,7 @@          -- ^ The intents the bot should use          -> P.Sem (SetupEff r) a          -> P.Sem r (Maybe StartupError)-runBotIO token intents setup = runBotIO' token intents Nothing Nothing setup+runBotIO token intents = runBotIO' token intents Nothing  resetDi :: BotC r => P.Sem r a -> P.Sem r a resetDi m = do@@ -115,22 +112,19 @@  -- | Create a bot, run your setup action, and then loop until the bot closes. ----- This version allows you to specify the http session, initial status, and intents.+-- This version allows you to specify the initial status, and intents. runBotIO' :: forall r a.           (P.Members '[P.Embed IO, P.Final IO, CacheEff, MetricEff, LogEff] r, Typeable (SetupEff r))           => Token           -> Intents           -- ^ The intents the bot should use-          -> Maybe Session-          -- ^ The HTTP session to use, defaults to 'newAPISession'           -> Maybe StatusUpdateData           -- ^ The initial status to send to the gateway           -> P.Sem (SetupEff r) a           -> P.Sem r (Maybe StartupError)-runBotIO' token intents session status setup = do+runBotIO' token intents status setup = do   initialDi <- Di.fetch-  session' <- maybe (P.embed newAPISession) pure session-  client <- P.embed $ newClient token session' initialDi+  client <- P.embed $ newClient token initialDi   handlers <- P.embed $ newTVarIO def   P.asyncToIOFinal . P.runAtomicStateTVar handlers . P.runReader client . Di.push "calamity" $ do     void $ Di.push "calamity-setup" setup

@@ -45,8 +45,6 @@ import           Data.Typeable import           Data.Void -import           Network.Wreq.Session            ( Session )- import           GHC.Exts                        ( fromList ) import           GHC.Generics @@ -68,7 +66,6 @@   , eventsIn            :: InChan CalamityEvent   , eventsOut           :: OutChan CalamityEvent   , ehidCounter         :: IORef Integer-  , session             :: Session   , initialDi           :: Maybe (DC.Di Df1.Level Df1.Path Df1.Message)   }   deriving ( Generic )

@@ -266,7 +266,7 @@ -- and use 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching -- from http. instance P.Member CacheEff r => Parser Guild r where-  parse = parseMP (parserName @Guild @r) $ mapParserMaybeM (try (ping "#") <|> snowflake)+  parse = parseMP (parserName @Guild @r) $ mapParserMaybeM snowflake           "Couldn't find a Guild with this id"           getGuild @@ -274,7 +274,7 @@ -- looks in the cache. Use @'Snowflake' 'Emoji'@ and use -- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http. instance Parser Emoji r where-  parse = parseMP (parserName @Emoji @r) $ mapParserMaybeM (try (ping "#") <|> snowflake)+  parse = parseMP (parserName @Emoji @r) $ mapParserMaybeM (try emoji <|> snowflake)           "Couldn't find an Emoji with this id"           (\eid -> do               ctx <- P.ask@@ -284,6 +284,16 @@ instance Parser RawEmoji r where   parse = parseMP (parserName @RawEmoji) (try parseCustomEmoji <|> (UnicodeEmoji <$> takeP (Just "A unicode emoji") 1))     where parseCustomEmoji = CustomEmoji <$> partialEmoji++-- | Parser for roles in the guild the command was invoked in, this only+-- looks in the cache. Use @'Snowflake' 'Role'@ and use+-- 'Calamity.Types.Upgradeable.upgrade' if you want to allow fetching from http.+instance Parser Role r where+  parse = parseMP (parserName @Role @r) $ mapParserMaybeM (try (ping "@&") <|> snowflake)+          "Couldn't find an Emoji with this id"+          (\rid -> do+              ctx <- P.ask+              pure $ ctx ^? #guild . _Just . #roles . ix rid)  instance (Parser a r, Parser b r) => Parser (a, b) r where   type ParserResult (a, b) = (ParserResult a, ParserResult b)

@@ -73,11 +73,9 @@          -> UC.InChan CalamityEvent          -> Sem r (UC.InChan ControlMessage, Async (Maybe ())) newShard gateway id count token presence intents evtIn = do-  (cmdIn, stateVar) <- P.embed $ mdo-    (cmdIn, cmdOut) <- UC.newChan-    stateVar <- newIORef $ newShardState shard-    let shard = Shard id count gateway evtIn cmdOut stateVar (rawToken token) presence intents-    pure (cmdIn, stateVar)+  (cmdIn, cmdOut) <- P.embed UC.newChan+  let shard = Shard id count gateway evtIn cmdOut (rawToken token) presence intents+  stateVar <- P.embed . newIORef $ newShardState shard    let runShard = P.runAtomicStateIORef stateVar shardLoop   let action = push "calamity-shard" . attr "shard-id" id $ runShard@@ -186,7 +184,7 @@     debug "Entering inner loop of shard"      shard <- P.atomicGets (^. #shardS)-    P.atomicModify (#wsConn ?~ ws)+    P.atomicModify' (#wsConn ?~ ws)      seqNum'    <- P.atomicGets (^. #seqNum)     sessionID' <- P.atomicGets (^. #sessionID)@@ -228,7 +226,7 @@      debug "Exiting inner loop of shard" -    P.atomicModify (#wsConn .~ Nothing)+    P.atomicModify' (#wsConn .~ Nothing)     haltHeartBeat     pure result @@ -237,11 +235,11 @@   handleMsg (Discord msg) = case msg of     EvtDispatch sn data' -> do       -- trace $ "Handling event: ("+||data'||+")"-      P.atomicModify (#seqNum ?~ sn)+      P.atomicModify' (#seqNum ?~ sn)        case data' of         Ready rdata' ->-          P.atomicModify (#sessionID ?~ (rdata' ^. #sessionID))+          P.atomicModify' (#sessionID ?~ (rdata' ^. #sessionID))          _NotReady -> pure () @@ -262,8 +260,8 @@         info "Received resumable invalid session"       else do         info "Received non-resumable invalid session, sleeping for 15 seconds then retrying"-        P.atomicModify (#sessionID .~ Nothing)-        P.atomicModify (#seqNum .~ Nothing)+        P.atomicModify' (#sessionID .~ Nothing)+        P.atomicModify' (#seqNum .~ Nothing)         P.embed $ threadDelay (15 * 1000 * 1000)       P.throw ShardFlowRestart @@ -273,7 +271,7 @@      HeartBeatAck -> do       debug "Received heartbeat ack"-      P.atomicModify (#hbResponse .~ True)+      P.atomicModify' (#hbResponse .~ True)    handleMsg (Control msg) = case msg of     SendPresence data' -> do@@ -287,7 +285,7 @@ startHeartBeatLoop interval = do   haltHeartBeat -- cancel any currently running hb thread   thread <- P.async $ heartBeatLoop interval-  P.atomicModify (#hbThread ?~ thread)+  P.atomicModify' (#hbThread ?~ thread)  haltHeartBeat :: ShardC r => Sem r () haltHeartBeat = do@@ -306,7 +304,7 @@   sn <- P.atomicGets (^. #seqNum)   debug $ "Sending heartbeat (seq: " +|| sn ||+ ")"   sendToWs $ HeartBeat sn-  P.atomicModify (#hbResponse .~ False)+  P.atomicModify' (#hbResponse .~ False)  heartBeatLoop :: ShardC r => Int -> Sem r () heartBeatLoop interval = untilJustFinalIO . (leftToMaybe <$>) . P.runError $ do

@@ -31,7 +31,6 @@ import           Data.Aeson import qualified Data.Aeson.Types                 as AT import           Data.Generics.Labels             ()-import           Data.IORef import           Data.Maybe import           Data.Text.Lazy                   ( Text ) @@ -272,7 +271,6 @@   , gateway       :: Text   , evtIn         :: InChan CalamityEvent   , cmdOut        :: OutChan ControlMessage-  , shardState    :: IORef ShardState   , token         :: Text   , initialStatus :: Maybe StatusUpdateData   , intents       :: Intents

@@ -1,34 +1,31 @@ -- | Audit Log endpoints-module Calamity.HTTP.AuditLog-    ( AuditLogRequest(..)-    , GetAuditLogOptions(..) ) where--import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Internal.Utils        ()-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+module Calamity.HTTP.AuditLog (+  AuditLogRequest (..),+  GetAuditLogOptions (..),+) where -import           Control.Lens-import           Control.Arrow                  ( (>>>) )+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Data.Default.Class-import           Data.Maybe                     ( maybeToList )+import Control.Lens -import           GHC.Generics+import Data.Default.Class -import           Network.Wreq.Lens+import GHC.Generics -import           TextShow                       ( showt )+import TextShow (showt)  data GetAuditLogOptions = GetAuditLogOptions-  { userID     :: Maybe (Snowflake User)+  { userID :: Maybe (Snowflake User)   , actionType :: Maybe AuditLogAction-  , before     :: Maybe (Snowflake AuditLogEntry)-  , limit      :: Maybe Integer+  , before :: Maybe (Snowflake AuditLogEntry)+  , limit :: Maybe Integer   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data AuditLogRequest a where   GetAuditLog :: HasID Guild g => g -> GetAuditLogOptions -> AuditLogRequest AuditLog@@ -36,12 +33,15 @@ instance Request (AuditLogRequest a) where   type Result (AuditLogRequest a) = a -  route (GetAuditLog (getID @Guild -> gid) _) = mkRouteBuilder // S "guilds" // ID @Guild // S "audit-logs"-    & giveID gid-    & buildRoute+  route (GetAuditLog (getID @Guild -> gid) _) =+    mkRouteBuilder // S "guilds" // ID @Guild // S "audit-logs"+      & giveID gid+      & buildRoute -  action (GetAuditLog _ GetAuditLogOptions { userID, actionType, before, limit }) = getWithP-    (param "user_id" .~ maybeToList (showt <$> userID) >>>-     param "action_type" .~ maybeToList (showt .fromEnum <$> actionType) >>>-     param "before" .~ maybeToList (showt <$> before) >>>-     param "limit" .~ maybeToList (showt <$> limit))+  action (GetAuditLog _ GetAuditLogOptions{userID, actionType, before, limit}) =+    getWithP+      ( "user_id" =:? (showt <$> userID)+          <> "action_type" =:? (showt . fromEnum <$> actionType)+          <> "before" =:? (showt <$> before)+          <> "limit" =:? (showt <$> limit)+      )

@@ -1,60 +1,51 @@ -- | Channel endpoints-module Calamity.HTTP.Channel-    ( ChannelRequest(..)-    , CreateMessageOptions(..)-    , ChannelUpdate(..)-    , AllowedMentionType(..)-    , AllowedMentions(..)-    , ChannelMessagesQuery(..)-    , GetReactionsOptions(..)-    , CreateChannelInviteOptions(..)-    , GroupDMAddRecipientOptions(..) ) where--import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Internal.AesonThings-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake--import           Control.Arrow-import           Control.Lens                   hiding ( (.=) )--import           Data.Aeson-import           Data.ByteString.Lazy           ( ByteString )-import           Data.Default.Class-import           Data.Generics.Product.Subtype  ( upcast )-import           Data.Maybe-import qualified Data.Text                      as S-import qualified Data.Text.Encoding as S-import           Data.Text                      ( Text )--import           GHC.Generics--import           Network.Wreq ( partLBS )-import           Network.Wreq.Lens-import           Network.Wreq.Session-import           Network.Mime+module Calamity.HTTP.Channel (+  ChannelRequest (..),+  CreateMessageOptions (..),+  ChannelUpdate (..),+  AllowedMentionType (..),+  AllowedMentions (..),+  ChannelMessagesQuery (..),+  GetReactionsOptions (..),+  CreateChannelInviteOptions (..),+  GroupDMAddRecipientOptions (..),+) where -import           TextShow-import Network.HTTP.Types (urlEncode)+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake+import Control.Lens hiding ((.=))+import Data.Aeson+import Data.ByteString.Lazy (ByteString)+import Data.Default.Class+import Data.Generics.Product.Subtype (upcast)+import Data.Text (Text)+import qualified Data.Text as S+import GHC.Generics+import Network.HTTP.Req+import Network.Mime+import Network.HTTP.Client.MultipartFormData+import TextShow  data CreateMessageOptions = CreateMessageOptions-  { content         :: Maybe Text-  , nonce           :: Maybe Text-  , tts             :: Maybe Bool-  , file            :: Maybe (Text, ByteString)-  , embed           :: Maybe Embed+  { content :: Maybe Text+  , nonce :: Maybe Text+  , tts :: Maybe Bool+  , file :: Maybe (Text, ByteString)+  , embed :: Maybe Embed   , allowedMentions :: Maybe AllowedMentions   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data AllowedMentionType   = AllowedMentionRoles   | AllowedMentionUsers   | AllowedMentionEveryone-  deriving ( Show, Generic )+  deriving (Show, Generic)  instance ToJSON AllowedMentionType where   toJSON AllowedMentionRoles = String "roles"@@ -66,8 +57,8 @@   , roles :: [Snowflake Role]   , users :: [Snowflake User]   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON AllowedMentions+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON AllowedMentions  instance Semigroup AllowedMentions where   AllowedMentions p0 r0 u0 <> AllowedMentions p1 r1 u1 =@@ -78,26 +69,26 @@  data CreateMessageJson = CreateMessageJson   { content :: Maybe Text-  , nonce   :: Maybe Text-  , tts     :: Maybe Bool-  , embed   :: Maybe Embed+  , nonce :: Maybe Text+  , tts :: Maybe Bool+  , embed :: Maybe Embed   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON CreateMessageJson+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON CreateMessageJson  data ChannelUpdate = ChannelUpdate-  { name                 :: Maybe Text-  , position             :: Maybe Int-  , topic                :: Maybe Text-  , nsfw                 :: Maybe Bool-  , rateLimitPerUser     :: Maybe Int-  , bitrate              :: Maybe Int-  , userLimit            :: Maybe Int+  { 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)+  , parentID :: Maybe (Snowflake Channel)   }-  deriving ( Generic, Show, Default )-  deriving ( ToJSON ) via CalamityJSON ChannelUpdate+  deriving (Generic, Show, Default)+  deriving (ToJSON) via CalamityJSON ChannelUpdate  data ChannelMessagesQuery   = ChannelMessagesAround@@ -112,175 +103,197 @@   | ChannelMessagesLimit       { limit :: Int       }-  deriving ( Generic, Show )-  deriving ( ToJSON ) via CalamityJSON ChannelMessagesQuery+  deriving (Generic, Show)+  deriving (ToJSON) via CalamityJSON ChannelMessagesQuery  data GetReactionsOptions = GetReactionsOptions   { before :: Maybe (Snowflake User)-  , after  :: Maybe (Snowflake User)-  , limit  :: Maybe Integer+  , after :: Maybe (Snowflake User)+  , limit :: Maybe Integer   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data CreateChannelInviteOptions = CreateChannelInviteOptions-  { maxAge    :: Maybe Int-  , maxUses   :: Maybe Int+  { maxAge :: Maybe Int+  , maxUses :: Maybe Int   , temporary :: Maybe Bool-  , unique    :: Maybe Bool+  , unique :: Maybe Bool   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON CreateChannelInviteOptions+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON CreateChannelInviteOptions  data GroupDMAddRecipientOptions = GroupDMAddRecipientOptions   { accessToken :: Text-  , nick        :: Text+  , nick :: Text   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON GroupDMAddRecipientOptions+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON GroupDMAddRecipientOptions  data ChannelRequest a where-  CreateMessage            :: (HasID Channel c) =>                                c -> CreateMessageOptions ->                 ChannelRequest Message-  GetMessage               :: (HasID Channel c, HasID Message m) =>               c -> m ->                                    ChannelRequest Message-  EditMessage              :: (HasID Channel c, HasID Message m) =>               c -> m -> Maybe Text -> Maybe Embed ->       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 ChannelMessagesQuery ->           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 ()-+  CreateMessage :: (HasID Channel c) => c -> CreateMessageOptions -> ChannelRequest Message+  GetMessage :: (HasID Channel c, HasID Message m) => c -> m -> ChannelRequest Message+  EditMessage :: (HasID Channel c, HasID Message m) => c -> m -> Maybe Text -> Maybe Embed -> 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 ChannelMessagesQuery -> 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--encodeEmoji :: RawEmoji -> S.Text-encodeEmoji = S.decodeUtf8 . urlEncode True . S.encodeUtf8 . showt+baseRoute id =+  mkRouteBuilder // S "channels" // ID @Channel+    & giveID id  instance Request (ChannelRequest a) where   type Result (ChannelRequest a) = a -  route (CreateMessage (getID -> id) _) = baseRoute id // S "messages"-    & 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 (CreateMessage (getID -> id) _) =+    baseRoute id // S "messages"+      & 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" // S (encodeEmoji emoji) // S "@me"-    & giveID mid-    & buildRoute+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // S "@me"+      & giveID mid+      & buildRoute   route (DeleteOwnReaction (getID -> cid) (getID @Message -> mid) emoji) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji) // S "@me"-    & giveID mid-    & buildRoute+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // S "@me"+      & giveID mid+      & buildRoute   route (DeleteUserReaction (getID -> cid) (getID @Message -> mid) emoji (getID @User -> uid)) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji) // ID @User-    & giveID mid-    & giveID uid-    & buildRoute+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // ID @User+      & giveID mid+      & giveID uid+      & buildRoute   route (GetReactions (getID -> cid) (getID @Message -> mid) emoji _) =-    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (encodeEmoji emoji)-    & giveID mid-    & buildRoute+    baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji)+      & giveID mid+      & 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+      & 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+      & 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+      & 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 _ o@CreateMessageOptions { file = Nothing }) = postWith'-    (toJSON . upcast @CreateMessageJson $ o)-  action (CreateMessage _ o@CreateMessageOptions { file = Just f }) = postWith'-    [partLBS @IO "file" (snd f) & partFileName ?~ (S.unpack $ fst f) & partContentType ?~ defaultMimeLookup (fst f),-     partLBS "payload_json" (encode . upcast @CreateMessageJson $ o)]+  action (CreateMessage _ o@CreateMessageOptions{file = Nothing}) =+    postWith'+      (ReqBodyJson . upcast @CreateMessageJson $ o)+  action (CreateMessage _ cm@CreateMessageOptions{file = Just f}) = \u o -> do+    let filePart =+          (partLBS @IO "file" (snd f))+            { partFilename = Just (S.unpack $ fst f)+            , partContentType = Just (defaultMimeLookup $ fst f)+            }+    body <- reqBodyMultipart [filePart, partLBS "payload_json" (encode . upcast @CreateMessageJson $ cm)]+    postWith' body u o   action (GetChannel _) = getWith-  action (ModifyChannel _ p) = putWith' (toJSON p)+  action (ModifyChannel _ p) = putWith' (ReqBodyJson p)   action (DeleteChannel _) = deleteWith-  action (GetChannelMessages _ (Just (ChannelMessagesAround (showt . fromSnowflake -> a)))) = getWithP-    (param "around" .~ [a])-  action (GetChannelMessages _ (Just (ChannelMessagesBefore (showt . fromSnowflake -> a)))) = getWithP-    (param "before" .~ [a])-  action (GetChannelMessages _ (Just (ChannelMessagesAfter (showt . fromSnowflake -> a)))) = getWithP-    (param "after" .~ [a])-  action (GetChannelMessages _ (Just (ChannelMessagesLimit (showt -> a)))) = getWithP (param "around" .~ [a])+  action (GetChannelMessages _ (Just (ChannelMessagesAround (showt . fromSnowflake -> a)))) =+    getWithP ("around" =: a)+  action (GetChannelMessages _ (Just (ChannelMessagesBefore (showt . fromSnowflake -> a)))) =+    getWithP ("before" =: a)+  action (GetChannelMessages _ (Just (ChannelMessagesAfter (showt . fromSnowflake -> a)))) =+    getWithP ("after" =: a)+  action (GetChannelMessages _ (Just (ChannelMessagesLimit (showt -> a)))) = getWithP ("around" =: a)   action (GetChannelMessages _ Nothing) = getWith   action (GetMessage _ _) = getWith-  action CreateReaction {} = putEmpty-  action DeleteOwnReaction {} = deleteWith-  action DeleteUserReaction {} = deleteWith-  action (GetReactions _ _ _ GetReactionsOptions { before, after, limit }) = getWithP-    (param "before" .~ maybeToList (showt <$> before) >>>-     param "after" .~ maybeToList (showt <$> after) >>>-     param "limit" .~ maybeToList (showt <$> limit))+  action CreateReaction{} = putEmpty+  action DeleteOwnReaction{} = deleteWith+  action DeleteUserReaction{} = deleteWith+  action (GetReactions _ _ _ GetReactionsOptions{before, after, limit}) =+    getWithP+      ( "before" =:? (showt <$> before)+          <> "after" =:? (showt <$> after)+          <> "limit" =:? (showt <$> limit)+      )   action (DeleteAllReactions _ _) = deleteWith-  action (EditMessage _ _ content embed) = patchWith' (object ["content" .= content, "embed" .= embed])+  action (EditMessage _ _ content embed) = patchWith' (ReqBodyJson $ object ["content" .= content, "embed" .= embed])   action (DeleteMessage _ _) = deleteWith-  action (BulkDeleteMessages _ (map (getID @Message) -> ids)) = postWith' (object ["messages" .= ids])+  action (BulkDeleteMessages _ (map (getID @Message) -> ids)) = postWith' (ReqBodyJson $ object ["messages" .= ids])   action (GetChannelInvites _) = getWith-  action (CreateChannelInvite _ o) = postWith' (toJSON o)-  action (EditChannelPermissions _ o) = putWith' (toJSON o)+  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' (toJSON o)+  action (GroupDMAddRecipient _ _ o) = putWith' (ReqBodyJson o)   action (GroupDMRemoveRecipient _ _) = deleteWith

@@ -1,46 +1,46 @@ -- | Emoji endpoints-module Calamity.HTTP.Emoji-    ( EmojiRequest(..)-    , CreateGuildEmojiOptions(..)-    , ModifyGuildEmojiOptions(..) ) where--import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Internal.AesonThings-import           Calamity.Internal.Utils        ()-import           Calamity.Types.Model.Guild-import           Calamity.Types.Snowflake+module Calamity.HTTP.Emoji (+  EmojiRequest (..),+  CreateGuildEmojiOptions (..),+  ModifyGuildEmojiOptions (..),+) where -import           Data.Aeson-import           Data.Function-import           Data.Text                      ( Text )+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Internal.AesonThings+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Guild+import Calamity.Types.Snowflake -import           GHC.Generics+import Data.Aeson+import Data.Function+import Data.Text (Text) -import           Network.Wreq.Session+import GHC.Generics +import Network.HTTP.Req  data CreateGuildEmojiOptions = CreateGuildEmojiOptions-  { name  :: Text+  { name :: Text   , image :: Text   , roles :: [Snowflake Role]   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON CreateGuildEmojiOptions+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON CreateGuildEmojiOptions  data ModifyGuildEmojiOptions = ModifyGuildEmojiOptions-  { name  :: Text+  { name :: Text   , roles :: [Snowflake Role]   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON ModifyGuildEmojiOptions+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON ModifyGuildEmojiOptions  data EmojiRequest a where-  ListGuildEmojis  :: (HasID Guild g) =>                g ->                                 EmojiRequest [Emoji]-  GetGuildEmoji    :: (HasID Guild g, HasID Emoji e) => g -> e ->                            EmojiRequest Emoji-  CreateGuildEmoji :: (HasID Guild g) =>                g -> CreateGuildEmojiOptions ->      EmojiRequest Emoji+  ListGuildEmojis :: (HasID Guild g) => g -> EmojiRequest [Emoji]+  GetGuildEmoji :: (HasID Guild g, HasID Emoji e) => g -> e -> EmojiRequest Emoji+  CreateGuildEmoji :: (HasID Guild g) => g -> CreateGuildEmojiOptions -> EmojiRequest Emoji   ModifyGuildEmoji :: (HasID Guild g, HasID Emoji e) => g -> e -> ModifyGuildEmojiOptions -> EmojiRequest Emoji-  DeleteGuildEmoji :: (HasID Guild g, HasID Emoji e) => g -> e ->                            EmojiRequest ()+  DeleteGuildEmoji :: (HasID Guild g, HasID Emoji e) => g -> e -> EmojiRequest ()  baseRoute :: Snowflake Guild -> RouteBuilder _ baseRoute id = mkRouteBuilder // S "guilds" // ID @Guild // S "emojis" & giveID id@@ -49,19 +49,22 @@   type Result (EmojiRequest a) = a    route (ListGuildEmojis (getID -> gid)) = baseRoute gid & buildRoute-  route (GetGuildEmoji (getID -> gid) (getID @Emoji -> eid)) = baseRoute gid // ID @Emoji-    & giveID eid-    & buildRoute+  route (GetGuildEmoji (getID -> gid) (getID @Emoji -> eid)) =+    baseRoute gid // ID @Emoji+      & giveID eid+      & buildRoute   route (CreateGuildEmoji (getID -> gid) _) = baseRoute gid & buildRoute-  route (ModifyGuildEmoji (getID -> gid) (getID @Emoji -> eid) _) = baseRoute gid // ID @Emoji-    & giveID eid-    & buildRoute-  route (DeleteGuildEmoji (getID -> gid) (getID @Emoji -> eid)) = baseRoute gid // ID @Emoji-    & giveID eid-    & buildRoute+  route (ModifyGuildEmoji (getID -> gid) (getID @Emoji -> eid) _) =+    baseRoute gid // ID @Emoji+      & giveID eid+      & buildRoute+  route (DeleteGuildEmoji (getID -> gid) (getID @Emoji -> eid)) =+    baseRoute gid // ID @Emoji+      & giveID eid+      & buildRoute -  action (ListGuildEmojis _)       = getWith-  action (GetGuildEmoji _ _)       = getWith-  action (CreateGuildEmoji _ o)    = postWith' (toJSON o)-  action (ModifyGuildEmoji _ _ o)  = patchWith' (toJSON o)-  action (DeleteGuildEmoji _ _)    = deleteWith+  action (ListGuildEmojis _) = getWith+  action (GetGuildEmoji _ _) = getWith+  action (CreateGuildEmoji _ o) = postWith' (ReqBodyJson o)+  action (ModifyGuildEmoji _ _ o) = patchWith' (ReqBodyJson o)+  action (DeleteGuildEmoji _ _) = deleteWith

@@ -1,289 +1,315 @@ -- | Guild endpoints-module Calamity.HTTP.Guild-    ( GuildRequest(..)-    , CreateGuildData(..)-    , ModifyGuildData(..)-    , ChannelCreateData(..)-    , ChannelPosition(..)-    , ListMembersOptions(..)-    , AddGuildMemberData(..)-    , ModifyGuildMemberData(..)-    , CreateGuildBanData(..)-    , ModifyGuildRoleData(..)-    , ModifyGuildRolePositionsData(..) ) where+module Calamity.HTTP.Guild (+  GuildRequest (..),+  CreateGuildData (..),+  ModifyGuildData (..),+  ChannelCreateData (..),+  ChannelPosition (..),+  ListMembersOptions (..),+  AddGuildMemberData (..),+  ModifyGuildMemberData (..),+  CreateGuildBanData (..),+  ModifyGuildRoleData (..),+  ModifyGuildRolePositionsData (..),+) where -import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Internal.AesonThings-import           Calamity.Internal.IntColour    ()-import           Calamity.Internal.Utils        ()-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Model.Voice-import           Calamity.Types.Snowflake+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Internal.AesonThings+import Calamity.Internal.IntColour ()+import Calamity.Internal.Utils ()+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Model.Voice+import Calamity.Types.Snowflake -import           Control.Arrow-import           Control.Lens                   hiding ( (.=) )+import Control.Lens hiding ((.=)) -import           Data.Aeson-import           Data.Aeson.Lens-import           Data.Colour                    ( Colour )-import           Data.Default.Class-import           Data.Maybe-import           Data.Text                      ( Text )+import Data.Aeson+import Data.Aeson.Lens+import Data.Colour (Colour)+import Data.Default.Class+import Data.Text (Text) -import           GHC.Generics+import GHC.Generics -import           Network.Wreq.Lens-import           Network.Wreq.Session+import Network.HTTP.Req -import           TextShow+import TextShow  data CreateGuildData = CreateGuildData-  { name                        :: Text-  , region                      :: Text-  , icon                        :: Text-  , verificationLevel           :: Integer -- TODO: enums for these+  { name :: Text+  , region :: Text+  , icon :: Text+  , verificationLevel :: Integer -- TODO: enums for these   , defaultMessageNotifications :: Integer-  , explicitContentFilter       :: Integer-  , roles                       :: [Role]-  , channels                    :: [Partial Channel]+  , explicitContentFilter :: Integer+  , roles :: [Role]+  , channels :: [Partial Channel]   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON CreateGuildData+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON CreateGuildData  data ModifyGuildData = ModifyGuildData-  { name                        :: Maybe Text-  , region                      :: Maybe Text-  , icon                        :: Maybe Text-  , verificationLevel           :: Maybe Integer -- TODO: enums for these+  { name :: Maybe Text+  , region :: Maybe Text+  , icon :: Maybe Text+  , verificationLevel :: Maybe Integer -- TODO: enums for these   , defaultMessageNotifications :: Maybe Integer-  , explicitContentFilter       :: Maybe Integer-  , afkChannelID                :: Maybe (Snowflake GuildChannel)-  , afkTimeout                  :: Maybe Integer-  , ownerID                     :: Maybe (Snowflake User)-  , splash                      :: Maybe Text-  , banner                      :: Maybe Text-  , systemChannelID             :: Maybe (Snowflake GuildChannel)+  , explicitContentFilter :: Maybe Integer+  , afkChannelID :: Maybe (Snowflake GuildChannel)+  , afkTimeout :: Maybe Integer+  , ownerID :: Maybe (Snowflake User)+  , splash :: Maybe Text+  , banner :: Maybe Text+  , systemChannelID :: Maybe (Snowflake GuildChannel)   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON ModifyGuildData+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON ModifyGuildData  data ChannelCreateData = ChannelCreateData-  { name                 :: Text-  , type_                :: Maybe ChannelType-  , topic                :: Maybe Text-  , bitrate              :: Maybe Integer-  , userLimit            :: Maybe Integer-  , rateLimitPerUser     :: Maybe Integer-  , position             :: Maybe Integer+  { name :: Text+  , type_ :: Maybe ChannelType+  , topic :: Maybe Text+  , bitrate :: Maybe Integer+  , userLimit :: Maybe Integer+  , rateLimitPerUser :: Maybe Integer+  , position :: Maybe Integer   , permissionOverwrites :: Maybe [Overwrite]-  , parentID             :: Maybe (Snowflake Category)-  , nsfw                 :: Maybe Bool+  , parentID :: Maybe (Snowflake Category)+  , nsfw :: Maybe Bool   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON ChannelCreateData+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON ChannelCreateData  data ChannelPosition = ChannelPosition-  { id       :: Snowflake GuildChannel+  { id :: Snowflake GuildChannel   , position :: Maybe Integer   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON ChannelPosition+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON ChannelPosition  data ListMembersOptions = ListMembersOptions   { limit :: Maybe Integer   , after :: Maybe (Snowflake User)   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data AddGuildMemberData = AddGuildMemberData   { accessToken :: Text-  , nick        :: Maybe Text-  , roles       :: Maybe [Snowflake Role]-  , mute        :: Maybe Bool-  , deaf        :: Maybe Bool+  , nick :: Maybe Text+  , roles :: Maybe [Snowflake Role]+  , mute :: Maybe Bool+  , deaf :: Maybe Bool   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON AddGuildMemberData+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON AddGuildMemberData  data ModifyGuildMemberData = ModifyGuildMemberData-  { nick      :: Maybe Text-  , roles     :: Maybe [Snowflake Role]-  , mute      :: Maybe Bool-  , deaf      :: Maybe Bool+  { nick :: Maybe Text+  , roles :: Maybe [Snowflake Role]+  , mute :: Maybe Bool+  , deaf :: Maybe Bool   , channelID :: Maybe (Snowflake VoiceChannel)   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON ModifyGuildMemberData+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON ModifyGuildMemberData  data CreateGuildBanData = CreateGuildBanData   { deleteMessageDays :: Maybe Integer-  , reason            :: Maybe Text+  , reason :: Maybe Text   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data ModifyGuildRoleData = ModifyGuildRoleData-  { name        :: Maybe Text+  { name :: Maybe Text   , permissions :: Maybe Permissions-  , color       :: Maybe (Colour Double)-  , hoist       :: Maybe Bool+  , color :: Maybe (Colour Double)+  , hoist :: Maybe Bool   , mentionable :: Maybe Bool   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON ModifyGuildRoleData+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON ModifyGuildRoleData  data ModifyGuildRolePositionsData = ModifyGuildRolePositionsData-  { id       :: Snowflake Role+  { id :: Snowflake Role   , position :: Maybe Integer   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON ModifyGuildRolePositionsData+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON ModifyGuildRolePositionsData  data GuildRequest a where-  CreateGuild                 :: CreateGuildData ->                                                                  GuildRequest Guild-  GetGuild                    :: HasID Guild g =>                               g ->                                 GuildRequest Guild-  ModifyGuild                 :: HasID Guild g =>                               g -> ModifyGuildData ->              GuildRequest Guild-  DeleteGuild                 :: HasID Guild g =>                               g ->                                 GuildRequest ()-  GetGuildChannels            :: HasID Guild g =>                               g ->                                 GuildRequest [Channel]-  CreateGuildChannel          :: HasID Guild g =>                               g -> ChannelCreateData ->            GuildRequest Channel-  ModifyGuildChannelPositions :: HasID Guild g =>                               g -> [ChannelPosition] ->            GuildRequest ()-  GetGuildMember              :: (HasID Guild g, HasID User u) =>               g -> u ->                            GuildRequest Member-  ListGuildMembers            :: HasID Guild g =>                               g -> ListMembersOptions ->           GuildRequest [Member]-  AddGuildMember              :: (HasID Guild g, HasID User u) =>               g -> u -> AddGuildMemberData ->      GuildRequest (Maybe Member)-  ModifyGuildMember           :: (HasID Guild g, HasID User u) =>               g -> u -> ModifyGuildMemberData ->   GuildRequest ()-  ModifyCurrentUserNick       :: HasID Guild g =>                               g -> Maybe Text ->                   GuildRequest ()-  AddGuildMemberRole          :: (HasID Guild g, HasID User u, HasID Role r) => g -> u -> r ->                       GuildRequest ()-  RemoveGuildMemberRole       :: (HasID Guild g, HasID User u, HasID Role r) => g -> u -> r ->                       GuildRequest ()-  RemoveGuildMember           :: (HasID Guild g, HasID User u) =>               g -> u ->                            GuildRequest ()-  GetGuildBans                :: HasID Guild g =>                               g ->                                 GuildRequest [BanData]-  GetGuildBan                 :: (HasID Guild g, HasID User u) =>               g -> u ->                            GuildRequest BanData-  CreateGuildBan              :: (HasID Guild g, HasID User u) =>               g -> u -> CreateGuildBanData ->      GuildRequest ()-  RemoveGuildBan              :: (HasID Guild g, HasID User u) =>               g -> u ->                            GuildRequest ()-  GetGuildRoles               :: HasID Guild g =>                               g ->                                 GuildRequest [Role]-  CreateGuildRole             :: HasID Guild g =>                               g -> ModifyGuildRoleData ->          GuildRequest Role-  ModifyGuildRolePositions    :: HasID Guild g =>                               g -> ModifyGuildRolePositionsData -> GuildRequest [Role]-  ModifyGuildRole             :: (HasID Guild g, HasID Role r) =>               g -> r -> ModifyGuildRoleData ->     GuildRequest Role-  DeleteGuildRole             :: (HasID Guild g, HasID Role r) =>               g -> r ->                            GuildRequest ()-  GetGuildPruneCount          :: HasID Guild g =>                               g -> Integer ->                      GuildRequest Integer-  BeginGuildPrune             :: HasID Guild g =>                               g -> Integer -> Bool ->              GuildRequest (Maybe Integer)-  GetGuildVoiceRegions        :: HasID Guild g =>                               g ->                                 GuildRequest [VoiceRegion]-  GetGuildInvites             :: HasID Guild g =>                               g ->                                 GuildRequest [Invite]+  CreateGuild :: CreateGuildData -> GuildRequest Guild+  GetGuild :: HasID Guild g => g -> GuildRequest Guild+  ModifyGuild :: HasID Guild g => g -> ModifyGuildData -> GuildRequest Guild+  DeleteGuild :: HasID Guild g => g -> GuildRequest ()+  GetGuildChannels :: HasID Guild g => g -> GuildRequest [Channel]+  CreateGuildChannel :: HasID Guild g => g -> ChannelCreateData -> GuildRequest Channel+  ModifyGuildChannelPositions :: HasID Guild g => g -> [ChannelPosition] -> GuildRequest ()+  GetGuildMember :: (HasID Guild g, HasID User u) => g -> u -> GuildRequest Member+  ListGuildMembers :: HasID Guild g => g -> ListMembersOptions -> GuildRequest [Member]+  AddGuildMember :: (HasID Guild g, HasID User u) => g -> u -> AddGuildMemberData -> GuildRequest (Maybe Member)+  ModifyGuildMember :: (HasID Guild g, HasID User u) => g -> u -> ModifyGuildMemberData -> GuildRequest ()+  ModifyCurrentUserNick :: HasID Guild g => g -> Maybe Text -> GuildRequest ()+  AddGuildMemberRole :: (HasID Guild g, HasID User u, HasID Role r) => g -> u -> r -> GuildRequest ()+  RemoveGuildMemberRole :: (HasID Guild g, HasID User u, HasID Role r) => g -> u -> r -> GuildRequest ()+  RemoveGuildMember :: (HasID Guild g, HasID User u) => g -> u -> GuildRequest ()+  GetGuildBans :: HasID Guild g => g -> GuildRequest [BanData]+  GetGuildBan :: (HasID Guild g, HasID User u) => g -> u -> GuildRequest BanData+  CreateGuildBan :: (HasID Guild g, HasID User u) => g -> u -> CreateGuildBanData -> GuildRequest ()+  RemoveGuildBan :: (HasID Guild g, HasID User u) => g -> u -> GuildRequest ()+  GetGuildRoles :: HasID Guild g => g -> GuildRequest [Role]+  CreateGuildRole :: HasID Guild g => g -> ModifyGuildRoleData -> GuildRequest Role+  ModifyGuildRolePositions :: HasID Guild g => g -> ModifyGuildRolePositionsData -> GuildRequest [Role]+  ModifyGuildRole :: (HasID Guild g, HasID Role r) => g -> r -> ModifyGuildRoleData -> GuildRequest Role+  DeleteGuildRole :: (HasID Guild g, HasID Role r) => g -> r -> GuildRequest ()+  GetGuildPruneCount :: HasID Guild g => g -> Integer -> GuildRequest Integer+  BeginGuildPrune :: HasID Guild g => g -> Integer -> Bool -> GuildRequest (Maybe Integer)+  GetGuildVoiceRegions :: HasID Guild g => g -> GuildRequest [VoiceRegion]+  GetGuildInvites :: HasID Guild g => g -> GuildRequest [Invite]  baseRoute :: Snowflake Guild -> RouteBuilder _-baseRoute id = mkRouteBuilder // S "guilds" // ID @Guild-  & giveID id+baseRoute id =+  mkRouteBuilder // S "guilds" // ID @Guild+    & giveID id  instance Request (GuildRequest a) where   type Result (GuildRequest a) = a -  route (CreateGuild _) = mkRouteBuilder // S "guilds"-    & buildRoute-  route (GetGuild (getID -> gid)) = baseRoute gid-    & buildRoute-  route (ModifyGuild (getID -> gid) _) = baseRoute gid-    & buildRoute-  route (DeleteGuild (getID -> gid)) = baseRoute gid-    & buildRoute-  route (GetGuildChannels (getID -> gid)) = baseRoute gid // S "channels"-    & buildRoute-  route (CreateGuildChannel (getID -> gid) _) = baseRoute gid // S "channels"-    & buildRoute-  route (ModifyGuildChannelPositions (getID -> gid) _) = baseRoute gid // S "channels"-    & buildRoute-  route (GetGuildMember (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "members" // ID @User-    & giveID uid-    & buildRoute-  route (ListGuildMembers (getID -> gid) _) = baseRoute gid // S "members"-    & buildRoute-  route (AddGuildMember (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "members" // ID @User-    & giveID uid-    & buildRoute-  route (ModifyGuildMember (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "members" // ID @User-    & giveID uid-    & buildRoute-  route (ModifyCurrentUserNick (getID -> gid) _) = baseRoute gid // S "members" // S "@me" // S "nick"-    & buildRoute+  route (CreateGuild _) =+    mkRouteBuilder // S "guilds"+      & buildRoute+  route (GetGuild (getID -> gid)) =+    baseRoute gid+      & buildRoute+  route (ModifyGuild (getID -> gid) _) =+    baseRoute gid+      & buildRoute+  route (DeleteGuild (getID -> gid)) =+    baseRoute gid+      & buildRoute+  route (GetGuildChannels (getID -> gid)) =+    baseRoute gid // S "channels"+      & buildRoute+  route (CreateGuildChannel (getID -> gid) _) =+    baseRoute gid // S "channels"+      & buildRoute+  route (ModifyGuildChannelPositions (getID -> gid) _) =+    baseRoute gid // S "channels"+      & buildRoute+  route (GetGuildMember (getID -> gid) (getID @User -> uid)) =+    baseRoute gid // S "members" // ID @User+      & giveID uid+      & buildRoute+  route (ListGuildMembers (getID -> gid) _) =+    baseRoute gid // S "members"+      & buildRoute+  route (AddGuildMember (getID -> gid) (getID @User -> uid) _) =+    baseRoute gid // S "members" // ID @User+      & giveID uid+      & buildRoute+  route (ModifyGuildMember (getID -> gid) (getID @User -> uid) _) =+    baseRoute gid // S "members" // ID @User+      & giveID uid+      & buildRoute+  route (ModifyCurrentUserNick (getID -> gid) _) =+    baseRoute gid // S "members" // S "@me" // S "nick"+      & buildRoute   route (AddGuildMemberRole (getID -> gid) (getID @User -> uid) (getID @Role -> rid)) =     baseRoute gid // S "members" // ID @User // S "roles" // ID @Role-    & giveID uid-    & giveID rid-    & buildRoute+      & giveID uid+      & giveID rid+      & buildRoute   route (RemoveGuildMemberRole (getID -> gid) (getID @User -> uid) (getID @Role -> rid)) =     baseRoute gid // S "members" // ID @User // S "roles" // ID @Role-    & giveID uid-    & giveID rid-    & buildRoute-  route (RemoveGuildMember (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "members" // ID @User-    & giveID uid-    & buildRoute-  route (GetGuildBans (getID -> gid)) = baseRoute gid // S "bans"-    & buildRoute-  route (GetGuildBan (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "bans" // ID @User-    & giveID uid-    & buildRoute-  route (CreateGuildBan (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "bans" // ID @User-    & giveID uid-    & buildRoute-  route (RemoveGuildBan (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "bans" // ID @User-    & giveID uid-    & buildRoute-  route (GetGuildRoles (getID -> gid)) = baseRoute gid // S "roles"-    & buildRoute-  route (CreateGuildRole (getID -> gid) _) = baseRoute gid // S "roles"-    & buildRoute-  route (ModifyGuildRolePositions (getID -> gid) _) = baseRoute gid // S "roles"-    & buildRoute-  route (ModifyGuildRole (getID -> gid) (getID @Role -> rid) _) = baseRoute gid // S "roles" // ID @Role-    & giveID rid-    & buildRoute-  route (DeleteGuildRole (getID -> gid) (getID @Role -> rid)) = baseRoute gid // S "roles" // ID @Role-    & giveID rid-    & buildRoute-  route (GetGuildPruneCount (getID -> gid) _) = baseRoute gid // S "prune"-    & buildRoute-  route (BeginGuildPrune (getID -> gid) _ _) = baseRoute gid // S "prune"-    & buildRoute-  route (GetGuildVoiceRegions (getID -> gid)) = baseRoute gid // S "regions"-    & buildRoute-  route (GetGuildInvites (getID -> gid)) = baseRoute gid // S "invites"-    & buildRoute+      & giveID uid+      & giveID rid+      & buildRoute+  route (RemoveGuildMember (getID -> gid) (getID @User -> uid)) =+    baseRoute gid // S "members" // ID @User+      & giveID uid+      & buildRoute+  route (GetGuildBans (getID -> gid)) =+    baseRoute gid // S "bans"+      & buildRoute+  route (GetGuildBan (getID -> gid) (getID @User -> uid)) =+    baseRoute gid // S "bans" // ID @User+      & giveID uid+      & buildRoute+  route (CreateGuildBan (getID -> gid) (getID @User -> uid) _) =+    baseRoute gid // S "bans" // ID @User+      & giveID uid+      & buildRoute+  route (RemoveGuildBan (getID -> gid) (getID @User -> uid)) =+    baseRoute gid // S "bans" // ID @User+      & giveID uid+      & buildRoute+  route (GetGuildRoles (getID -> gid)) =+    baseRoute gid // S "roles"+      & buildRoute+  route (CreateGuildRole (getID -> gid) _) =+    baseRoute gid // S "roles"+      & buildRoute+  route (ModifyGuildRolePositions (getID -> gid) _) =+    baseRoute gid // S "roles"+      & buildRoute+  route (ModifyGuildRole (getID -> gid) (getID @Role -> rid) _) =+    baseRoute gid // S "roles" // ID @Role+      & giveID rid+      & buildRoute+  route (DeleteGuildRole (getID -> gid) (getID @Role -> rid)) =+    baseRoute gid // S "roles" // ID @Role+      & giveID rid+      & buildRoute+  route (GetGuildPruneCount (getID -> gid) _) =+    baseRoute gid // S "prune"+      & buildRoute+  route (BeginGuildPrune (getID -> gid) _ _) =+    baseRoute gid // S "prune"+      & buildRoute+  route (GetGuildVoiceRegions (getID -> gid)) =+    baseRoute gid // S "regions"+      & buildRoute+  route (GetGuildInvites (getID -> gid)) =+    baseRoute gid // S "invites"+      & buildRoute -  action (CreateGuild o) = postWith' (toJSON o)+  action (CreateGuild o) = postWith' (ReqBodyJson o)   action (GetGuild _) = getWith-  action (ModifyGuild _ o) = patchWith' (toJSON o)+  action (ModifyGuild _ o) = patchWith' (ReqBodyJson o)   action (DeleteGuild _) = deleteWith   action (GetGuildChannels _) = getWith-  action (CreateGuildChannel _ o) = postWith' (toJSON o)-  action (ModifyGuildChannelPositions _ o) = postWith' (toJSON o)+  action (CreateGuildChannel _ o) = postWith' (ReqBodyJson o)+  action (ModifyGuildChannelPositions _ o) = postWith' (ReqBodyJson o)   action (GetGuildMember _ _) = getWith-  action (ListGuildMembers _ ListMembersOptions { limit, after }) = getWithP-    (param "limit" .~ maybeToList (showt <$> limit) >>> param "after" .~ maybeToList (showt <$> after))-  action (AddGuildMember _ _ o) = putWith' (toJSON o)-  action (ModifyGuildMember _ _ o) = patchWith' (toJSON o)-  action (ModifyCurrentUserNick _ nick) = patchWith' (object ["nick" .= nick])-  action (AddGuildMemberRole {}) = putEmpty-  action (RemoveGuildMemberRole {}) = deleteWith+  action (ListGuildMembers _ ListMembersOptions{limit, after}) =+    getWithP+      ("limit" =:? (showt <$> limit) <> "after" =:? (showt <$> after))+  action (AddGuildMember _ _ o) = putWith' (ReqBodyJson o)+  action (ModifyGuildMember _ _ o) = patchWith' (ReqBodyJson o)+  action (ModifyCurrentUserNick _ nick) = patchWith' (ReqBodyJson $ object ["nick" .= nick])+  action AddGuildMemberRole{} = putEmpty+  action RemoveGuildMemberRole{} = deleteWith   action (RemoveGuildMember _ _) = deleteWith   action (GetGuildBans _) = getWith   action (GetGuildBan _ _) = getWith-  action (CreateGuildBan _ _ CreateGuildBanData { deleteMessageDays, reason }) = putEmptyP-    (param "delete-message-days" .~ maybeToList (showt <$> deleteMessageDays) >>> param "reason" .~ maybeToList-     (showt <$> reason))+  action (CreateGuildBan _ _ CreateGuildBanData{deleteMessageDays, reason}) =+    putEmptyP+      ("delete-message-days" =:? (showt <$> deleteMessageDays) <> "reason" =:? (showt <$> reason))   action (RemoveGuildBan _ _) = deleteWith   action (GetGuildRoles _) = getWith-  action (CreateGuildRole _ o) = postWith' (toJSON o)-  action (ModifyGuildRolePositions _ o) = patchWith' (toJSON o)-  action (ModifyGuildRole _ _ o) = patchWith' (toJSON o)+  action (CreateGuildRole _ o) = postWith' (ReqBodyJson o)+  action (ModifyGuildRolePositions _ o) = patchWith' (ReqBodyJson o)+  action (ModifyGuildRole _ _ o) = patchWith' (ReqBodyJson o)   action (DeleteGuildRole _ _) = deleteWith-  action (GetGuildPruneCount _ d) = getWithP (param "days" .~ [showt d])-  action (BeginGuildPrune _ d r) = postEmptyP (param "days" .~ [showt d] >>> param "compute_prune_count" .~ [showt r])+  action (GetGuildPruneCount _ d) = getWithP ("days" =: d)+  action (BeginGuildPrune _ d r) = postEmptyP ("days" =: d <> "compute_prune_count" =: r)   action (GetGuildVoiceRegions _) = getWith   action (GetGuildInvites _) = getWith    -- this is a bit of a hack   -- TODO: add something to allow for contextual parsing-  modifyResponse (GetGuildMember (getID @Guild -> gid) _) = _Object . at "guild_id"  ?~ _String # showt (fromSnowflake gid)-  modifyResponse (ListGuildMembers (getID @Guild -> gid) _) = values . _Object . at "guild_id"  ?~ _String # showt (fromSnowflake gid)+  modifyResponse (GetGuildMember (getID @Guild -> gid) _) = _Object . at "guild_id" ?~ _String # showt (fromSnowflake gid)+  modifyResponse (ListGuildMembers (getID @Guild -> gid) _) = values . _Object . at "guild_id" ?~ _String # showt (fromSnowflake gid)   modifyResponse _ = Prelude.id

@@ -1,117 +1,122 @@ -- | Module containing ratelimit stuff-module Calamity.HTTP.Internal.Ratelimit-    ( newRateLimitState-    , doRequest ) where+module Calamity.HTTP.Internal.Ratelimit (+  newRateLimitState,+  doRequest,+) where -import           Calamity.Client.Types        ( BotC )-import           Calamity.HTTP.Internal.Route-import           Calamity.HTTP.Internal.Types-import           Calamity.Internal.Utils+import Calamity.Client.Types (BotC)+import Calamity.HTTP.Internal.Route+import Calamity.HTTP.Internal.Types+import Calamity.Internal.Utils -import           Control.Concurrent-import           Control.Concurrent.Event     ( Event )-import qualified Control.Concurrent.Event     as E-import           Control.Concurrent.STM-import           Control.Concurrent.STM.Lock  ( Lock )-import qualified Control.Concurrent.STM.Lock  as L-import           Control.Lens-import           Control.Monad+import Control.Concurrent+import Control.Concurrent.Event (Event)+import qualified Control.Concurrent.Event as E+import Control.Concurrent.STM+import Control.Concurrent.STM.Lock (Lock)+import qualified Control.Concurrent.STM.Lock as L+import Control.Lens+import Control.Monad -import           Data.Aeson-import           Data.Aeson.Lens-import           Data.ByteString              ( ByteString )-import qualified Data.ByteString.Lazy         as LB-import           Data.Functor-import           Data.Maybe-import qualified Data.Text.Lazy               as LT-import           Data.Time-import           Data.Time.Clock.POSIX+import Data.Aeson+import Data.Aeson.Lens+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LB+import Data.Functor+import Data.Maybe+import qualified Data.Text.Lazy as LT+import Data.Time+import Data.Time.Clock.POSIX -import           Fmt+import Fmt -import           Focus+import Focus -import           Network.HTTP.Date-import           Network.HTTP.Types           hiding ( statusCode )-import           Network.Wreq+import Network.HTTP.Client (responseStatus)+import Network.HTTP.Date+import Network.HTTP.Req+import Network.HTTP.Types -import qualified Polysemy                     as P-import           Polysemy                     ( Sem )-import qualified Polysemy.Async               as P+import Polysemy (Sem)+import qualified Polysemy as P+import qualified Polysemy.Async as P -import           Prelude                      hiding ( error )+import Prelude hiding (error) -import qualified StmContainers.Map            as SC import qualified Control.Exception.Safe as Ex+import qualified StmContainers.Map as SC  newRateLimitState :: IO RateLimitState newRateLimitState = RateLimitState <$> SC.newIO <*> E.newSet  lookupOrInsertDefaultM :: Monad m => m a -> Focus a m a-lookupOrInsertDefaultM aM = casesM-  (do a <- aM-      pure (a, Set a))-  (\a -> pure (a, Leave))+lookupOrInsertDefaultM aM =+  casesM+    ( do+        a <- aM+        pure (a, Set a)+    )+    (\a -> pure (a, Leave))  getRateLimit :: RateLimitState -> Route -> STM Lock getRateLimit s h = SC.focus (lookupOrInsertDefaultM L.new) h (rateLimits s) -doDiscordRequest :: BotC r => IO (Response LB.ByteString) -> Sem r DiscordResponseType+doDiscordRequest :: BotC r => IO LbsResponse -> Sem r DiscordResponseType doDiscordRequest r = do   r'' <- P.embed $ Ex.catchAny (Right <$> r) (pure . Left . Ex.displayException)   case r'' of     Right r' -> do-      let status = r' ^. responseStatus+      let status = responseStatus . toVanillaResponse $ r'       if-        | statusIsSuccessful status -> do-          let resp = r' ^. responseBody-          debug $ "Got good response from discord: " +|| r' ^. responseStatus ||+ ""-          pure $ if isExhausted r'+          | statusIsSuccessful status -> do+            let resp = responseBody r'+            debug $ "Got good response from discord: " +|| status ||+ ""+            pure $+              if isExhausted r'                 then case parseRateLimitHeader r' of-                       Just sleepTime -> ExhaustedBucket resp sleepTime-                       Nothing        -> ServerError (status ^. statusCode)+                  Just sleepTime -> ExhaustedBucket resp sleepTime+                  Nothing -> ServerError (statusCode status)                 else Good resp-        | status == status429 -> do-          debug "Got 429 from discord, retrying."-          case asValue r' of-            Just rv -> pure $ Ratelimited (parseRetryAfter rv) (isGlobal rv)-            Nothing -> pure $ ClientError (status ^. statusCode) "429 with invalid json???"-        | statusIsClientError status -> do-          let err = r' ^. responseBody-          error $ "Something went wrong: " +|| err ||+ " response: " +|| r' ||+ ""-          pure $ ClientError (status ^. statusCode) err-        | otherwise -> do-          debug $ "Got server error from discord: " +| status ^. statusCode |+ ""-          pure $ ServerError (status ^. statusCode)+          | status == status429 -> do+            debug "Got 429 from discord, retrying."+            let resp = responseBody r'+            case resp ^? _Value of+              Just rv -> pure $ Ratelimited (parseRetryAfter rv) (isGlobal rv)+              Nothing -> pure $ ClientError (statusCode status) "429 with invalid json???"+          | statusIsClientError status -> do+            let err = responseBody r'+            error $ "Something went wrong: " +|| err ||+ " response: " +|| r' ||+ ""+            pure $ ClientError (statusCode status) err+          | otherwise -> do+            debug $ "Got server error from discord: " +| statusCode status |+ ""+            pure $ ServerError (statusCode status)     Left e -> do       error $ "Something went wrong with the http client: " +| LT.pack e |+ ""       pure . InternalResponseError $ LT.pack e - parseDiscordTime :: ByteString -> Maybe UTCTime parseDiscordTime s = httpDateToUTC <$> parseHTTPDate s  computeDiscordTimeDiff :: Double -> UTCTime -> Int computeDiscordTimeDiff end now = round . (* 1000.0) $ diffUTCTime end' now-  where end' = end & toRational & fromRational & posixSecondsToUTCTime+ where+  end' = end & toRational & fromRational & posixSecondsToUTCTime  -- | Parse a ratelimit header returning the number of milliseconds until it resets-parseRateLimitHeader :: Response a -> Maybe Int-parseRateLimitHeader r = computeDiscordTimeDiff end <$> now+parseRateLimitHeader :: HttpResponse r => r -> Maybe Int+parseRateLimitHeader r = computeDiscordTimeDiff <$> end <*> now  where-  end = r ^?! responseHeader "X-Ratelimit-Reset" . _Double-  now = r ^?! responseHeader "Date" & parseDiscordTime--isExhausted :: Response a -> Bool-isExhausted r = r ^? responseHeader "X-RateLimit-Remaining" == Just "0"+  end = responseHeader r "X-Ratelimit-Reset" ^? _Just . _Double+  now = parseDiscordTime =<< responseHeader r "Date" -parseRetryAfter :: Response Value -> Int-parseRetryAfter r =-  r ^?! responseBody . key "retry_after" . _Integral+isExhausted :: HttpResponse r => r -> Bool+isExhausted r = responseHeader r "X-RateLimit-Remaining" == Just "0" -isGlobal :: Response Value -> Bool-isGlobal r = r ^? responseBody . key "global" . _Bool == Just True+parseRetryAfter :: Value -> Int+parseRetryAfter r = r ^?! key "retry_after" . _Integral +isGlobal :: Value -> Bool+isGlobal r = r ^? key "global" . _Bool == Just True  -- Either (Either a a) b data ShouldRetry a b@@ -119,12 +124,15 @@   | RFail a   | RGood b -retryRequest-  :: BotC r-  => Int -- ^ number of retries-  -> Sem r (ShouldRetry a b) -- ^ action to perform-  -> Sem r ()  -- ^ action to run if max number of retries was reached-  -> Sem r (Either a b)+retryRequest ::+  BotC r =>+  -- | number of retries+  Int ->+  -- | action to perform+  Sem r (ShouldRetry a b) ->+  -- | action to run if max number of retries was reached+  Sem r () ->+  Sem r (Either a b) retryRequest max_retries action failAction = retryInner 0  where   retryInner num_retries = do@@ -138,25 +146,27 @@         debug "Request failed due to error response."         doFail $ Left r       RGood r -> pure $ Right r-    where doFail v = failAction $> v-+   where+    doFail v = failAction $> v  -- Run a single request -- NOTE: this function will only unlock the ratelimit lock if the request -- gave a response, otherwise it will stay locked so that it can be retried again-doSingleRequest-  :: BotC r-  => Event -- ^ Global lock-  -> Lock -- ^ Local lock-  -> IO (Response LB.ByteString) -- ^ Request action-  -> Sem r (ShouldRetry RestError LB.ByteString)+doSingleRequest ::+  BotC r =>+  -- | Global lock+  Event ->+  -- | Local lock+  Lock ->+  -- | Request action+  IO LbsResponse ->+  Sem r (ShouldRetry RestError LB.ByteString) doSingleRequest gl l r = do   r' <- doDiscordRequest r   case r' of     Good v -> do       P.embed . atomically $ L.release l       pure $ RGood v-     ExhaustedBucket v d -> do       debug $ "Exhausted bucket, unlocking after " +| d |+ "ms"       void . P.async $ do@@ -165,12 +175,10 @@           atomically $ L.release l         debug "unlocking bucket"       pure $ RGood v-     Ratelimited d False -> do       debug $ "429 ratelimited on route, sleeping for " +| d |+ " ms"       P.embed . threadDelay $ 1000 * d       pure $ Retry (HTTPError 429 Nothing)-     Ratelimited d True -> do       debug "429 ratelimited globally"       P.embed $ do@@ -178,18 +186,15 @@         threadDelay $ 1000 * d         E.set gl       pure $ Retry (HTTPError 429 Nothing)-     ServerError c -> do       debug "Server failed, retrying"       pure $ Retry (HTTPError c Nothing)-     InternalResponseError c -> do       debug "Internal error, retrying"       pure $ Retry (InternalClientError c)-     ClientError c v -> pure $ RFail (HTTPError c $ decode v) -doRequest :: BotC r => RateLimitState -> Route -> IO (Response LB.ByteString) -> Sem r (Either RestError LB.ByteString)+doRequest :: BotC r => RateLimitState -> Route -> IO LbsResponse -> Sem r (Either RestError LB.ByteString) doRequest rlState route action = do   P.embed $ E.wait (globalLock rlState) @@ -198,5 +203,7 @@     L.acquire lock     pure lock -  retryRequest 5 (doSingleRequest (globalLock rlState) ratelimit action)+  retryRequest+    5+    (doSingleRequest (globalLock rlState) ratelimit action)     (P.embed . atomically $ L.release ratelimit)

@@ -1,44 +1,45 @@ -- | Generic Request type-module Calamity.HTTP.Internal.Request-    ( Request(..)-    , invoke-    , postWith'-    , postWithP'-    , putWith'-    , patchWith'-    , putEmpty-    , putEmptyP-    , postEmpty-    , postEmptyP-    , getWithP ) where+module Calamity.HTTP.Internal.Request (+  Request (..),+  invoke,+  getWith,+  postWith',+  postWithP',+  putWith',+  patchWith',+  putEmpty,+  putEmptyP,+  postEmpty,+  postEmptyP,+  getWithP,+  deleteWith,+  (=:?),+) where -import           Calamity.Client.Types-import           Calamity.HTTP.Internal.Ratelimit-import           Calamity.HTTP.Internal.Route-import           Calamity.HTTP.Internal.Types-import           Calamity.Metrics.Eff-import           Calamity.Types.Token+import Calamity.Client.Types+import Calamity.HTTP.Internal.Ratelimit+import Calamity.HTTP.Internal.Route+import Calamity.HTTP.Internal.Types+import Calamity.Metrics.Eff+import Calamity.Types.Token -import           Control.Lens-import           Control.Monad+import Control.Lens+import Control.Monad -import           Data.Aeson                       hiding ( Options )-import           Data.ByteString                  ( ByteString )-import qualified Data.ByteString.Lazy             as LB-import qualified Data.Text.Encoding               as TS-import qualified Data.Text.Lazy                   as TL-import           Data.Text.Strict.Lens+import Data.Aeson hiding (Options)+import qualified Data.ByteString.Lazy as LB+import qualified Data.Text as T+import qualified Data.Text.Encoding as TS+import qualified Data.Text.Lazy as TL -import           DiPolysemy                       hiding ( debug, error, info )+import DiPolysemy hiding (debug, error, info) -import           Network.Wreq                     (Response, checkResponse, header, defaults)-import           Network.Wreq.Session-import           Network.Wreq.Types               (Options, Postable, Putable )+import Network.HTTP.Req -import           Polysemy                         ( Sem )-import qualified Polysemy                         as P-import qualified Polysemy.Error                   as P-import qualified Polysemy.Reader                  as P+import Polysemy (Sem)+import qualified Polysemy as P+import qualified Polysemy.Error as P+import qualified Polysemy.Reader as P  fromResult :: P.Member (P.Error RestError) r => Data.Aeson.Result a -> Sem r a fromResult (Success a) = pure a@@ -58,7 +59,7 @@ instance ReadResponse () where   readResp = const (Right ()) -instance {-# OVERLAPS #-}FromJSON a => ReadResponse a where+instance {-# OVERLAPS #-} FromJSON a => ReadResponse a where   readResp = eitherDecode  class Request a where@@ -66,66 +67,79 @@    route :: a -> Route -  action :: a -> Options -> Session -> String -> IO (Response LB.ByteString)+  action :: a -> Url 'Https -> Option 'Https -> Req LbsResponse    modifyResponse :: a -> Value -> Value   modifyResponse _ = id - invoke :: (BotC r, Request a, FromJSON (Calamity.HTTP.Internal.Request.Result a)) => a -> Sem r (Either RestError (Calamity.HTTP.Internal.Request.Result a)) invoke a = do-    rlState' <- P.asks (^. #rlState)-    session <- P.asks (^. #session)-    token' <- P.asks (^. #token)+  rlState' <- P.asks (^. #rlState)+  token' <- P.asks (^. #token) -    let route' = route a+  let route' = route a -    inFlightRequests <- registerGauge "inflight_requests" [("route", route' ^. #path)]-    totalRequests <- registerCounter "total_requests" [("route", route' ^. #path)]-    void $ modifyGauge (+ 1) inFlightRequests-    void $ addCounter 1 totalRequests+  inFlightRequests <- registerGauge "inflight_requests" [("route", renderUrl $ route' ^. #path)]+  totalRequests <- registerCounter "total_requests" [("route", renderUrl $ route' ^. #path)]+  void $ modifyGauge (+ 1) inFlightRequests+  void $ addCounter 1 totalRequests -    resp <- attr "route" (route' ^. #path) $ doRequest rlState' route'-      (action a (requestOptions token') session (route' ^. #path . unpacked))+  let r = action a (route' ^. #path) (requestOptions token')+      act = runReq reqConfig r -    void $ modifyGauge (subtract 1) inFlightRequests+  resp <- attr "route" (renderUrl $ route' ^. #path) $ doRequest rlState' route' act -    P.runError $ (fromResult . fromJSON . modifyResponse a) =<< (fromJSONDecode . readResp) =<< extractRight resp+  void $ modifyGauge (subtract 1) inFlightRequests +  P.runError $ fromResult . fromJSON . modifyResponse a =<< fromJSONDecode . readResp =<< extractRight resp -defaultRequestOptions :: Options-defaultRequestOptions = defaults-  & header "User-Agent" .~ ["Calamity (https://github.com/nitros12/calamity)"]-  & header "X-RateLimit-Precision" .~ ["millisecond"]-  & checkResponse ?~ (\_ _ -> pure ())+reqConfig :: HttpConfig+reqConfig =+  defaultHttpConfig+    { httpConfigCheckResponse = \_ _ _ -> Nothing+    } -requestOptions :: Token -> Options-requestOptions t = defaultRequestOptions-  & header "Authorization" .~ [TS.encodeUtf8 . TL.toStrict $ formatToken t]+defaultRequestOptions :: Option 'Https+defaultRequestOptions =+  header "User-Agent" "Calamity (https://github.com/nitros12/calamity)"+    <> header "X-RateLimit-Precision" "millisecond" -postWith' :: Postable a => a -> Options -> Session -> String -> IO (Response LB.ByteString)-postWith' p o sess s = postWith o sess s p+requestOptions :: Token -> Option 'Https+requestOptions t = defaultRequestOptions <> header "Authorization" (TS.encodeUtf8 . TL.toStrict $ formatToken t) -postWithP' :: Postable a => a -> (Options -> Options) -> Options -> Session -> String -> IO (Response LB.ByteString)-postWithP' p oF o sess s = postWith (oF o) sess s p+getWith :: Url 'Https -> Option 'Https -> Req LbsResponse+getWith u = req GET u NoReqBody lbsResponse -postEmpty :: Options -> Session -> String -> IO (Response LB.ByteString)-postEmpty o sess s = postWith o sess s ("" :: ByteString)+postWith' :: HttpBody a => a -> Url 'Https -> Option 'Https -> Req LbsResponse+postWith' a u = req POST u a lbsResponse -putWith' :: Putable a => a -> Options -> Session -> String -> IO (Response LB.ByteString)-putWith' p o sess s = putWith o sess s p+postWithP' :: HttpBody a => a -> Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse+postWithP' a o u o' = req POST u a lbsResponse (o <> o') -patchWith' :: Postable a => a -> Options -> Session -> String -> IO (Response LB.ByteString)-patchWith' p o sess s = customPayloadMethodWith "PATCH" o sess s p+postEmpty :: Url 'Https -> Option 'Https -> Req LbsResponse+postEmpty u = req POST u NoReqBody lbsResponse -putEmpty :: Options -> Session -> String -> IO (Response LB.ByteString)-putEmpty o sess s = putWith o sess s ("" :: ByteString)+putWith' :: HttpBody a => a -> Url 'Https -> Option 'Https -> Req LbsResponse+putWith' a u = req PUT u a lbsResponse -putEmptyP :: (Options -> Options) -> Options -> Session -> String -> IO (Response LB.ByteString)-putEmptyP = (putEmpty .)+patchWith' :: HttpBody a => a -> Url 'Https -> Option 'Https -> Req LbsResponse+patchWith' a u = req PATCH u a lbsResponse -postEmptyP :: (Options -> Options) -> Options -> Session -> String -> IO (Response LB.ByteString)-postEmptyP = (postEmpty .)+putEmpty :: Url 'Https -> Option 'Https -> Req LbsResponse+putEmpty u = req PUT u NoReqBody lbsResponse -getWithP :: (Options -> Options) -> Options -> Session -> String -> IO (Response LB.ByteString)-getWithP oF o = getWith (oF o)+putEmptyP :: Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse+putEmptyP o u o' = req PUT u NoReqBody lbsResponse (o <> o')++postEmptyP :: Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse+postEmptyP o u o' = req POST u NoReqBody lbsResponse (o <> o')++getWithP :: Option 'Https -> Url 'Https -> Option 'Https -> Req LbsResponse+getWithP o u o' = req GET u NoReqBody lbsResponse (o <> o')++deleteWith :: Url 'Https -> Option 'Https -> Req LbsResponse+deleteWith u = req DELETE u NoReqBody lbsResponse++(=:?) :: T.Text -> Maybe T.Text -> Option 'Https+n =:? (Just x) = n =: x+n =:? Nothing = mempty

@@ -24,7 +24,10 @@ import qualified Data.Text                    as T import           Data.Typeable import           Data.Word+import           Data.List ( foldl' ) +import           Network.HTTP.Req+ import           GHC.Generics                 hiding ( S )  import           TextShow@@ -115,7 +118,7 @@ infixl 5 //  data Route = Route-  { path      :: Text+  { path      :: Url 'Https   , key       :: Text   , channelID :: Maybe (Snowflake Channel)   , guildID   :: Maybe (Snowflake Guild)@@ -124,8 +127,8 @@ instance Hashable Route where   hashWithSalt s (Route _ ident c g) = hashWithSalt s (ident, c, g) -baseURL :: Text-baseURL = "https://discord.com/api/v8"+baseURL :: Url 'Https+baseURL = https "discord.com" /: "api" /: "v8"  buildRoute   :: forall (ids :: [(Type, RouteRequirement)])@@ -133,7 +136,7 @@   => RouteBuilder ids   -> Route buildRoute (UnsafeMkRouteBuilder route ids) = Route-  (T.intercalate "/" (baseURL : map goR route))+  (foldl' (/:) baseURL $ map goR route)   (T.concat (map goIdent route))   (Snowflake <$> lookup (typeRep (Proxy @Channel)) ids)   (Snowflake <$> lookup (typeRep (Proxy @Guild)) ids)

@@ -1,22 +1,18 @@ -- | Invite endpoints-module Calamity.HTTP.Invite-    ( InviteRequest(..) ) where--import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Types.Model.Guild+module Calamity.HTTP.Invite (InviteRequest (..)) where -import           Control.Lens                   hiding ( (.=) )+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Types.Model.Guild -import           Data.Text                      ( Text )+import Control.Lens hiding ((.=)) -import           Network.Wreq.Lens-import           Network.Wreq.Session+import Data.Text (Text) -import           TextShow+import Network.HTTP.Req  data InviteRequest a where-  GetInvite    :: Text -> InviteRequest Invite+  GetInvite :: Text -> InviteRequest Invite   DeleteInvite :: Text -> InviteRequest ()  baseRoute :: RouteBuilder _@@ -25,10 +21,12 @@ instance Request (InviteRequest a) where   type Result (InviteRequest a) = a -  route (GetInvite c) = baseRoute // S c-    & buildRoute-  route (DeleteInvite c) = baseRoute // S c-    & buildRoute+  route (GetInvite c) =+    baseRoute // S c+      & buildRoute+  route (DeleteInvite c) =+    baseRoute // S c+      & buildRoute -  action (GetInvite _) = getWithP (param "with_counts" .~ [showt True])+  action (GetInvite _) = getWithP ("with_counts" =: True)   action (DeleteInvite _) = deleteWith

@@ -1,26 +1,25 @@ -- | Miscellaneous routes module Calamity.HTTP.MiscRoutes where -import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.HTTP.Internal.Types--import           Data.Function+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.HTTP.Internal.Types -import           Network.Wreq.Session+import Data.Function  data MiscRequest a where-  GetGateway    :: MiscRequest GatewayResponse+  GetGateway :: MiscRequest GatewayResponse   GetGatewayBot :: MiscRequest BotGatewayResponse  instance Request (MiscRequest a) where   type Result (MiscRequest a) = a -  route GetGateway = mkRouteBuilder // S "gateway"-    & buildRoute--  route GetGatewayBot = mkRouteBuilder // S "gateway" // S "bot"-    & buildRoute+  route GetGateway =+    mkRouteBuilder // S "gateway"+      & buildRoute+  route GetGatewayBot =+    mkRouteBuilder // S "gateway" // S "bot"+      & buildRoute    action GetGateway = getWith   action GetGatewayBot = getWith

@@ -1,21 +1,20 @@ -- | A wrapper request that adds a reson to a request-module Calamity.HTTP.Reason-    ( Reason(..)-    , reason ) where--import           Calamity.HTTP.Internal.Request+module Calamity.HTTP.Reason (+  Reason (..),+  reason,+) where -import           Control.Lens                   hiding ( (.=) )+import Calamity.HTTP.Internal.Request -import           Data.Text                      ( Text )-import           Data.Text.Encoding             ( encodeUtf8 )+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8) -import           GHC.Generics+import GHC.Generics -import           Network.Wreq.Lens+import Network.HTTP.Req  data Reason a = Reason a Text-  deriving ( Show, Eq, Generic )+  deriving (Show, Eq, Generic)  -- | Attach a reason to a request reason :: Request a => Text -> a -> Reason a@@ -26,4 +25,5 @@    route (Reason a _) = route a -  action (Reason a r) = action a . (header "X-Audit-Log-Reason" .~ [encodeUtf8 r])+  action (Reason a r) = \u o ->+    action a u (o <> header "X-Audit-Log-Reason" (encodeUtf8 r))

@@ -1,54 +1,52 @@ -- | User endpoints-module Calamity.HTTP.User-    ( UserRequest(..)-    , ModifyUserData(..)-    , GetCurrentUserGuildsOptions(..) ) where+module Calamity.HTTP.User (+  UserRequest (..),+  ModifyUserData (..),+  GetCurrentUserGuildsOptions (..),+) where -import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Internal.AesonThings-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Model.User-import           Calamity.Types.Snowflake+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Model.User+import Calamity.Types.Snowflake -import           Control.Arrow-import           Control.Lens                   hiding ( (.=) )+import Control.Lens hiding ((.=)) -import           Data.Aeson-import           Data.Default.Class-import           Data.Maybe-import           Data.Text                      ( Text )+import Data.Aeson+import Data.Default.Class+import Data.Text (Text) -import           GHC.Generics+import GHC.Generics -import           Network.Wreq.Lens-import           Network.Wreq.Session+import Network.HTTP.Req -import           TextShow+import TextShow  data ModifyUserData = ModifyUserData   { username :: Maybe Text-    -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data-  , avatar   :: Maybe Text+  , -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data+    avatar :: Maybe Text   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON ModifyUserData+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON ModifyUserData  data GetCurrentUserGuildsOptions = GetCurrentUserGuildsOptions   { before :: Maybe (Snowflake Guild)-  , after  :: Maybe (Snowflake Guild)-  , limit  :: Maybe Integer+  , after :: Maybe (Snowflake Guild)+  , limit :: Maybe Integer   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data UserRequest a where-  GetCurrentUser       ::                                UserRequest User-  GetUser              :: HasID User u => u ->           UserRequest User-  ModifyCurrentUser    :: ModifyUserData ->              UserRequest User+  GetCurrentUser :: UserRequest User+  GetUser :: HasID User u => u -> UserRequest User+  ModifyCurrentUser :: ModifyUserData -> UserRequest User   GetCurrentUserGuilds :: GetCurrentUserGuildsOptions -> UserRequest [Partial Guild]-  LeaveGuild           :: HasID Guild g => g ->          UserRequest ()-  CreateDM             :: HasID User u => u ->           UserRequest DMChannel+  LeaveGuild :: HasID Guild g => g -> UserRequest ()+  CreateDM :: HasID User u => u -> UserRequest DMChannel  baseRoute :: RouteBuilder _ baseRoute = mkRouteBuilder // S "users" // S "@me"@@ -56,26 +54,34 @@ instance Request (UserRequest a) where   type Result (UserRequest a) = a -  route GetCurrentUser = baseRoute-    & buildRoute-  route (GetUser (getID @User -> uid)) = mkRouteBuilder // S "users" // ID @User-    & giveID uid-    & buildRoute-  route (ModifyCurrentUser _) = baseRoute-    & buildRoute-  route (GetCurrentUserGuilds _) = baseRoute // S "guilds"-    & buildRoute-  route (LeaveGuild (getID @Guild -> gid)) = baseRoute // S "guilds" // ID @Guild-    & giveID gid-    & buildRoute-  route (CreateDM _) = baseRoute // S "channels"-    & buildRoute+  route GetCurrentUser =+    baseRoute+      & buildRoute+  route (GetUser (getID @User -> uid)) =+    mkRouteBuilder // S "users" // ID @User+      & giveID uid+      & buildRoute+  route (ModifyCurrentUser _) =+    baseRoute+      & buildRoute+  route (GetCurrentUserGuilds _) =+    baseRoute // S "guilds"+      & buildRoute+  route (LeaveGuild (getID @Guild -> gid)) =+    baseRoute // S "guilds" // ID @Guild+      & giveID gid+      & buildRoute+  route (CreateDM _) =+    baseRoute // S "channels"+      & buildRoute    action GetCurrentUser = getWith   action (GetUser _) = getWith-  action (ModifyCurrentUser o) = patchWith' (toJSON o)-  action (GetCurrentUserGuilds GetCurrentUserGuildsOptions { before, after, limit }) = getWithP-    (param "before" .~ maybeToList (showt <$> before) >>> param "after" .~ maybeToList (showt <$> after) >>> param-     "limit" .~ maybeToList (showt <$> limit))+  action (ModifyCurrentUser o) = patchWith' $ ReqBodyJson o+  action (GetCurrentUserGuilds GetCurrentUserGuildsOptions{before, after, limit}) =+    getWithP+      ( "before" =:? (showt <$> before) <> "after" =:? (showt <$> after)+          <> "limit" =:? (showt <$> limit)+      )   action (LeaveGuild _) = deleteWith-  action (CreateDM (getID @User -> uid)) = postWith' (object ["recipient_id" .= uid])+  action (CreateDM (getID @User -> uid)) = postWith' $ ReqBodyJson (object ["recipient_id" .= uid])

@@ -1,84 +1,82 @@ -- | Webhook endpoints-module Calamity.HTTP.Webhook-    ( WebhookRequest(..)-    , CreateWebhookData(..)-    , ModifyWebhookData(..)-    , ExecuteWebhookOptions(..) ) where+module Calamity.HTTP.Webhook (+  WebhookRequest (..),+  CreateWebhookData (..),+  ModifyWebhookData (..),+  ExecuteWebhookOptions (..),+) where -import           Calamity.HTTP.Internal.Request-import           Calamity.HTTP.Internal.Route-import           Calamity.Internal.AesonThings-import           Calamity.Types.Model.Channel-import           Calamity.Types.Model.Guild-import           Calamity.Types.Snowflake+import Calamity.HTTP.Internal.Request+import Calamity.HTTP.Internal.Route+import Calamity.Internal.AesonThings+import Calamity.Types.Model.Channel+import Calamity.Types.Model.Guild+import Calamity.Types.Snowflake -import           Control.Lens                   hiding ( (.=) )+import Control.Lens hiding ((.=)) -import           Data.Aeson-import           Data.ByteString.Lazy           ( ByteString )-import           Data.Default.Class-import           Data.Generics.Product.Subtype  ( upcast )-import           Data.Maybe-import           Data.Text                      ( Text )+import Data.Aeson+import Data.ByteString.Lazy (ByteString)+import Data.Default.Class+import Data.Generics.Product.Subtype (upcast)+import Data.Text (Text) -import           GHC.Generics+import GHC.Generics -import           Network.Wreq ( partLBS )-import           Network.Wreq.Lens-import           Network.Wreq.Session+import Network.HTTP.Req -import           TextShow+import Network.HTTP.Client.MultipartFormData+import TextShow  data CreateWebhookData = CreateWebhookData   { username :: Maybe Text-    -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data-  , avatar   :: Maybe Text+  , -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data+    avatar :: Maybe Text   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON CreateWebhookData+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON CreateWebhookData  data ModifyWebhookData = ModifyWebhookData-  { username  :: Maybe Text-    -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data-  , avatar    :: Maybe Text+  { username :: Maybe Text+  , -- | The avatar field should be in discord's image data format: https://discord.com/developers/docs/reference#image-data+    avatar :: Maybe Text   , channelID :: Maybe (Snowflake Channel)   }-  deriving ( Show, Generic, Default )-  deriving ( ToJSON ) via CalamityJSON ModifyWebhookData+  deriving (Show, Generic, Default)+  deriving (ToJSON) via CalamityJSON ModifyWebhookData  data ExecuteWebhookOptions = ExecuteWebhookOptions-  { wait      :: Maybe Bool-  , content   :: Maybe Text-  , file      :: Maybe ByteString-  , embeds    :: Maybe [Embed]-  , username  :: Maybe Text+  { wait :: Maybe Bool+  , content :: Maybe Text+  , file :: Maybe ByteString+  , embeds :: Maybe [Embed]+  , username :: Maybe Text   , avatarUrl :: Maybe Text-  , tts       :: Maybe Bool+  , tts :: Maybe Bool   }-  deriving ( Show, Generic, Default )+  deriving (Show, Generic, Default)  data ExecuteWebhookJson = ExecuteWebhookJson-  { content   :: Maybe Text-  , embeds    :: Maybe [Embed]-  , username  :: Maybe Text+  { content :: Maybe Text+  , embeds :: Maybe [Embed]+  , username :: Maybe Text   , avatarUrl :: Maybe Text-  , tts       :: Maybe Bool+  , tts :: Maybe Bool   }-  deriving ( Show, Generic )-  deriving ( ToJSON ) via CalamityJSON ExecuteWebhookJson+  deriving (Show, Generic)+  deriving (ToJSON) via CalamityJSON ExecuteWebhookJson  data WebhookRequest a where-  CreateWebhook      :: HasID Channel c => c -> CreateWebhookData ->                                   WebhookRequest Webhook-  GetChannelWebhooks :: HasID Channel c => c ->                                                        WebhookRequest [Webhook]-  GetGuildWebhooks   :: HasID Guild c => c ->                                                          WebhookRequest [Webhook]-  GetWebhook         :: HasID Webhook w => w ->                                                        WebhookRequest Webhook-  GetWebhookToken    :: HasID Webhook w => w -> Text ->                                                WebhookRequest Webhook-  ModifyWebhook      :: HasID Webhook w => w -> ModifyWebhookData ->                                   WebhookRequest Webhook-  ModifyWebhookToken :: HasID Webhook w => w -> Text -> ModifyWebhookData ->                           WebhookRequest Webhook-  DeleteWebhook      :: HasID Webhook w => w ->                                                        WebhookRequest ()-  DeleteWebhookToken :: HasID Webhook w => w -> Text ->                                                WebhookRequest ()-  ExecuteWebhook     :: HasID Webhook w => w -> Text -> ExecuteWebhookOptions -> WebhookRequest ()-+  CreateWebhook :: HasID Channel c => c -> CreateWebhookData -> WebhookRequest Webhook+  GetChannelWebhooks :: HasID Channel c => c -> WebhookRequest [Webhook]+  GetGuildWebhooks :: HasID Guild c => c -> WebhookRequest [Webhook]+  GetWebhook :: HasID Webhook w => w -> WebhookRequest Webhook+  GetWebhookToken :: HasID Webhook w => w -> Text -> WebhookRequest Webhook+  ModifyWebhook :: HasID Webhook w => w -> ModifyWebhookData -> WebhookRequest Webhook+  ModifyWebhookToken :: HasID Webhook w => w -> Text -> ModifyWebhookData -> WebhookRequest Webhook+  DeleteWebhook :: HasID Webhook w => w -> WebhookRequest ()+  DeleteWebhookToken :: HasID Webhook w => w -> Text -> WebhookRequest ()+  ExecuteWebhook :: HasID Webhook w => w -> Text -> ExecuteWebhookOptions -> WebhookRequest ()  baseRoute :: Snowflake Webhook -> RouteBuilder _ baseRoute id = mkRouteBuilder // S "webhooks" // ID @Webhook & giveID id@@ -86,41 +84,53 @@ instance Request (WebhookRequest a) where   type Result (WebhookRequest a) = a -  route (CreateWebhook (getID @Channel -> cid) _) = mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"-    & giveID cid-    & buildRoute-  route (GetChannelWebhooks (getID @Channel -> cid)) = mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"-    & giveID cid-    & buildRoute-  route (GetGuildWebhooks (getID @Guild -> gid)) = mkRouteBuilder // S "guilds" // ID @Guild // S "webhooks"-    & giveID gid-    & buildRoute-  route (GetWebhook (getID @Webhook -> wid)) = baseRoute wid-    & buildRoute-  route (GetWebhookToken (getID @Webhook -> wid) t) = baseRoute wid // S t-    & buildRoute-  route (ModifyWebhook (getID @Webhook -> wid) _) = baseRoute wid-    & buildRoute-  route (ModifyWebhookToken (getID @Webhook -> wid) t _) = baseRoute wid // S t-    & buildRoute-  route (DeleteWebhook (getID @Webhook -> wid)) = baseRoute wid-    & buildRoute-  route (DeleteWebhookToken (getID @Webhook -> wid) t) = baseRoute wid // S t-    & buildRoute-  route (ExecuteWebhook (getID @Webhook -> wid) t _) = baseRoute wid // S t-    & buildRoute+  route (CreateWebhook (getID @Channel -> cid) _) =+    mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"+      & giveID cid+      & buildRoute+  route (GetChannelWebhooks (getID @Channel -> cid)) =+    mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"+      & giveID cid+      & buildRoute+  route (GetGuildWebhooks (getID @Guild -> gid)) =+    mkRouteBuilder // S "guilds" // ID @Guild // S "webhooks"+      & giveID gid+      & buildRoute+  route (GetWebhook (getID @Webhook -> wid)) =+    baseRoute wid+      & buildRoute+  route (GetWebhookToken (getID @Webhook -> wid) t) =+    baseRoute wid // S t+      & buildRoute+  route (ModifyWebhook (getID @Webhook -> wid) _) =+    baseRoute wid+      & buildRoute+  route (ModifyWebhookToken (getID @Webhook -> wid) t _) =+    baseRoute wid // S t+      & buildRoute+  route (DeleteWebhook (getID @Webhook -> wid)) =+    baseRoute wid+      & buildRoute+  route (DeleteWebhookToken (getID @Webhook -> wid) t) =+    baseRoute wid // S t+      & buildRoute+  route (ExecuteWebhook (getID @Webhook -> wid) t _) =+    baseRoute wid // S t+      & buildRoute -  action (CreateWebhook _ o) = postWith' (toJSON o)+  action (CreateWebhook _ o) = postWith' $ ReqBodyJson o   action (GetChannelWebhooks _) = getWith   action (GetGuildWebhooks _) = getWith   action (GetWebhook _) = getWith   action (GetWebhookToken _ _) = getWith-  action (ModifyWebhook _ o) = patchWith' (toJSON o)-  action (ModifyWebhookToken _ _ o) = patchWith' (toJSON o)+  action (ModifyWebhook _ o) = patchWith' $ ReqBodyJson o+  action (ModifyWebhookToken _ _ o) = patchWith' $ ReqBodyJson o   action (DeleteWebhook _) = deleteWith   action (DeleteWebhookToken _ _) = deleteWith-  action (ExecuteWebhook _ _ o@ExecuteWebhookOptions { file = Nothing }) = postWithP'-    (toJSON . upcast @ExecuteWebhookJson $ o) (param "wait" .~ maybeToList (showt <$> o ^. #wait))-  action (ExecuteWebhook _ _ o@ExecuteWebhookOptions { file = Just f }) = postWithP'-    [partLBS @IO "file" f, partLBS "payload_json" (encode . upcast @ExecuteWebhookJson $ o)]-    (param "wait" .~ maybeToList (showt <$> o ^. #wait))+  action (ExecuteWebhook _ _ o@ExecuteWebhookOptions{file = Nothing}) =+    postWithP'+      (ReqBodyJson . upcast @ExecuteWebhookJson $ o)+      ("wait" =:? (showt <$> o ^. #wait))+  action (ExecuteWebhook _ _ wh@ExecuteWebhookOptions{file = Just f}) = \u o -> do+    body <- reqBodyMultipart [partLBS @IO "file" f, partLBS "payload_json" (encode . upcast @ExecuteWebhookJson $ wh)]+    postWithP' body ("wait" =:? (showt <$> wh ^. #wait)) u o

@@ -30,7 +30,7 @@   deriving ( Generic, Eq, Data, Ord, Show )   deriving ( TextShow ) via TSG.FromGeneric (SnowflakeMap a)   deriving newtype ( IsList, Semigroup, Monoid )-  deriving anyclass ( NFData, Hashable )+  deriving newtype ( NFData, Hashable )  -- instance At (SnowflakeMap a) where --   at k f m = at (unSnowflakeMap k) f m

@@ -6,6 +6,7 @@ import           Calamity.Client.Types import           Calamity.HTTP                  as H import           Calamity.Internal.Utils+import qualified Calamity.Internal.SnowflakeMap as SM import           Calamity.Types.Model.Channel import           Calamity.Types.Model.Guild import           Calamity.Types.Model.User@@ -97,3 +98,17 @@         Right e <- invoke $ H.GetGuildEmoji gid eid         updateGuild gid (#emojis . at eid ?~ e)         pure e++instance Upgradeable Role (Snowflake Guild, Snowflake Role) where+  upgrade (gid, rid) = P.runNonDetMaybe (getcache <|> gethttp)+    where+      getcache = P.failToNonDet $ do+        Just g <- getGuild gid+        Just r <- pure (g ^. #roles . at rid)+        pure r+      gethttp = P.failToNonDet $ do+        Right rs <- invoke $ H.GetGuildRoles gid+        let sm = SM.fromList rs+        updateGuild gid (#roles <>~ sm)+        Just r <- pure (sm ^. at rid)+        pure r