Bump to 0.10.0.0

simmsb · Jul 17, 2023 · 3d0c34f · 3d0c34f
1 parent 6a0efe0
commit 3d0c34f
Show file tree

Hide file tree

Showing 6 changed files with 73 additions and 29 deletions.
diff --git a/bot/app/Main.hs b/bot/app/Main.hs
@@ -35,6 +35,7 @@ import Data.Foldable (for_)
 import Data.Text qualified as T
 import Di qualified
 import DiPolysemy qualified as DiP
+import Network.HTTP.Client (RequestBody (RequestBodyLBS))
 import Optics
 import Polysemy qualified as P
 import Polysemy.Async qualified as P
@@ -70,7 +71,7 @@ main = do
           command @'[User] "pfp" \ctx u -> do
             Right pfp <- fetchAsset (u ^. #avatar)
             let name = maybe "default.png" assetHashFile (u ^. #avatar % #hash)
-                file = CreateMessageAttachment name (Just "Your avatar") pfp
+                file = CreateMessageAttachment name (Just "Your avatar") (Network.HTTP.Client.RequestBodyLBS pfp)
             void $ tell ctx file
           command @'[User] "utest" \ctx u -> do
             void . tell @T.Text ctx $ "got user: " <> showt u

diff --git a/bot/bot.cabal b/bot/bot.cabal
@@ -33,6 +33,7 @@ executable bot
     , di
     , di-core
     , di-polysemy
+    , http-client
     , optics
     , polysemy
     , polysemy-plugin

diff --git a/calamity/Calamity/HTTP/Channel.hs b/calamity/Calamity/HTTP/Channel.hs
@@ -53,13 +53,14 @@ data CreateMessageAttachment = CreateMessageAttachment
   }
 
 instance Show CreateMessageAttachment where
-  show (CreateMessageAttachment filename description _) = mconcat
-    [ "CreateMessageAttachment {filename = "
-    , show filename
-    , ", description = "
-    , show description
-    , ", content = <body>}"
-    ]
+  show (CreateMessageAttachment filename description _) =
+    mconcat
+      [ "CreateMessageAttachment {filename = "
+      , show filename
+      , ", description = "
+      , show description
+      , ", content = <body>}"
+      ]
 
 data CreateMessageOptions = CreateMessageOptions
   { content :: Maybe Text

diff --git a/calamity/ChangeLog.md b/calamity/ChangeLog.md
@@ -1,5 +1,10 @@
 # Changelog for Calamity
 
+## 0.10.0.0
+
++ Updated `CreateMessageAttachment.content` to be a `Network.HTTP.Client.RequestBody`
+  to allow for easy streaming of uploads
+
 ## 0.9.0.0
 
 + Require tls >= 1.7

diff --git a/calamity/README.md b/calamity/README.md
@@ -57,9 +57,8 @@ project listed here)
 {- cabal:
   build-depends:
      base >= 4.13 && < 5
-     , calamity >= 0.3.0.0
+     , calamity >= 0.10.0.0
      , optics >= 0.4.1 && < 0.5
-     , lens >= 5.1 && < 6
      , di-polysemy ^>= 0.2
      , di >= 1.3 && < 2
      , df1 >= 0.3 && < 0.5
@@ -68,44 +67,51 @@ project listed here)
      , polysemy-plugin >= 0.3 && <0.5
      , stm >= 2.5 && <3
      , text-show >= 3.8 && <4
+     , http-client ^>= 0.7
 -}
 
 {-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
 
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
 
 module Main (main) where
 
 import Calamity
 import Calamity.Cache.InMemory
 import Calamity.Commands
-import Calamity.Commands.Context (useFullContext)
-import qualified Calamity.Interactions as I
+import Calamity.Commands.Context (FullContext, useFullContext)
+import Calamity.Interactions qualified as I
 import Calamity.Metrics.Noop
+import Calamity.Utils.CDNUrl (assetHashFile)
 import Control.Concurrent
-import Optics
 import Control.Monad
-import qualified Data.Text as T
-import qualified Di
-import qualified DiPolysemy as DiP
-import qualified Polysemy as P
-import qualified Polysemy.Async as P
-import qualified Polysemy.State as P
+import Data.Foldable (for_)
+import Data.Text qualified as T
+import Di qualified
+import DiPolysemy qualified as DiP
+import Optics
+import Polysemy qualified as P
+import Polysemy.Async qualified as P
+import Polysemy.State qualified as P
 import System.Environment (getEnv)
 import TextShow
+import Network.HTTP.Client (RequestBody(RequestBodyLBS))
 
 data MyViewState = MyViewState
   { numOptions :: Int
@@ -118,15 +124,25 @@ main :: IO ()
 main = do
   token <- T.pack <$> getEnv "BOT_TOKEN"
   Di.new $ \di ->
-    void . P.runFinal . P.embedToFinal . DiP.runDiToIO di
+    void
+      . P.runFinal
+      . P.embedToFinal
+      . DiP.runDiToIO di
       . runCacheInMemory
       . runMetricsNoop
       . useConstantPrefix "!"
       . useFullContext
-      $ runBotIO (BotToken token) defaultIntents $ do
-        addCommands $ do
+      $ runBotIO (BotToken token) defaultIntents
+      $ do
+        void . addCommands $ do
+          helpCommand
           -- just some examples
 
+          command @'[User] "pfp" \ctx u -> do
+            Right pfp <- fetchAsset (u ^. #avatar)
+            let name = maybe "default.png" assetHashFile (u ^. #avatar % #hash)
+                file = CreateMessageAttachment name (Just "Your avatar") (Network.HTTP.Client.RequestBodyLBS pfp)
+            void $ tell ctx file
           command @'[User] "utest" \ctx u -> do
             void . tell @T.Text ctx $ "got user: " <> showt u
           command @'[Named "u" User, Named "u1" User] "utest2" \ctx u u1 -> do
@@ -219,7 +235,27 @@ main = do
                     void $ I.respond ("Thanks: " <> a <> " " <> b)
                     I.endView ()
 
-              pure ()
+        react @('CustomEvt (CtxCommandError FullContext)) \(CtxCommandError ctx e) -> do
+          DiP.info $ "Command failed with reason: " <> showt e
+          case e of
+            ParseError n r ->
+              void . tell ctx $
+                "Failed to parse parameter: "
+                  <> codeline n
+                  <> ", with reason: "
+                  <> codeblock' Nothing r
+            CheckError n r ->
+              void . tell ctx $
+                "The following check failed: "
+                  <> codeline n
+                  <> ", with reason: "
+                  <> codeblock' Nothing r
+            InvokeError n r ->
+              void . tell ctx $
+                "The command: "
+                  <> codeline n
+                  <> ", failed with reason: "
+                  <> codeblock' Nothing r
 ```
 
 ## Disabling library logging

diff --git a/calamity/calamity.cabal b/calamity/calamity.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.0
 name:               calamity
-version:            0.9.0.0
+version:            0.10.0.0
 synopsis:           A library for writing discord bots in haskell
 description:
   Please see the README on GitHub at <https://github.com/simmsb/calamity#readme>