calamity 0.1.4.4 → 0.1.5.0

raw patch · 26 files changed

+706/−232 lines, 26 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +23/−21
• calamity.cabal +6/−2
• src/Calamity/Client/ShardManager.hs +2/−2
• src/Calamity/Gateway/Types.hs +12/−0
• src/Calamity/HTTP.hs +8/−2
• src/Calamity/HTTP/AuditLog.hs +41/−0
• src/Calamity/HTTP/Channel.hs +96/−63
• src/Calamity/HTTP/Emoji.hs +13/−11
• src/Calamity/HTTP/Guild.hs +59/−57
• src/Calamity/HTTP/Internal/Request.hs +13/−15
• src/Calamity/HTTP/Invite.hs +7/−5
• src/Calamity/HTTP/MiscRoutes.hs +7/−5
• src/Calamity/HTTP/Reason.hs +29/−0
• src/Calamity/HTTP/User.hs +15/−13
• src/Calamity/HTTP/Webhook.hs +25/−23
• src/Calamity/Internal/SnowflakeMap.hs +1/−0
• src/Calamity/Internal/Utils.hs +2/−1
• src/Calamity/Types.hs +2/−0
• src/Calamity/Types/Model/Channel/Attachment.hs +10/−6
• src/Calamity/Types/Model/Channel/Embed.hs +31/−1
• src/Calamity/Types/Model/Guild.hs +3/−1
• src/Calamity/Types/Model/Guild/AuditLog.hs +187/−0
• src/Calamity/Types/Model/Guild/Emoji.hs +2/−2
• src/Calamity/Types/Model/Presence/Activity.hs +2/−2
• src/Calamity/Types/Tellable.hs +105/−0
• src/Calamity/Types/UnixTimestamp.hs +5/−0

@@ -104,27 +104,29 @@ info = DiP.info @Text debug = DiP.info @Text +tellt = tell @Text+ main :: IO () main = do-  P.runFinal . P.embedToFinal . handleFailByPrinting . runCounterAtomic . runCacheInMemory . runMetricsNoop $ runBotIO-    (BotToken "") $ do-      react @"messagecreate" $ \msg -> handleFailByLogging $ do-        when (msg ^. #content == "!count") $ replicateM_ 3 $ do-          val <- getCounter-          info $ "the counter is: " <> fromStrict (showt val)-          void . invokeRequest $ CreateMessage (msg ^. #channelID) ("The value is: " <> showt val)-        when (msg ^. #content == "!say hi") $ replicateM_ 3 . P.async $ do-          info "saying heya"-          Right msg' <- invokeRequest $ CreateMessage (msg ^. #channelID) "heya"-          info "sleeping"-          P.embed $ threadDelay (5 * 1000 * 1000)-          info "slept"-          void . invokeRequest $ EditMessage (msg ^. #channelID) msg' (Just "lol") Nothing-          info "edited"-        when (msg ^. #content == "!explode") $ do-          Just x <- pure Nothing-          debug "unreachable!"-        when (msg ^. #content == "!bye") $ do-          void . invokeRequest $ CreateMessage (msg ^. #channelID) "bye!"-          stopBot+  token <- view packed <$> getEnv "BOT_TOKEN"+  P.runFinal . P.embedToFinal . handleFailByPrinting . runCounterAtomic . runCacheInMemory . runMetricsNoop+    $ runBotIO (BotToken token) $ react @"messagecreate" $ \msg -> handleFailByLogging $ do+      when (msg ^. #content == "!count") $ replicateM_ 3 $ do+        val <- getCounter+        info $ "the counter is: " <> showt val+        void $ tellt msg ("The value is: " <> showt val)+      when (msg ^. #content == "!say hi") $ replicateM_ 3 . P.async $ do+        info "saying heya"+        Right msg' <- tellt msg "heya"+        info "sleeping"+        P.embed $ threadDelay (5 * 1000 * 1000)+        info "slept"+        void . invoke $ EditMessage (msg ^. #channelID) msg' (Just "lol") Nothing+        info "edited"+      when (msg ^. #content == "!explode") $ do+        Just x <- pure Nothing+        debug "unreachable!"+      when (msg ^. #content == "!bye") $ do+        void $ tellt msg "bye!"+        stopBot ```

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5c7efe15b2591781800d2351bc951927dd700e2f79d18d28ae979dc7dfe58f0b+-- hash: cd2b6837ac1a0aafe0608b377821ae47dba465830404b42d9bfc1c20a5db9ac6  name:           calamity-version:        0.1.4.4+version:        0.1.5.0 synopsis:       A library for writing discord bots description:    Please see the README on GitHub at <https://github.com/nitros12/calamity#readme> category:       Network, Web@@ -45,6 +45,7 @@       Calamity.Gateway.Shard       Calamity.Gateway.Types       Calamity.HTTP+      Calamity.HTTP.AuditLog       Calamity.HTTP.Channel       Calamity.HTTP.Emoji       Calamity.HTTP.Guild@@ -54,6 +55,7 @@       Calamity.HTTP.Internal.Types       Calamity.HTTP.Invite       Calamity.HTTP.MiscRoutes+      Calamity.HTTP.Reason       Calamity.HTTP.User       Calamity.HTTP.Webhook       Calamity.Internal.AesonThings@@ -81,6 +83,7 @@       Calamity.Types.Model.Channel.Reaction       Calamity.Types.Model.Channel.Webhook       Calamity.Types.Model.Guild+      Calamity.Types.Model.Guild.AuditLog       Calamity.Types.Model.Guild.Ban       Calamity.Types.Model.Guild.Emoji       Calamity.Types.Model.Guild.Guild@@ -98,6 +101,7 @@       Calamity.Types.Model.Voice.VoiceState       Calamity.Types.Partial       Calamity.Types.Snowflake+      Calamity.Types.Tellable       Calamity.Types.Token       Calamity.Types.UnixTimestamp   other-modules:

@@ -33,7 +33,7 @@   token <- P.asks Calamity.Client.Types.token   eventQueue <- P.asks eventQueue -  Right gateway <- invokeRequest GetGatewayBot+  Right gateway <- invoke GetGatewayBot    let numShards' = gateway ^. #shards   let host = gateway ^. #url@@ -59,7 +59,7 @@ --   eventQueue <- asks eventQueue --   logEnv <- askLog ---   gateway <- aa <$> invokeRequest GetGateway+--   gateway <- aa <$> invoke GetGateway  --   let host = gateway ^. #url --   liftIO $ putMVar numShardsVar 1

@@ -113,6 +113,18 @@   deriving ( Show, Generic )  instance ToJSON SentDiscordMessage where+  toJSON (HeartBeat data') = object ["op" .= (1 :: Int), "d" .= data']++  toJSON (Identify data') = object ["op" .= (2 :: Int), "d" .= data']++  toJSON (StatusUpdate data') = object ["op" .= (3 :: Int), "d" .= data']++  toJSON (VoiceStatusUpdate data') = object ["op" .= (4 :: Int), "d" .= data']++  toJSON (Resume data') = object ["op" .= (6 :: Int), "d" .= data']++  toJSON (RequestGuildMembers data') = object ["op" .= (8 :: Int), "d" .= data']+   toEncoding (HeartBeat data') = pairs ("op" .= (1 :: Int) <> "d" .= data')    toEncoding (Identify data') = pairs ("op" .= (2 :: Int) <> "d" .= data')

@@ -1,19 +1,25 @@ -- | Combined http request stuff module Calamity.HTTP-    ( module Calamity.HTTP.Internal.Request+    ( module Calamity.HTTP.AuditLog+    , module Calamity.HTTP.Internal.Request     , module Calamity.HTTP.Channel     , module Calamity.HTTP.Emoji     , module Calamity.HTTP.Guild     , module Calamity.HTTP.Invite     , module Calamity.HTTP.MiscRoutes     , module Calamity.HTTP.User+    , module Calamity.HTTP.Reason+    , module Calamity.HTTP.Internal.Types     , module Calamity.HTTP.Webhook ) where +import           Calamity.HTTP.AuditLog import           Calamity.HTTP.Channel import           Calamity.HTTP.Emoji import           Calamity.HTTP.Guild-import           Calamity.HTTP.Internal.Request ( invokeRequest )+import           Calamity.HTTP.Internal.Request ( invoke )+import           Calamity.HTTP.Internal.Types   ( RestError ) import           Calamity.HTTP.Invite import           Calamity.HTTP.MiscRoutes+import           Calamity.HTTP.Reason import           Calamity.HTTP.User import           Calamity.HTTP.Webhook

@@ -0,0 +1,41 @@+-- | Audit Log endpoints+module Calamity.HTTP.AuditLog+    ( AuditLogRequest(..)+    , GetAuditLogOptions(..) ) 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.Model.User+import           Calamity.Types.Snowflake++import           Data.Aeson+import           Data.Default.Class+import           Data.Function++import           GHC.Generics++import           Network.Wreq++data GetAuditLogOptions = GetAuditLogOptions+  { userID     :: Maybe (Snowflake User)+  , actionType :: Maybe AuditLogAction+  , before     :: Maybe (Snowflake AuditLogEntry)+  , limit      :: Maybe Integer+  }+  deriving ( Show, Generic, Default )+  deriving ( ToJSON ) via CalamityJSON GetAuditLogOptions++data AuditLogRequest a where+  GetAuditLog :: HasID Guild g => g -> AuditLogRequest AuditLog++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++  action (GetAuditLog _) = getWith

@@ -1,6 +1,7 @@ -- | Channel endpoints module Calamity.HTTP.Channel     ( ChannelRequest(..)+    , CreateMessageOptions(..)     , ChannelUpdate(..)     , ChannelMessagesQuery(..)     , GetReactionsOptions(..)@@ -16,12 +17,14 @@ import           Calamity.Types.Snowflake  import           Control.Arrow-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.Text                      ( Text )  import           GHC.Generics @@ -29,6 +32,24 @@  import           TextShow +data CreateMessageOptions = CreateMessageOptions+  { content :: Maybe Text+  , nonce   :: Maybe Text+  , tts     :: Maybe Bool+  , file    :: Maybe ByteString+  , embed   :: Maybe Embed+  }+  deriving ( Show, Generic, Default )++data CreateMessageJson = CreateMessageJson+  { content :: Maybe Text+  , nonce   :: Maybe Text+  , tts     :: Maybe Bool+  , embed   :: Maybe Embed+  }+  deriving ( Show, Generic )+  deriving ( ToJSON ) via CalamityJSON CreateMessageJson+ data ChannelUpdate = ChannelUpdate   { name                 :: Maybe Text   , position             :: Maybe Int@@ -83,7 +104,7 @@   deriving ( ToJSON ) via CalamityJSON GroupDMAddRecipientOptions  data ChannelRequest a where-  CreateMessage            :: (HasID Channel c) =>                                c -> Text ->                                 ChannelRequest Message+  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 ()@@ -113,101 +134,113 @@ baseRoute id = mkRouteBuilder // S "channels" // ID @Channel   & giveID id -instance Request (ChannelRequest a) a where-  toRoute (CreateMessage (getID -> id) _)      = baseRoute id // S "messages" & buildRoute-  toRoute (GetChannel    (getID -> id))        = baseRoute id                 & buildRoute-  toRoute (ModifyChannel (getID -> id) _)      = baseRoute id                 & buildRoute-  toRoute (DeleteChannel (getID -> id))        = baseRoute id                 & buildRoute-  toRoute (GetChannelMessages (getID -> id) _) = baseRoute id // S "messages" & buildRoute-  toRoute (GetMessage (getID -> cid) (getID @Message -> mid)) = baseRoute cid // S "messages" // ID @Message+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-  toRoute (CreateReaction (getID -> cid) (getID @Message -> mid) emoji) =+  route (CreateReaction (getID -> cid) (getID @Message -> mid) emoji) =     baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // S "@me"     & giveID mid     & buildRoute-  toRoute (DeleteOwnReaction (getID -> cid) (getID @Message -> mid) emoji) =+  route (DeleteOwnReaction (getID -> cid) (getID @Message -> mid) emoji) =     baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // S "@me"     & giveID mid     & buildRoute-  toRoute (DeleteUserReaction (getID -> cid) (getID @Message -> mid) emoji (getID @User -> uid)) =+  route (DeleteUserReaction (getID -> cid) (getID @Message -> mid) emoji (getID @User -> uid)) =     baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji) // ID @User     & giveID mid     & giveID uid     & buildRoute-  toRoute (GetReactions (getID -> cid) (getID @Message -> mid) emoji _) =+  route (GetReactions (getID -> cid) (getID @Message -> mid) emoji _) =     baseRoute cid // S "messages" // ID @Message // S "reactions" // S (showt emoji)     & giveID mid     & buildRoute-  toRoute (DeleteAllReactions (getID -> cid) (getID @Message -> mid)) =+  route (DeleteAllReactions (getID -> cid) (getID @Message -> mid)) =     baseRoute cid // S "messages" // ID @Message // S "reactions"     & giveID mid     & buildRoute-  toRoute (EditMessage (getID -> cid) (getID @Message -> mid) _ _) =-    baseRoute cid // S "messages" // ID @Message+  route (EditMessage (getID -> cid) (getID @Message -> mid) _ _) = baseRoute cid // S "messages" // ID @Message     & giveID mid     & buildRoute-  toRoute (DeleteMessage (getID -> cid) (getID @Message -> mid)) =-    baseRoute cid // S "messages" // ID @Message+  route (DeleteMessage (getID -> cid) (getID @Message -> mid)) = baseRoute cid // S "messages" // ID @Message     & giveID mid     & buildRoute-  toRoute (BulkDeleteMessages (getID -> cid) _) =-    baseRoute cid // S "messages" // S "bulk-delete"+  route (BulkDeleteMessages (getID -> cid) _) = baseRoute cid // S "messages" // S "bulk-delete"     & buildRoute-  toRoute (GetChannelInvites (getID -> cid)) = baseRoute cid // S "invites" & buildRoute-  toRoute (CreateChannelInvite (getID -> cid) _) = baseRoute cid // S "invites" & buildRoute-  toRoute (EditChannelPermissions (getID -> cid) (getID @Overwrite -> oid)) =+  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-  toRoute (DeleteChannelPermission (getID -> cid) (getID @Overwrite -> oid)) =+  route (DeleteChannelPermission (getID -> cid) (getID @Overwrite -> oid)) =     baseRoute cid // S "permissions" // ID @Overwrite     & giveID oid     & buildRoute-  toRoute (TriggerTyping (getID -> cid)) = baseRoute cid // S "typing" & buildRoute-  toRoute (GetPinnedMessages (getID -> cid)) = baseRoute cid // S "pins" & buildRoute-  toRoute (AddPinnedMessage (getID -> cid) (getID @Message -> mid)) = baseRoute cid // S "pins" // ID @Message+  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-  toRoute (DeletePinnedMessage (getID -> cid) (getID @Message -> mid)) = baseRoute cid // S "pins" // ID @Message+  route (DeletePinnedMessage (getID -> cid) (getID @Message -> mid)) = baseRoute cid // S "pins" // ID @Message     & giveID mid     & buildRoute-  toRoute (GroupDMAddRecipient (getID -> cid) (getID @User -> uid) _) = baseRoute cid // S "recipients" // ID @User+  route (GroupDMAddRecipient (getID -> cid) (getID @User -> uid) _) = baseRoute cid // S "recipients" // ID @User     & giveID uid     & buildRoute-  toRoute (GroupDMRemoveRecipient (getID -> cid) (getID @User -> uid)) = baseRoute cid // S "recipients" // ID @User+  route (GroupDMRemoveRecipient (getID -> cid) (getID @User -> uid)) = baseRoute cid // S "recipients" // ID @User     & giveID uid     & buildRoute -  toAction (CreateMessage _ t) = postWith' (object ["content" .= t])-  toAction (GetChannel _)      = getWith-  toAction (ModifyChannel _ p) = putWith' (toJSON p)-  toAction (DeleteChannel _)   = deleteWith-  toAction (GetChannelMessages _ (Just (ChannelMessagesAround (showt . fromSnowflake -> a)))) = getWithP (param "around" .~ [a])-  toAction (GetChannelMessages _ (Just (ChannelMessagesBefore (showt . fromSnowflake -> a)))) = getWithP (param "before" .~ [a])-  toAction (GetChannelMessages _ (Just (ChannelMessagesAfter  (showt . fromSnowflake -> a)))) = getWithP (param "after"  .~ [a])-  toAction (GetChannelMessages _ (Just (ChannelMessagesLimit  (showt -> a))))                 = getWithP (param "around" .~ [a])-  toAction (GetChannelMessages _ Nothing) = getWith-  toAction (GetMessage _ _)               = getWith-  toAction CreateReaction {}              = putEmpty-  toAction DeleteOwnReaction {}           = deleteWith-  toAction DeleteUserReaction {}          = deleteWith-  toAction (GetReactions _ _ _ GetReactionsOptions { before, after, limit }) = getWithP-    (param "before" .~ maybeToList (showt <$> before)-     >>> param "after" .~ maybeToList (showt <$> after)-     >>> param "limit" .~ maybeToList (showt <$> limit))-  toAction (DeleteAllReactions _ _) = deleteWith-  toAction (EditMessage _ _ content embed) = patchWith'-    (object ["content" .= content, "embed" .= embed])-  toAction (DeleteMessage _ _)                       = deleteWith-  toAction (BulkDeleteMessages _ (map (getID @Message) -> ids)) = postWith' (object ["messages" .= ids])-  toAction (GetChannelInvites _)                     = getWith-  toAction (CreateChannelInvite _ o)                 = postWith' (toJSON o)-  toAction (EditChannelPermissions _ o)              = putWith' (toJSON o)-  toAction (DeleteChannelPermission _ _)             = deleteWith-  toAction (TriggerTyping _)                         = postEmpty-  toAction (GetPinnedMessages _)                     = getWith-  toAction (AddPinnedMessage _ _)                    = putEmpty-  toAction (DeletePinnedMessage _ _)                 = deleteWith-  toAction (GroupDMAddRecipient _ _ o)               = putWith' (toJSON o)-  toAction (GroupDMRemoveRecipient _ _)              = deleteWith+  action (CreateMessage _ o@CreateMessageOptions { file = Nothing }) = postWith'+    (toJSON . upcast @CreateMessageJson $ o)+  action (CreateMessage _ o@CreateMessageOptions { file = Just f }) = postWith'+    [partLBS @IO "file" f, partLBS "payload_json" (encode . upcast @CreateMessageJson $ o)]+  action (GetChannel _) = getWith+  action (ModifyChannel _ p) = putWith' (toJSON 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 _ 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 (DeleteAllReactions _ _) = deleteWith+  action (EditMessage _ _ content embed) = patchWith' (object ["content" .= content, "embed" .= embed])+  action (DeleteMessage _ _) = deleteWith+  action (BulkDeleteMessages _ (map (getID @Message) -> ids)) = postWith' (object ["messages" .= ids])+  action (GetChannelInvites _) = getWith+  action (CreateChannelInvite _ o) = postWith' (toJSON o)+  action (EditChannelPermissions _ o) = putWith' (toJSON o)+  action (DeleteChannelPermission _ _) = deleteWith+  action (TriggerTyping _) = postEmpty+  action (GetPinnedMessages _) = getWith+  action (AddPinnedMessage _ _) = putEmpty+  action (DeletePinnedMessage _ _) = deleteWith+  action (GroupDMAddRecipient _ _ o) = putWith' (toJSON o)+  action (GroupDMRemoveRecipient _ _) = deleteWith

@@ -45,21 +45,23 @@ baseRoute :: Snowflake Guild -> RouteBuilder _ baseRoute id = mkRouteBuilder // S "guilds" // ID @Guild // S "emojis" & giveID id -instance Request (EmojiRequest a) a where-  toRoute (ListGuildEmojis (getID -> gid)) = baseRoute gid & buildRoute-  toRoute (GetGuildEmoji (getID -> gid) (getID @Emoji -> eid)) = baseRoute gid // ID @Emoji+instance Request (EmojiRequest a) where+  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-  toRoute (CreateGuildEmoji (getID -> gid) _) = baseRoute gid & buildRoute-  toRoute (ModifyGuildEmoji (getID -> gid) (getID @Emoji -> eid) _) = baseRoute gid // ID @Emoji+  route (CreateGuildEmoji (getID -> gid) _) = baseRoute gid & buildRoute+  route (ModifyGuildEmoji (getID -> gid) (getID @Emoji -> eid) _) = baseRoute gid // ID @Emoji     & giveID eid     & buildRoute-  toRoute (DeleteGuildEmoji (getID -> gid) (getID @Emoji -> eid)) = baseRoute gid // ID @Emoji+  route (DeleteGuildEmoji (getID -> gid) (getID @Emoji -> eid)) = baseRoute gid // ID @Emoji     & giveID eid     & buildRoute -  toAction (ListGuildEmojis _)       = getWith-  toAction (GetGuildEmoji _ _)       = getWith-  toAction (CreateGuildEmoji _ o)    = postWith' (toJSON o)-  toAction (ModifyGuildEmoji _ _ o)  = patchWith' (toJSON o)-  toAction (DeleteGuildEmoji _ _)    = deleteWith+  action (ListGuildEmojis _)       = getWith+  action (GetGuildEmoji _ _)       = getWith+  action (CreateGuildEmoji _ o)    = postWith' (toJSON o)+  action (ModifyGuildEmoji _ _ o)  = patchWith' (toJSON o)+  action (DeleteGuildEmoji _ _)    = deleteWith

@@ -170,107 +170,109 @@ baseRoute id = mkRouteBuilder // S "guilds" // ID @Guild   & giveID id -instance Request (GuildRequest a) a where-  toRoute (CreateGuild _) = mkRouteBuilder // S "guilds"+instance Request (GuildRequest a) where+  type Result (GuildRequest a) = a++  route (CreateGuild _) = mkRouteBuilder // S "guilds"     & buildRoute-  toRoute (GetGuild (getID -> gid)) = baseRoute gid+  route (GetGuild (getID -> gid)) = baseRoute gid     & buildRoute-  toRoute (ModifyGuild (getID -> gid) _) = baseRoute gid+  route (ModifyGuild (getID -> gid) _) = baseRoute gid     & buildRoute-  toRoute (DeleteGuild (getID -> gid)) = baseRoute gid+  route (DeleteGuild (getID -> gid)) = baseRoute gid     & buildRoute-  toRoute (GetGuildChannels (getID -> gid)) = baseRoute gid // S "channels"+  route (GetGuildChannels (getID -> gid)) = baseRoute gid // S "channels"     & buildRoute-  toRoute (CreateGuildChannel (getID -> gid) _) = baseRoute gid // S "channels"+  route (CreateGuildChannel (getID -> gid) _) = baseRoute gid // S "channels"     & buildRoute-  toRoute (ModifyGuildChannelPositions (getID -> gid) _) = baseRoute gid // S "channels"+  route (ModifyGuildChannelPositions (getID -> gid) _) = baseRoute gid // S "channels"     & buildRoute-  toRoute (GetGuildMember (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "members" // ID @User+  route (GetGuildMember (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "members" // ID @User     & giveID uid     & buildRoute-  toRoute (ListGuildMembers (getID -> gid) _) = baseRoute gid // S "members"+  route (ListGuildMembers (getID -> gid) _) = baseRoute gid // S "members"     & buildRoute-  toRoute (AddGuildMember (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "members" // ID @User+  route (AddGuildMember (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "members" // ID @User     & giveID uid     & buildRoute-  toRoute (ModifyGuildMember (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "members" // ID @User+  route (ModifyGuildMember (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "members" // ID @User     & giveID uid     & buildRoute-  toRoute (ModifyCurrentUserNick (getID -> gid) _) = baseRoute gid // S "members" // S "@me" // S "nick"+  route (ModifyCurrentUserNick (getID -> gid) _) = baseRoute gid // S "members" // S "@me" // S "nick"     & buildRoute-  toRoute (AddGuildMemberRole (getID -> gid) (getID @User -> uid) (getID @Role -> rid)) =+  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-  toRoute (RemoveGuildMemberRole (getID -> gid) (getID @User -> uid) (getID @Role -> rid)) =+  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-  toRoute (RemoveGuildMember (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "members" // ID @User+  route (RemoveGuildMember (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "members" // ID @User     & giveID uid     & buildRoute-  toRoute (GetGuildBans (getID -> gid)) = baseRoute gid // S "bans"+  route (GetGuildBans (getID -> gid)) = baseRoute gid // S "bans"     & buildRoute-  toRoute (GetGuildBan (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "bans" // ID @User+  route (GetGuildBan (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "bans" // ID @User     & giveID uid     & buildRoute-  toRoute (CreateGuildBan (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "bans" // ID @User+  route (CreateGuildBan (getID -> gid) (getID @User -> uid) _) = baseRoute gid // S "bans" // ID @User     & giveID uid     & buildRoute-  toRoute (RemoveGuildBan (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "bans" // ID @User+  route (RemoveGuildBan (getID -> gid) (getID @User -> uid)) = baseRoute gid // S "bans" // ID @User     & giveID uid     & buildRoute-  toRoute (GetGuildRoles (getID -> gid)) = baseRoute gid // S "roles"+  route (GetGuildRoles (getID -> gid)) = baseRoute gid // S "roles"     & buildRoute-  toRoute (CreateGuildRole (getID -> gid) _) = baseRoute gid // S "roles"+  route (CreateGuildRole (getID -> gid) _) = baseRoute gid // S "roles"     & buildRoute-  toRoute (ModifyGuildRolePositions (getID -> gid) _) = baseRoute gid // S "roles"+  route (ModifyGuildRolePositions (getID -> gid) _) = baseRoute gid // S "roles"     & buildRoute-  toRoute (ModifyGuildRole (getID -> gid) (getID @Role -> rid) _) = baseRoute gid // S "roles" // ID @Role+  route (ModifyGuildRole (getID -> gid) (getID @Role -> rid) _) = baseRoute gid // S "roles" // ID @Role     & giveID rid     & buildRoute-  toRoute (DeleteGuildRole (getID -> gid) (getID @Role -> rid)) = baseRoute gid // S "roles" // ID @Role+  route (DeleteGuildRole (getID -> gid) (getID @Role -> rid)) = baseRoute gid // S "roles" // ID @Role     & giveID rid     & buildRoute-  toRoute (GetGuildPruneCount (getID -> gid) _) = baseRoute gid // S "prune"+  route (GetGuildPruneCount (getID -> gid) _) = baseRoute gid // S "prune"     & buildRoute-  toRoute (BeginGuildPrune (getID -> gid) _ _) = baseRoute gid // S "prune"+  route (BeginGuildPrune (getID -> gid) _ _) = baseRoute gid // S "prune"     & buildRoute-  toRoute (GetGuildVoiceRegions (getID -> gid)) = baseRoute gid // S "regions"+  route (GetGuildVoiceRegions (getID -> gid)) = baseRoute gid // S "regions"     & buildRoute-  toRoute (GetGuildInvites (getID -> gid)) = baseRoute gid // S "invites"+  route (GetGuildInvites (getID -> gid)) = baseRoute gid // S "invites"     & buildRoute -  toAction (CreateGuild o) = postWith' (toJSON o)-  toAction (GetGuild _) = getWith-  toAction (ModifyGuild _ o) = patchWith' (toJSON o)-  toAction (DeleteGuild _) = deleteWith-  toAction (GetGuildChannels _) = getWith-  toAction (CreateGuildChannel _ o) = postWith' (toJSON o)-  toAction (ModifyGuildChannelPositions _ o) = postWith' (toJSON o)-  toAction (GetGuildMember _ _) = getWith-  toAction (ListGuildMembers _ ListMembersOptions { limit, after }) = getWithP+  action (CreateGuild o) = postWith' (toJSON o)+  action (GetGuild _) = getWith+  action (ModifyGuild _ o) = patchWith' (toJSON o)+  action (DeleteGuild _) = deleteWith+  action (GetGuildChannels _) = getWith+  action (CreateGuildChannel _ o) = postWith' (toJSON o)+  action (ModifyGuildChannelPositions _ o) = postWith' (toJSON o)+  action (GetGuildMember _ _) = getWith+  action (ListGuildMembers _ ListMembersOptions { limit, after }) = getWithP     (param "limit" .~ maybeToList (showt <$> limit) >>> param "after" .~ maybeToList (showt <$> after))-  toAction (AddGuildMember _ _ o) = putWith' (toJSON o)-  toAction (ModifyGuildMember _ _ o) = patchWith' (toJSON o)-  toAction (ModifyCurrentUserNick _ nick) = patchWith' (object ["nick" .= nick])-  toAction (AddGuildMemberRole {}) = putEmpty-  toAction (RemoveGuildMemberRole {}) = deleteWith-  toAction (RemoveGuildMember _ _) = deleteWith-  toAction (GetGuildBans _) = getWith-  toAction (GetGuildBan _ _) = getWith-  toAction (CreateGuildBan _ _ CreateGuildBanData { deleteMessageDays, reason }) = putEmptyP+  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 (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))-  toAction (RemoveGuildBan _ _) = deleteWith-  toAction (GetGuildRoles _) = getWith-  toAction (CreateGuildRole _ o) = postWith' (toJSON o)-  toAction (ModifyGuildRolePositions _ o) = patchWith' (toJSON o)-  toAction (ModifyGuildRole _ _ o) = patchWith' (toJSON o)-  toAction (DeleteGuildRole _ _) = deleteWith-  toAction (GetGuildPruneCount _ d) = getWithP (param "days" .~ [showt d])-  toAction (BeginGuildPrune _ d r) = postEmptyP (param "days" .~ [showt d] >>> param "compute_prune_count" .~ [showt r])-  toAction (GetGuildVoiceRegions _) = getWith-  toAction (GetGuildInvites _) = getWith+  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 (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 (GetGuildVoiceRegions _) = getWith+  action (GetGuildInvites _) = getWith

@@ -25,7 +25,6 @@ import           Data.Aeson                       hiding ( Options ) import           Data.ByteString                  ( ByteString ) import qualified Data.ByteString.Lazy             as LB-import qualified Data.Text                        as TS import qualified Data.Text.Encoding               as TS import qualified Data.Text.Lazy                   as TL import           Data.Text.Strict.Lens@@ -42,7 +41,7 @@  import           TextShow -fromResult :: P.Member (P.Error RestError) r => Result a -> Sem r a+fromResult :: P.Member (P.Error RestError) r => Data.Aeson.Result a -> Sem r a fromResult (Success a) = pure a fromResult (Error e) = P.throw (DecodeError . TL.pack $ e) @@ -63,32 +62,31 @@ instance {-# OVERLAPS #-}FromJSON a => ReadResponse a where   readResp = eitherDecode -class Request a r | a -> r where-  toRoute :: a -> Route+class Request a where+  type Result a -  url :: a -> String-  url = TS.unpack . path . toRoute+  route :: a -> Route -  toAction :: a -> Options -> String -> IO (Response LB.ByteString)+  action :: a -> Options -> String -> IO (Response LB.ByteString) -  invokeRequest :: forall reffs. (BotC reffs, FromJSON r) => a -> Sem reffs (Either RestError r)-  invokeRequest a = do+  invoke :: (BotC r, 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       token' <- P.asks token -      let route = toRoute a+      let route' = route a -      inFlightRequests <- registerGauge "inflight_requests" [("route", route ^. #path)]-      totalRequests <- registerCounter "total_requests" [("route", route ^. #path)]+      inFlightRequests <- registerGauge "inflight_requests" [("route", route' ^. #path)]+      totalRequests <- registerCounter "total_requests" [("route", route' ^. #path)]       void $ modifyGauge succ inFlightRequests       void $ addCounter 1 totalRequests -      whenJust (route ^. #guildID) $ \guildID -> do+      whenJust (route' ^. #guildID) $ \guildID -> do         totalRequestsGuild <- registerCounter "total_requests" [("guild", showt guildID)]         void $ addCounter 1 totalRequestsGuild -      resp <- attr "route" (toRoute a ^. #path) $ doRequest rlState' route-        (toAction a (requestOptions token') (route ^. #path . unpacked))+      resp <- attr "route" (route' ^. #path) $ doRequest rlState' route'+        (action a (requestOptions token') (route' ^. #path . unpacked))        void $ modifyGauge pred inFlightRequests 

@@ -21,11 +21,13 @@ baseRoute :: RouteBuilder _ baseRoute = mkRouteBuilder // S "invites" -instance Request (InviteRequest a) a where-  toRoute (GetInvite c) = baseRoute // S c+instance Request (InviteRequest a) where+  type Result (InviteRequest a) = a++  route (GetInvite c) = baseRoute // S c     & buildRoute-  toRoute (DeleteInvite c) = baseRoute // S c+  route (DeleteInvite c) = baseRoute // S c     & buildRoute -  toAction (GetInvite _) = getWithP (param "with_counts" .~ [showt True])-  toAction (DeleteInvite _) = deleteWith+  action (GetInvite _) = getWithP (param "with_counts" .~ [showt True])+  action (DeleteInvite _) = deleteWith

@@ -13,12 +13,14 @@   GetGateway    :: MiscRequest GatewayResponse   GetGatewayBot :: MiscRequest BotGatewayResponse -instance Request (MiscRequest a) a where-  toRoute GetGateway = mkRouteBuilder // S "gateway"+instance Request (MiscRequest a) where+  type Result (MiscRequest a) = a++  route GetGateway = mkRouteBuilder // S "gateway"     & buildRoute -  toRoute GetGatewayBot = mkRouteBuilder // S "gateway" // S "bot"+  route GetGatewayBot = mkRouteBuilder // S "gateway" // S "bot"     & buildRoute -  toAction GetGateway = getWith-  toAction GetGatewayBot = getWith+  action GetGateway = getWith+  action GetGatewayBot = getWith

@@ -0,0 +1,29 @@+-- | A wrapper request that adds a reson to a request+module Calamity.HTTP.Reason+    ( Reason(..)+    , reason ) where++import           Calamity.HTTP.Internal.Request++import           Control.Lens                   hiding ( (.=) )++import           Data.Text                      ( Text )+import           Data.Text.Encoding             ( encodeUtf8 )++import           GHC.Generics++import           Network.Wreq++data Reason a = Reason a Text+  deriving ( Show, Eq, Generic )++-- | Attach a reason to a request+reason :: Request a => Text -> a -> Reason a+reason = flip Reason++instance Request a => Request (Reason a) where+  type Result (Reason a) = Result a++  route (Reason a _) = route a++  action (Reason a r) = action a . (header "X-Audit-Log-Reason" .~ [encodeUtf8 r])

@@ -52,27 +52,29 @@ baseRoute :: RouteBuilder _ baseRoute = mkRouteBuilder // S "users" // S "@me" -instance Request (UserRequest a) a where-  toRoute GetCurrentUser = baseRoute+instance Request (UserRequest a) where+  type Result (UserRequest a) = a++  route GetCurrentUser = baseRoute     & buildRoute-  toRoute (GetUser (getID @User -> uid)) = mkRouteBuilder // S "users" // ID @User+  route (GetUser (getID @User -> uid)) = mkRouteBuilder // S "users" // ID @User     & giveID uid     & buildRoute-  toRoute (ModifyCurrentUser _) = baseRoute+  route (ModifyCurrentUser _) = baseRoute     & buildRoute-  toRoute (GetCurrentUserGuilds _) = baseRoute // S "guilds"+  route (GetCurrentUserGuilds _) = baseRoute // S "guilds"     & buildRoute-  toRoute (LeaveGuild (getID @Guild -> gid)) = baseRoute // S "guilds" // ID @Guild+  route (LeaveGuild (getID @Guild -> gid)) = baseRoute // S "guilds" // ID @Guild     & giveID gid     & buildRoute-  toRoute (CreateDM _) = baseRoute // S "channels"+  route (CreateDM _) = baseRoute // S "channels"     & buildRoute -  toAction GetCurrentUser = getWith-  toAction (GetUser _) = getWith-  toAction (ModifyCurrentUser o) = patchWith' (toJSON o)-  toAction (GetCurrentUserGuilds GetCurrentUserGuildsOptions { before, after, limit }) = getWithP+  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))-  toAction (LeaveGuild _) = deleteWith-  toAction (CreateDM (getID @User -> uid)) = postWith' (object ["recipient_id" .= uid])+  action (LeaveGuild _) = deleteWith+  action (CreateDM (getID @User -> uid)) = postWith' (object ["recipient_id" .= uid])

@@ -15,7 +15,7 @@ import           Control.Lens                   hiding ( (.=) )  import           Data.Aeson-import           Data.ByteString.Lazy+import           Data.ByteString.Lazy           ( ByteString ) import           Data.Default.Class import           Data.Generics.Product.Subtype  ( upcast ) import           Data.Maybe@@ -81,42 +81,44 @@ baseRoute :: Snowflake Webhook -> RouteBuilder _ baseRoute id = mkRouteBuilder // S "webhooks" // ID @Webhook & giveID id -instance Request (WebhookRequest a) a where-  toRoute (CreateWebhook (getID @Channel -> cid) _) = mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"+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-  toRoute (GetChannelWebhooks (getID @Channel -> cid)) = mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"+  route (GetChannelWebhooks (getID @Channel -> cid)) = mkRouteBuilder // S "channels" // ID @Channel // S "webhooks"     & giveID cid     & buildRoute-  toRoute (GetGuildWebhooks (getID @Guild -> gid)) = mkRouteBuilder // S "guilds" // ID @Guild // S "webhooks"+  route (GetGuildWebhooks (getID @Guild -> gid)) = mkRouteBuilder // S "guilds" // ID @Guild // S "webhooks"     & giveID gid     & buildRoute-  toRoute (GetWebhook (getID @Webhook -> wid)) = baseRoute wid+  route (GetWebhook (getID @Webhook -> wid)) = baseRoute wid     & buildRoute-  toRoute (GetWebhookToken (getID @Webhook -> wid) t) = baseRoute wid // S t+  route (GetWebhookToken (getID @Webhook -> wid) t) = baseRoute wid // S t     & buildRoute-  toRoute (ModifyWebhook (getID @Webhook -> wid) _) = baseRoute wid+  route (ModifyWebhook (getID @Webhook -> wid) _) = baseRoute wid     & buildRoute-  toRoute (ModifyWebhookToken (getID @Webhook -> wid) t _) = baseRoute wid // S t+  route (ModifyWebhookToken (getID @Webhook -> wid) t _) = baseRoute wid // S t     & buildRoute-  toRoute (DeleteWebhook (getID @Webhook -> wid)) = baseRoute wid+  route (DeleteWebhook (getID @Webhook -> wid)) = baseRoute wid     & buildRoute-  toRoute (DeleteWebhookToken (getID @Webhook -> wid) t) = baseRoute wid // S t+  route (DeleteWebhookToken (getID @Webhook -> wid) t) = baseRoute wid // S t     & buildRoute-  toRoute (ExecuteWebhook (getID @Webhook -> wid) t _) = baseRoute wid // S t+  route (ExecuteWebhook (getID @Webhook -> wid) t _) = baseRoute wid // S t     & buildRoute -  toAction (CreateWebhook _ o) = postWith' (toJSON o)-  toAction (GetChannelWebhooks _) = getWith-  toAction (GetGuildWebhooks _) = getWith-  toAction (GetWebhook _) = getWith-  toAction (GetWebhookToken _ _) = getWith-  toAction (ModifyWebhook _ o) = patchWith' (toJSON o)-  toAction (ModifyWebhookToken _ _ o) = patchWith' (toJSON o)-  toAction (DeleteWebhook _) = deleteWith-  toAction (DeleteWebhookToken _ _) = deleteWith-  toAction (ExecuteWebhook _ _ o@ExecuteWebhookOptions { file = Nothing }) = postWithP'+  action (CreateWebhook _ o) = postWith' (toJSON 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 (DeleteWebhook _) = deleteWith+  action (DeleteWebhookToken _ _) = deleteWith+  action (ExecuteWebhook _ _ o@ExecuteWebhookOptions { file = Nothing }) = postWithP'     (toJSON . upcast @ExecuteWebhookJson $ o) (param "wait" .~ maybeToList (showt <$> o ^. #wait))-  toAction (ExecuteWebhook _ _ o@ExecuteWebhookOptions { file = Just f }) = postWithP'+  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))

@@ -236,4 +236,5 @@     pure . Calamity.Internal.SnowflakeMap.fromList . F.toList $ parsed  instance ToJSON a => ToJSON (SnowflakeMap a) where+  toJSON = toJSON . elems   toEncoding = toEncoding . elems

@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-orphans #-}+ -- | Internal utilities and instances module Calamity.Internal.Utils     ( whenJust@@ -65,7 +66,7 @@ instance (TextShow a, VU.Unbox a) => TextShow (Vector a) where   showb = showbList . VU.toList -   -- lazy and strict use the same internal data structure+    -- lazy and strict use the same internal data structure instance (Show k, Show v) => TextShow (LH.HashMap k v) where   showb = fromString . show 

@@ -4,10 +4,12 @@     , module Calamity.Types.Partial     , module Calamity.Types.Snowflake     , module Calamity.Types.Token+    , module Calamity.Types.Tellable     , module Calamity.Types.UnixTimestamp ) where  import           Calamity.Types.Model import           Calamity.Types.Partial import           Calamity.Types.Snowflake import           Calamity.Types.Token+import           Calamity.Types.Tellable import           Calamity.Types.UnixTimestamp

@@ -33,12 +33,16 @@   deriving ( HasID Attachment ) via HasIDField "id" Attachment  instance ToJSON Attachment where-  toEncoding Attachment { id, filename, size, url, proxyUrl, dimensions = Just (width, height) } = pairs-    ("id" .= id <> "filename" .= filename <> "size" .= size <> "url" .= url <> "proxy_url" .= proxyUrl-     <> "width" .= width <> "height" .= height)--  toEncoding Attachment { id, filename, size, url, proxyUrl } = pairs-    ("id" .= id <> "filename" .= filename <> "size" .= size <> "url" .= url <> "proxy_url" .= proxyUrl)+  toJSON Attachment { id, filename, size, url, proxyUrl, dimensions = Just (width, height) } = object+    [ "id" .= id+    , "filename" .= filename+    , "size" .= size+    , "url" .= url+    , "proxy_url" .= proxyUrl+    , "width" .= width+    , "height" .= height]+  toJSON Attachment { id, filename, size, url, proxyUrl } =+    object ["id" .= id, "filename" .= filename, "size" .= size, "url" .= url, "proxy_url" .= proxyUrl]  instance FromJSON Attachment where   parseJSON = withObject "Attachment" $ \v -> do

@@ -12,7 +12,12 @@ import           Calamity.Internal.AesonThings import           Calamity.Internal.Utils       () +import           Control.Lens+ import           Data.Aeson+import           Data.Default.Class+import           Data.Generics.Labels          ()+import           Data.Semigroup import           Data.Text.Lazy                ( Text ) import           Data.Time import           Data.Word@@ -37,12 +42,31 @@   , author      :: Maybe EmbedAuthor   , fields      :: [EmbedField]   }-  deriving ( Eq, Show, Generic )+  deriving ( Eq, Show, Generic, Default )   deriving ( TextShow ) via TSG.FromGeneric Embed   deriving ( FromJSON ) via WithSpecialCases '[IfNoneThen "fields" DefaultToEmptyArray]       Embed   deriving ( ToJSON ) via CalamityJSON Embed +instance Semigroup Embed where+  l <> r = l+    & #title       %~ (<> (r ^. #title))+    & #type_       %~ getLast . (<> Last (r ^. #type_)) . Last+    & #description %~ (<> (r ^. #description))+    & #url         %~ getLast . (<> Last (r ^. #url)) . Last+    & #timestamp   %~ getLast . (<> Last (r ^. #timestamp)) . Last+    & #color       %~ getLast . (<> Last (r ^. #color)) . Last+    & #footer      %~ (<> (r ^. #footer))+    & #image       %~ getLast . (<> Last (r ^. #image)) . Last+    & #thumbnail   %~ getLast . (<> Last (r ^. #thumbnail)) . Last+    & #video       %~ getLast . (<> Last (r ^. #video)) . Last+    & #provider    %~ getLast . (<> Last (r ^. #provider)) . Last+    & #author      %~ getLast . (<> Last (r ^. #author)) . Last+    & #fields      %~ (<> (r ^. #fields))++instance Monoid Embed where+  mempty = def+ data EmbedFooter = EmbedFooter   { text         :: Text   , iconUrl      :: Maybe Text@@ -51,6 +75,12 @@   deriving ( Eq, Show, Generic )   deriving ( TextShow ) via TSG.FromGeneric EmbedFooter   deriving ( ToJSON, FromJSON ) via CalamityJSON EmbedFooter++instance Semigroup EmbedFooter where+  l <> r = l+    & #text         %~ (<> (r ^. #text))+    & #iconUrl      %~ getLast . (<> Last (r ^. #iconUrl)) . Last+    & #proxyIconUrl %~ getLast . (<> Last (r ^. #proxyIconUrl)) . Last  data EmbedImage = EmbedImage   { url      :: Text

@@ -1,6 +1,7 @@ -- | Discord Guilds module Calamity.Types.Model.Guild-    ( module Calamity.Types.Model.Guild.Ban+    ( module Calamity.Types.Model.Guild.AuditLog+    , module Calamity.Types.Model.Guild.Ban     , module Calamity.Types.Model.Guild.Emoji     , module Calamity.Types.Model.Guild.Guild     , module Calamity.Types.Model.Guild.Member@@ -9,6 +10,7 @@     , module Calamity.Types.Model.Guild.Role     , module Calamity.Types.Model.Guild.UnavailableGuild ) where +import           Calamity.Types.Model.Guild.AuditLog import           Calamity.Types.Model.Guild.Ban import           Calamity.Types.Model.Guild.Emoji import           Calamity.Types.Model.Guild.Guild            hiding ( UpdatedGuild(..) )

@@ -0,0 +1,187 @@+-- | Audit Log models+module Calamity.Types.Model.Guild.AuditLog+    ( AuditLog(..)+    , AuditLogEntry(..)+    , AuditLogEntryInfo(..)+    , AuditLogChange(..)+    , AuditLogAction(..) ) where++import           Calamity.Internal.AesonThings+import           Calamity.Internal.SnowflakeMap ( SnowflakeMap )+import           Calamity.Types.Model.Channel+import           Calamity.Types.Model.User+import           Calamity.Types.Snowflake++import           Data.Aeson+import           Data.Scientific+import           Data.Text.Lazy                 ( Text )++import           GHC.Generics++import           TextShow+import qualified TextShow.Generic               as TSG++data AuditLog = AuditLog+  { webhooks        :: SnowflakeMap Webhook+  , users           :: SnowflakeMap User+  , auditLogEntries :: SnowflakeMap AuditLogEntry+  }+  deriving ( Show, Generic )+  deriving ( TextShow ) via TSG.FromGeneric AuditLog+  deriving ( FromJSON ) via CalamityJSON AuditLog++data AuditLogEntry = AuditLogEntry+  { targetID   :: Maybe (Snowflake ())+  , changes    :: [AuditLogChange]+  , userID     :: Snowflake User+  , id         :: Snowflake AuditLogEntry+  , actionType :: AuditLogAction+  , options    :: Maybe AuditLogEntryInfo+  , reason     :: Maybe Text+  }+  deriving ( Show, Generic )+  deriving ( TextShow ) via TSG.FromGeneric AuditLogEntry+  deriving ( FromJSON ) via CalamityJSON AuditLogEntry+  deriving ( HasID User ) via HasIDField "userID" AuditLogEntry+  deriving ( HasID AuditLogEntry ) via HasIDField "id" AuditLogEntry++data AuditLogEntryInfo = AuditLogEntryInfo+  { deleteMemberDays :: Maybe Text+  , membersRemoved   :: Maybe Text+  , channelID        :: Maybe (Snowflake Channel)+  , messageID        :: Maybe (Snowflake Message)+  , count            :: Maybe Text+  , id               :: Maybe (Snowflake ())+  , type_            :: Maybe Text+  , roleName         :: Maybe Text+  }+  deriving ( Show, Generic )+  deriving ( TextShow ) via TSG.FromGeneric AuditLogEntryInfo+  deriving ( FromJSON ) via CalamityJSON AuditLogEntryInfo++data AuditLogChange = AuditLogChange+  { newValue :: Maybe Value+  , oldValue :: Maybe Value+  , key      :: Text+  }+  deriving ( Show, Generic )+  deriving ( TextShow ) via FromStringShow AuditLogChange+  deriving ( FromJSON ) via CalamityJSON AuditLogChange++data AuditLogAction+  = GUILD_UPDATE+  | CHANNEL_CREATE+  | CHANNEL_UPDATE+  | CHANNEL_DELETE+  | CHANNEL_OVERWRITE_CREATE+  | CHANNEL_OVERWRITE_UPDATE+  | CHANNEL_OVERWRITE_DELETE+  | MEMBER_KICK+  | MEMBER_PRUNE+  | MEMBER_BAN_ADD+  | MEMBER_BAN_REMOVE+  | MEMBER_UPDATE+  | MEMBER_ROLE_UPDATE+  | MEMBER_MOVE+  | MEMBER_DISCONNECT+  | BOT_ADD+  | ROLE_CREATE+  | ROLE_UPDATE+  | ROLE_DELETE+  | INVITE_CREATE+  | INVITE_UPDATE+  | INVITE_DELETE+  | WEBHOOK_CREATE+  | WEBHOOK_UPDATE+  | WEBHOOK_DELETE+  | EMOJI_CREATE+  | EMOJI_UPDATE+  | EMOJI_DELETE+  | MESSAGE_DELETE+  | MESSAGE_BULK_DELETE+  | MESSAGE_PIN+  | MESSAGE_UNPIN+  | INTEGRATION_CREATE+  | INTEGRATION_UPDATE+  | INTEGRATION_DELETE+  deriving ( Show, Generic )+  deriving ( TextShow ) via TSG.FromGeneric AuditLogAction++instance FromJSON AuditLogAction where+  parseJSON = withScientific "AuditLogAction" $ \n -> case toBoundedInteger @Int n of+    Just v  -> case v of+      1  -> pure GUILD_UPDATE+      10 -> pure CHANNEL_CREATE+      11 -> pure CHANNEL_UPDATE+      12 -> pure CHANNEL_DELETE+      13 -> pure CHANNEL_OVERWRITE_CREATE+      14 -> pure CHANNEL_OVERWRITE_UPDATE+      15 -> pure CHANNEL_OVERWRITE_DELETE+      20 -> pure MEMBER_KICK+      21 -> pure MEMBER_PRUNE+      22 -> pure MEMBER_BAN_ADD+      23 -> pure MEMBER_BAN_REMOVE+      24 -> pure MEMBER_UPDATE+      25 -> pure MEMBER_ROLE_UPDATE+      26 -> pure MEMBER_MOVE+      27 -> pure MEMBER_DISCONNECT+      28 -> pure BOT_ADD+      30 -> pure ROLE_CREATE+      31 -> pure ROLE_UPDATE+      32 -> pure ROLE_DELETE+      40 -> pure INVITE_CREATE+      41 -> pure INVITE_UPDATE+      42 -> pure INVITE_DELETE+      50 -> pure WEBHOOK_CREATE+      51 -> pure WEBHOOK_UPDATE+      52 -> pure WEBHOOK_DELETE+      60 -> pure EMOJI_CREATE+      61 -> pure EMOJI_UPDATE+      62 -> pure EMOJI_DELETE+      72 -> pure MESSAGE_DELETE+      73 -> pure MESSAGE_BULK_DELETE+      74 -> pure MESSAGE_PIN+      75 -> pure MESSAGE_UNPIN+      80 -> pure INTEGRATION_CREATE+      81 -> pure INTEGRATION_UPDATE+      82 -> pure INTEGRATION_DELETE+      _  -> fail $ "Invalid AuditLogAction: " <> show n+    Nothing -> fail $ "Invalid AuditLogAction: " <> show n++instance ToJSON AuditLogAction where+  toJSON x = toJSON @Int $ case x of+    GUILD_UPDATE             -> 1+    CHANNEL_CREATE           -> 10+    CHANNEL_UPDATE           -> 11+    CHANNEL_DELETE           -> 12+    CHANNEL_OVERWRITE_CREATE -> 13+    CHANNEL_OVERWRITE_UPDATE -> 14+    CHANNEL_OVERWRITE_DELETE -> 15+    MEMBER_KICK              -> 20+    MEMBER_PRUNE             -> 21+    MEMBER_BAN_ADD           -> 22+    MEMBER_BAN_REMOVE        -> 23+    MEMBER_UPDATE            -> 24+    MEMBER_ROLE_UPDATE       -> 25+    MEMBER_MOVE              -> 26+    MEMBER_DISCONNECT        -> 27+    BOT_ADD                  -> 28+    ROLE_CREATE              -> 30+    ROLE_UPDATE              -> 31+    ROLE_DELETE              -> 32+    INVITE_CREATE            -> 40+    INVITE_UPDATE            -> 41+    INVITE_DELETE            -> 42+    WEBHOOK_CREATE           -> 50+    WEBHOOK_UPDATE           -> 51+    WEBHOOK_DELETE           -> 52+    EMOJI_CREATE             -> 60+    EMOJI_UPDATE             -> 61+    EMOJI_DELETE             -> 62+    MESSAGE_DELETE           -> 72+    MESSAGE_BULK_DELETE      -> 73+    MESSAGE_PIN              -> 74+    MESSAGE_UNPIN            -> 75+    INTEGRATION_CREATE       -> 80+    INTEGRATION_UPDATE       -> 81+    INTEGRATION_DELETE       -> 82

@@ -50,8 +50,8 @@   deriving ( TextShow ) via TSG.FromGeneric RawEmoji  instance ToJSON RawEmoji where-  toEncoding (CustomEmoji e) = pairs $ "emoji" .= e-  toEncoding (UnicodeEmoji s) = pairs $ "emoji" .= (("name" .= s) :: Object)+  toJSON (CustomEmoji e) = object ["emoji" .= e]+  toJSON (UnicodeEmoji s) = object ["emoji" .= object ["name" .= s]]  instance FromJSON RawEmoji where   parseJSON = withObject "RawEmoji" $ \v -> do

@@ -63,8 +63,8 @@   deriving ( TextShow ) via TSG.FromGeneric ActivityTimestamps  instance ToJSON ActivityTimestamps where-  toEncoding ActivityTimestamps { start, end } = pairs-    ("start" .= (unixToMilliseconds <$> start) <> "end" .= (unixToMilliseconds <$> end))+  toJSON ActivityTimestamps { start, end } = object+    ["start" .= (unixToMilliseconds <$> start), "end" .= (unixToMilliseconds <$> end)]  instance FromJSON ActivityTimestamps where   parseJSON = withObject "ActivityTimestamps" $ \v -> do

@@ -0,0 +1,105 @@+-- | Things that are messageable+module Calamity.Types.Tellable+    ( ToMessage(..)+    , Tellable(..)+    , TFile(..)+    , tell ) where++import           Calamity.Client.Types+import           Calamity.HTTP+import           Calamity.Types.Model.Channel+import           Calamity.Types.Model.Guild+import           Calamity.Types.Model.User+import           Calamity.Types.Snowflake++import           Control.Lens++import           Data.ByteString.Lazy         ( ByteString )+import           Data.Default.Class+import           Data.Monoid+import           Data.Text                    ( Text )++import           GHC.Generics++import qualified Polysemy                     as P+import qualified Polysemy.Error               as P++-- | A wrapper type for sending files+newtype TFile = TFile ByteString+  deriving ( Show, Generic )++-- | Things that can be used to send a message+--+-- Can be used to compose text, embeds, and files. /e.g./+--+-- @+-- 'intoMsg' @'Text' "A message" '<>' 'intoMsg' @'Embed' ('def' '&' #description '?~' "Embed description")+-- @+class ToMessage a where+  intoMsg :: a -> Endo CreateMessageOptions++-- | Message content, '(<>)' concatenates the content+instance ToMessage Text where+  intoMsg t = Endo (#content %~ (<> Just t))++-- | Message embed, '(<>)' merges embeds using '(<>)'+instance ToMessage Embed where+  intoMsg e = Endo (#embed %~ (<> Just e))++-- | Message file, '(<>)' keeps the last added file+instance ToMessage TFile where+  intoMsg (TFile f) = Endo (#file %~ getLast . (<> Last (Just f)) . Last)++instance ToMessage (Endo CreateMessageOptions) where+  intoMsg = Prelude.id++instance ToMessage (CreateMessageOptions -> CreateMessageOptions) where+  intoMsg = Endo++instance ToMessage CreateMessageOptions where+  intoMsg = Endo . const++class Tellable a where+  getChannel :: (BotC r, P.Member (P.Error RestError) r) => a -> P.Sem r (Snowflake Channel)++runToMessage :: ToMessage a => a -> CreateMessageOptions+runToMessage = flip appEndo def . intoMsg++-- | Send a message to something that is messageable+tell :: forall msg r t. (BotC r, ToMessage msg, Tellable t) => t -> msg -> P.Sem r (Either RestError Message)+tell target (runToMessage -> msg) = P.runError $ do+  cid <- getChannel target+  r <- invoke $ CreateMessage cid msg+  P.fromEither r++instance Tellable DMChannel where+  getChannel = pure . getID++instance Tellable (Snowflake DMChannel) where+  getChannel = pure . coerceSnowflake++instance Tellable TextChannel where+  getChannel = pure . getID++instance Tellable (Snowflake TextChannel) where+  getChannel = pure . coerceSnowflake++instance Tellable Message where+  getChannel = pure . getID++messageUser :: (BotC r, P.Member (P.Error RestError) r, HasID User a) => a -> P.Sem r (Snowflake Channel)+messageUser (getID @User -> uid) = do+  c <- invoke $ CreateDM uid+  getID <$> P.fromEither c++instance Tellable (Snowflake Member) where+  getChannel = messageUser . coerceSnowflake @_ @User++instance Tellable Member where+  getChannel = messageUser++instance Tellable User where+  getChannel = messageUser++instance Tellable (Snowflake User) where+  getChannel = messageUser

@@ -40,6 +40,11 @@                      >>> UnixTimestamp  instance ToJSON UnixTimestamp where+  toJSON = unUnixTimestamp+               >>> utcTimeToPOSIXSeconds+               >>> toRational+               >>> round+               >>> toJSON @Word64   toEncoding = unUnixTimestamp                >>> utcTimeToPOSIXSeconds                >>> toRational