Parse Slack email objects without exploding

CHANGELOG.md

@@ -1,3 +1,9 @@
+# 1.6.1.0 (2022-12-16)
+
+* [#124](https://github.com/MercuryTechnologies/slack-web/pull/124)
+  Parse [Slack incoming emails](https://slack.com/help/articles/206819278-Send-emails-to-Slack)
+  without throwing an error.
+
 # 1.6.0.0 (2022-12-14)
 
 ## Breaking changes

slack-web.cabal

@@ -8,8 +8,8 @@ license: MIT
 license-file: LICENSE.md
 
 copyright: 2017 Juan Pedro Villa Isaza, 2022 Mercury Technologies, Inc
-author: Juan Pedro Villa Isaza <jpvillaisaza@gmail.com>, Jade Lovelace <jadel@mercury.com>, Dennis Hennen <dennis@mercury.com>
-maintainer: Jade Lovelace <jadel@mercury.com>
+author: Juan Pedro Villa Isaza <jpvillaisaza@gmail.com>, Jade Lovelace <software at lfcode dot ca>, Dennis Hennen <dennis@mercury.com>
+maintainer: Jade Lovelace <software at lfcode dot ca>
 
 homepage: https://github.com/MercuryTechnologies/slack-web
 bug-reports: https://github.com/MercuryTechnologies/slack-web/issues
@@ -187,6 +187,7 @@ test-suite tests
       Web.Slack.Experimental.Events.TypesSpec
       Web.Slack.Experimental.BlocksSpec
       TestImport
+      TestImport.Aeson
   build-tool-depends:
     hspec-discover:hspec-discover >=2.6.0 && <2.11
   build-depends:
@@ -197,6 +198,7 @@ test-suite tests
     , bytestring
     , classy-prelude
     , fakepull
+    , generic-arbitrary
     , hspec
     , hspec-core
     , hspec-golden

src/Web/Slack/Files/Types.hs

@@ -18,10 +18,42 @@ newtype FileId = FileId {unFileId :: Text}
   deriving stock (Show, Eq)
   deriving newtype (FromJSON, ToJSON)
 
-data FileMode = Hosted | External | Snippet | Post | FileAccess
-  deriving stock (Show, Eq)
+data FileMode
+  = Hosted
+  | External
+  | Snippet
+  | Post
+  | FileAccess
+  | -- | <https://slack.com/help/articles/206819278-Send-emails-to-Slack>
+    --
+    -- @since 1.6.1.0
+    Email
+  | -- | Other file modes.
+    --
+    --   @since 1.6.1.0
+    Other Text
+  deriving stock (Show, Eq, Generic)
+
+instance FromJSON FileMode where
+  parseJSON = A.withText "FileMode" \case
+    "hosted" -> pure Hosted
+    "external" -> pure External
+    "snippet" -> pure Snippet
+    "post" -> pure Post
+    "file_access" -> pure FileAccess
+    "email" -> pure Email
+    other -> pure . Other $ other
 
-$(deriveJSON snakeCaseOptions ''FileMode)
+instance ToJSON FileMode where
+  toJSON =
+    A.String . \case
+      Hosted -> "hosted"
+      External -> "external"
+      Snippet -> "snippet"
+      Post -> "post"
+      FileAccess -> "file_access"
+      Email -> "email"
+      Other s -> s
 
 -- | <https://api.slack.com/types/file>
 data FileObjectVisible = FileObjectVisible

tests/TestImport.hs

@@ -2,10 +2,12 @@ module TestImport
   ( fromJust,
     module Control.Monad.Fail,
     module Test.Hspec,
+    module Test.Hspec.QuickCheck,
     module ClassyPrelude,
     module Data.Aeson,
     module Data.Aeson.TH,
     cs,
+    module Test.QuickCheck,
   )
 where
 
@@ -16,3 +18,6 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Maybe (fromJust)
 import Data.String.Conversions (cs)
 import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+import Test.QuickCheck.Instances ()

tests/TestImport/Aeson.hs

@@ -0,0 +1,14 @@
+module TestImport.Aeson (aesonRoundtrips) where
+
+import Data.Aeson.Types qualified as A
+import TestImport
+
+aesonRoundtrips :: forall a. (FromJSON a, ToJSON a, Eq a) => a -> Bool
+aesonRoundtrips a =
+  let encoded = toJSON a
+      parsed = A.parse (parseJSON @a) encoded
+      roundTwo = fmap (toJSON @a) parsed
+   in -- The encoding is the same
+      A.Success encoded == roundTwo
+        -- AND the object itself is the same
+        && A.Success a == parsed

tests/Web/Slack/Experimental/Events/TypesSpec.hs

@@ -23,4 +23,6 @@ spec = describe "Types for Slack events" do
         , "slackbotIm"
         , "channel_left"
         , "share_without_message"
+        , -- https://slack.com/help/articles/206819278-Send-emails-to-Slack
+          "email_message"
         ]

tests/Web/Slack/Files/TypesSpec.hs

@@ -1,12 +1,21 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+-- GHC told me to set it, and it compiles now 🤷
+{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-}
+
 module Web.Slack.Files.TypesSpec (spec) where
 
 import JSONGolden
+import Test.QuickCheck.Arbitrary.Generic (GenericArbitrary (..))
 import TestImport
+import TestImport.Aeson
 import Web.Slack.Files.Types
 
+deriving via GenericArbitrary FileMode instance Arbitrary FileMode
+
 spec :: Spec
 spec = describe "Types for Slack files" do
   describe "FileObject" do
+    prop "FileMode roundtrips" $ aesonRoundtrips @FileMode
     describe "FromJSON" do
       mapM_
         (oneGoldenTestDecode @FileObject)

tests/golden/SlackWebhookEvent/email_message.golden

@@ -0,0 +1,43 @@
+EventEventCallback
+    ( EventCallback
+        { eventId = EventId
+            { unEventId = "Ev0123467899" }
+        , teamId = TeamId
+            { unTeamId = "T012346789" }
+        , eventTime = MkSystemTime
+            { systemSeconds = 1671217113
+            , systemNanoseconds = 0
+            }
+        , event = EventMessage
+            ( MessageEvent
+                { blocks = Nothing
+                , channel = ConversationId
+                    { unConversationId = "C012346789" }
+                , text = ""
+                , channelType = Channel
+                , files = Just
+                    [ VisibleFileObject
+                        ( FileObjectVisible
+                            { id = FileId
+                                { unFileId = "F0123468789" }
+                            , created = 2022-12-16 18:58:33 UTC
+                            , name = "meow"
+                            , title = "meow"
+                            , mimetype = "text/html"
+                            , urlPrivate = "https://example.com"
+                            , isExternal = False
+                            , size = 6212
+                            , mode = Email
+                            }
+                        )
+                    ]
+                , user = UserId
+                    { unUserId = "USLACKBOT" }
+                , ts = "1671217113.292829"
+                , threadTs = Nothing
+                , appId = Nothing
+                , botId = Just "B012346789"
+                }
+            )
+        }
+    )

tests/golden/SlackWebhookEvent/email_message.json

@@ -0,0 +1,91 @@
+{
+  "token": "aaaa",
+  "team_id": "T012346789",
+  "api_app_id": "A012346789",
+  "event": {
+    "type": "message",
+    "text": "",
+    "files": [
+      {
+        "id": "F0123468789",
+        "created": 1671217113,
+        "timestamp": 1671217110,
+        "name": "meow",
+        "title": "meow",
+        "mimetype": "text/html",
+        "filetype": "email",
+        "pretty_type": "Email",
+        "user": "USLACKBOT",
+        "user_team": "T012346789",
+        "editable": true,
+        "size": 6212,
+        "mode": "email",
+        "is_external": false,
+        "external_type": "",
+        "is_public": true,
+        "public_url_shared": false,
+        "display_as_bot": true,
+        "username": "Email",
+        "url_private": "https://example.com",
+        "url_private_download": "https://example.com",
+        "permalink": "https://example.com",
+        "permalink_public": "https://example.com",
+        "subject": "meow",
+        "to": [
+          {
+            "address": "",
+            "name": "Email",
+            "original": "Email <>"
+          }
+        ],
+        "from": [
+          {
+            "address": "addr@example.com",
+            "name": "meow",
+            "original": "meow <addr@example.com>"
+          }
+        ],
+        "cc": [],
+        "attachments": [],
+        "original_attachment_count": 0,
+        "plain_text": "meow",
+        "preview": "meow",
+        "preview_plain_text": "meow",
+        "headers": {
+          "date": "Fri, 16 Dec 2022 18:58:30 +0000",
+          "in_reply_to": null,
+          "reply_to": null,
+          "message_id": "<meow@example.com>"
+        },
+        "has_more": false,
+        "sent_to_self": false,
+        "bot_id": "B012346789",
+        "has_rich_preview": false,
+        "file_access": "visible"
+      }
+    ],
+    "upload": true,
+    "user": "USLACKBOT",
+    "display_as_bot": true,
+    "bot_id": "B012346789",
+    "ts": "1671217113.292829",
+    "channel": "C012346789",
+    "subtype": "file_share",
+    "event_ts": "1671217113.292829",
+    "channel_type": "channel"
+  },
+  "type": "event_callback",
+  "event_id": "Ev0123467899",
+  "event_time": 1671217113,
+  "authorizations": [
+    {
+      "enterprise_id": null,
+      "team_id": "T012346789",
+      "user_id": "U012346789",
+      "is_bot": true,
+      "is_enterprise_install": false
+    }
+  ],
+  "is_ext_shared_channel": false,
+  "event_context": "aaaa"
+}