Skip to content

Commit

Permalink
Fix bug decoding SlackPlainText (#131)
Browse files Browse the repository at this point in the history
The `SlackPlainText` constructor of `SlackTextObject`'s `ToJSON` and
`FromJSON` instances disagreed on whether its type should be
`"plain_text"` or `"text"`.

This failure to decode when the type was set to `"plain_text"` caused a
bug when interacting with slack.
  • Loading branch information
rampion authored Jan 9, 2024
1 parent d3c9bc6 commit 119ed19
Show file tree
Hide file tree
Showing 3 changed files with 168 additions and 4 deletions.
4 changes: 3 additions & 1 deletion slack-web.cabal
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
cabal-version: 2.2
name: slack-web
version: 2.0.0.0
version: 2.0.0.1

build-type: Simple

Expand Down Expand Up @@ -186,6 +186,7 @@ test-suite tests
Web.Slack.Experimental.RequestVerificationSpec
Web.Slack.Experimental.Events.TypesSpec
Web.Slack.Experimental.BlocksSpec
Web.Slack.Experimental.Blocks.TypesSpec
TestImport
TestImport.Aeson
build-tool-depends:
Expand All @@ -205,6 +206,7 @@ test-suite tests
, mtl
, pretty-simple ^>= 4.1
, quickcheck-instances
, refined
, slack-web
, string-conversions
, string-variants
Expand Down
6 changes: 3 additions & 3 deletions src/Web/Slack/Experimental/Blocks/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -81,13 +81,13 @@ instance FromJSON SlackTextObject where
parseJSON = withObject "SlackTextObject" $ \obj -> do
(slackTextType :: Text) <- obj .: "type"
case slackTextType of
"text" -> do
"plain_text" -> do
text <- obj .: "text"
pure . SlackPlainText . SlackText $ lines text
"mrkdwn" -> do
text <- obj .: "text"
pure . SlackMarkdownText . SlackText $ lines text
_ -> fail "Unknown SlackTextObject type, must be one of ['text', 'mrkdwn']"
_ -> fail "Unknown SlackTextObject type, must be one of ['plain_text', 'mrkdwn']"

instance Show SlackText where
show (SlackText arr) = show $ concat arr
Expand Down Expand Up @@ -653,7 +653,7 @@ data SlackConfirmObject = SlackConfirmObject
, slackConfirmDeny :: SlackPlainTextOnly -- max length 30
, slackConfirmStyle :: Maybe SlackStyle
}
deriving stock (Eq)
deriving stock (Eq, Show)

instance ToJSON SlackConfirmObject where
toJSON SlackConfirmObject {..} =
Expand Down
162 changes: 162 additions & 0 deletions tests/Web/Slack/Experimental/Blocks/TypesSpec.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,162 @@
module Web.Slack.Experimental.Blocks.TypesSpec where

import Data.Aeson qualified as Aeson
import Data.StringVariants.NonEmptyText.Internal (pattern NonEmptyText)
import Refined.Unsafe (reallyUnsafeRefine)
import TestImport
import Web.Slack.Experimental.Blocks.Types

jsonRoundtrips :: (Show a, Eq a, Aeson.ToJSON a, Aeson.FromJSON a) => a -> Spec
jsonRoundtrips a = do
it "can decode its own json encoding" do
(Aeson.fromJSON . Aeson.toJSON) a `shouldBe` Aeson.Success a

spec :: Spec
spec = do
let
aSlackAccessory = SlackButtonAccessory aSlackAction
aSlackAction = SlackAction
do SlackActionId $ NonEmptyText "action-id"
do aSlackButton
aSlackActionList =
SlackActionList
. reallyUnsafeRefine
$ [ aSlackAction
, SlackAction
do SlackActionId $ NonEmptyText "another-action-id"
do
SlackButton
do SlackButtonText $ NonEmptyText "another-button-text"
do Nothing
do Nothing
do Nothing
do Nothing
]
aSlackBlockSection = SlackBlockSection aSlackSection
aSlackBlockImage = SlackBlockImage aSlackImage
aSlackBlockContext = SlackBlockContext aSlackContext
aSlackBlockActions = SlackBlockActions
do Just $ NonEmptyText "block-actions"
do aSlackActionList
aSlackBlockHeader = SlackBlockHeader $ SlackPlainTextOnly "block-header"
aSlackButton =
SlackButton
{ slackButtonText = SlackButtonText (NonEmptyText "button-text")
, slackButtonUrl = Just (NonEmptyText "button-url")
, slackButtonValue = Just (NonEmptyText "button-value")
, slackButtonStyle = Just SlackStylePrimary
, slackButtonConfirm = Just aSlackConfirmObject
}
aSlackConfirmObject =
SlackConfirmObject
{ slackConfirmTitle = SlackPlainTextOnly "button-confirm-title"
, slackConfirmText = SlackPlainText "button-confirm-text"
, slackConfirmConfirm = SlackPlainTextOnly "button-confirm-confirm"
, slackConfirmDeny = SlackPlainTextOnly "button-confirm-deny"
, slackConfirmStyle = Just SlackStyleDanger
}
aSlackContentText = SlackContentText "content-text"
aSlackContentImage = SlackContentImage aSlackImage
aSlackContext = SlackContext [aSlackContentText, aSlackContentImage]
aSlackImage =
SlackImage
{ slackImageTitle = Just "image-title"
, slackImageAltText = "image-alt-text"
, slackImageUrl = "image-url"
}
aSlackMessage =
SlackMessage
[ aSlackBlockSection
, aSlackBlockImage
, aSlackBlockContext
, aSlackBlockActions
, aSlackBlockHeader
-- not tested: SlackBlockRichText
]
aSlackPlainTextOnly = SlackPlainTextOnly "plain-text-only"
aSlackPlainText = SlackPlainText "plain-text"
aSlackMarkdownText = SlackMarkdownText "markdown-text"
aSlackSection =
SlackSection
{ slackSectionText = Just "section-text"
, slackSectionBlockId = Just (NonEmptyText "section-block-id")
, slackSectionFields = Just ["field-0", "field-1", "field-2"]
, slackSectionAccessory = Just aSlackAccessory
}

describe "SlackAccessory" do
jsonRoundtrips aSlackAccessory

describe "SlackAction" do
jsonRoundtrips aSlackAction

describe "SlackBlock" do
describe "SlackBlockSection" do
jsonRoundtrips aSlackBlockSection

describe "SlackBlockImage" do
jsonRoundtrips aSlackBlockImage

describe "SlackBlockContext" do
jsonRoundtrips aSlackBlockContext

describe "SlackBlockDivider" do
jsonRoundtrips SlackBlockDivider

-- SlackBlock's ToJSON instance is lossy; SlackBlockRichText values get
-- encoded as '{}'
--
-- describe "SlackBlockRichText" do
-- jsonRoundtrips aSlackBlockRichText

describe "SlackBlockActions" do
jsonRoundtrips aSlackBlockActions

describe "SlackBlockHeader" do
jsonRoundtrips aSlackBlockHeader

describe "SlackConfirmObject" do
jsonRoundtrips aSlackConfirmObject

describe "SlackContent" do
describe "SlackContentText" do
jsonRoundtrips aSlackContentText

describe "SlackContentImage" do
jsonRoundtrips aSlackContentImage

describe "SlackContext" do
jsonRoundtrips aSlackContext

describe "SlackMessage" do
jsonRoundtrips aSlackMessage

describe "SlackPlainTextOnly" do
jsonRoundtrips aSlackPlainTextOnly

describe "SlackTextObject" do
describe "SlackPlainText" do
jsonRoundtrips aSlackPlainText

describe "SlackMarkdownText" do
jsonRoundtrips aSlackMarkdownText

-- Untestable for roundtripping:
--
-- FromJSON only
-- - RichItem
-- - RichStyle
-- - RichText
-- - RichTextSectionItem
-- - SlackActionComponent
-- - SlackActionResponse
-- - SlackInteractivePayload
-- - SlackInteractiveResponseResponse
--
-- ToJSON only
-- - SlackInteractiveResponse
-- - SlackText
--
-- Note also that SlackBlock's encoding is lossy, encoding
-- SlackBlockRichText as '{}', so that case is not tested
-- for round-tripping

0 comments on commit 119ed19

Please sign in to comment.