diff --git a/bot/app/Main.hs b/bot/app/Main.hs index 7b138d3..a1d3246 100644 --- 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 index f1d362f..281072d 100644 --- 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 index 45468e4..2700999 100644 --- 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 = }" - ] + show (CreateMessageAttachment filename description _) = + mconcat + [ "CreateMessageAttachment {filename = " + , show filename + , ", description = " + , show description + , ", content = }" + ] data CreateMessageOptions = CreateMessageOptions { content :: Maybe Text diff --git a/calamity/ChangeLog.md b/calamity/ChangeLog.md index 61e8363..84984ca 100644 --- 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 index cd92807..7bbffca 100644 --- 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 index 3321126..aa24970 100644 --- 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