{-# LANGUAGE OverloadedStrings #-}

module Webhook where

import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import Data.Word (Word64)
import Network.Pusher
  ( WebhookEv (..),
    WebhookPayload (..),
    Webhooks (..),
    parseWebhookPayloadWith,
  )
import Network.Pusher.Protocol (User (..))
import Test.Hspec (Spec, describe, it)
import Test.QuickCheck (property)

data TestWebhookPayload
  = TestWebhookPayload
      { -- A Request received from Pusher Channels
        _webhookRequest :: ([(BC.ByteString, BC.ByteString)], BC.ByteString),
        -- Must have this key
        _hasKey :: B.ByteString,
        -- Which must correspond to this secret
        _hasSecret :: B.ByteString,
        -- And which must parse to this Payload
        _payload :: Maybe WebhookPayload
      }

-- Attempt to parse the contained req.
-- - It must use our appKey which must correspond to our secret.
-- - The body must be correctly signed by our secret.
-- - The parsed payload must then further be identical to the one we expect.
testWebhookPayloadParses :: TestWebhookPayload -> Bool
testWebhookPayloadParses (TestWebhookPayload (headers, body) hasKey correspondingSecret expectedPayload) =
  let parseResult =
        parseWebhookPayloadWith
          ( \k ->
              if k == hasKey
                then Just correspondingSecret
                else Nothing
          )
          headers
          body
   in parseResult == expectedPayload

-- Build a _simple_ TestWebhookPayload which contains:
-- - A HTTP POST request with key and signature headers and a 'ByteString' body
-- - A mapping from the same key to the secret used to sign the body to produce
--   the signature.
-- - A list of webhook events we expect to have in the body.
--
-- The caller can deliberately pass incorrect timestamps, bodies, secrets,
-- signatures and event combinations to test whether parsing fails as expected.
--
-- Parsing of values generated by this function should only succeed when:
-- - The timestamp is the same as the one in the message body
-- - The message body contains exactly the same list of events
-- - The body is encrypted by the given key to produce the given signature
--
-- The word _simple_ excludes cases where:
-- - The HTTP request doesn't have the required headers
-- - The HTTP headers are different to the expected payload
-- - The HTTP requests key is unknown or doesn't match our secret
mkSimpleTestWebhookPayload ::
  B.ByteString ->
  B.ByteString ->
  Word64 ->
  BC.ByteString ->
  B.ByteString ->
  [WebhookEv] ->
  TestWebhookPayload
mkSimpleTestWebhookPayload key secret timestampMS body signature whs =
  TestWebhookPayload
    { _webhookRequest =
        ([("X-Pusher-Key", key), ("X-Pusher-Signature", signature)], body),
      _hasKey = key,
      _hasSecret = secret,
      _payload =
        Just
          WebhookPayload
            { xPusherKey = key,
              xPusherSignature = signature,
              webhooks =
                Webhooks {timeMs = timestampMS, webhookEvs = whs}
            }
    }

channelOccupiedPayload :: TestWebhookPayload
channelOccupiedPayload =
  mkSimpleTestWebhookPayload
    "ebc2cca5d18f3cf01d99"
    "6f87cba29d7b8f6f4a36"
    1502790365001
    "{\"time_ms\":1502790365001,\"events\":[{\"channel\":\"foo\",\"name\":\"channel_occupied\"}]}"
    "4b3d29966e4930d875ec01012e37c18070f4b779b09f71af99d1f0baaffabc98"
    [ChannelOccupiedEv {onChannel = "foo"}]

channelVacatedPayload :: TestWebhookPayload
channelVacatedPayload =
  mkSimpleTestWebhookPayload
    "ebc2cca5d18f3cf01d99"
    "6f87cba29d7b8f6f4a36"
    1502790363928
    "{\"time_ms\":1502790363928,\"events\":[{\"channel\":\"foo\",\"name\":\"channel_vacated\"}]}"
    "c9c70dcf19e011912ecdabe8997b451a95667157d00e37c7476491e7f233c416"
    [ChannelVacatedEv {onChannel = "foo"}]

memberAddedPayload :: TestWebhookPayload
memberAddedPayload =
  mkSimpleTestWebhookPayload
    "ebc2cca5d18f3cf01d99"
    "6f87cba29d7b8f6f4a36"
    1503394956847
    "{\"time_ms\":1503394956847,\"events\":[{\"channel\":\"presence-foo\",\"user_id\":\"42\",\"name\":\"member_added\"}]}"
    "392bd546e8a33a826d7870bd6432f6c7dcf11ca31565575d8c72f9b02f5b0736"
    [ MemberAddedEv
        { onChannel = "presence-foo",
          withUser = User "42"
        }
    ]

memberRemovedPayload :: TestWebhookPayload
memberRemovedPayload =
  mkSimpleTestWebhookPayload
    "ebc2cca5d18f3cf01d99"
    "6f87cba29d7b8f6f4a36"
    1503394971554
    "{\"time_ms\":1503394971554,\"events\":[{\"channel\":\"presence-foo\",\"user_id\":\"42\",\"name\":\"member_removed\"}]}"
    "9a344e8aeb2c6339999e84bacb4d50b3674599e297d01655eb2cec3f9c655763"
    [ MemberRemovedEv
        { onChannel = "presence-foo",
          withUser = User "42"
        }
    ]

clientEventPayload :: TestWebhookPayload
clientEventPayload =
  mkSimpleTestWebhookPayload
    "ebc2cca5d18f3cf01d99"
    "6f87cba29d7b8f6f4a36"
    1503397271011
    "{\"time_ms\":1503397271011,\"events\":[{\"name\":\"client_event\",\"channel\":\"presence-foo\",\"event\":\"client-event\",\"data\":\"{\\\"name\\\":\\\"John\\\",\\\"message\\\":\\\"Hello\\\"}\",\"socket_id\":\"219049.596715\",\"user_id\":\"sturdy-window-821\"}]}"
    "e5ef8964e8c87c91dde0555e46fa921163aff262395c9e36c1755ffe206be547"
    [ ClientEv
        { onChannel = "presence-foo",
          clientEvName = "client-event",
          clientEvBody =
            Just $
              A.toJSON
                (HM.fromList [("name", "John"), ("message", "Hello")] :: HM.HashMap T.Text T.Text),
          withSocketId = "219049.596715",
          withPossibleUser = Just . User $ "sturdy-window-821"
        }
    ]

batchEventPayload :: TestWebhookPayload
batchEventPayload =
  mkSimpleTestWebhookPayload
    "ebc2cca5d18f3cf01d99"
    "6f87cba29d7b8f6f4a36"
    1503397088953
    "{\"time_ms\":1503397088953,\"events\":[{\"channel\":\"private-foo\",\"name\":\"channel_occupied\"},{\"channel\":\"presence-foo\",\"name\":\"channel_occupied\"}]}"
    "7a9803e1ca598dac4750a60fbb017d4f34fc44eaf0aea26c694ca0d7060e6477"
    [ ChannelOccupiedEv {onChannel = "private-foo"},
      ChannelOccupiedEv {onChannel = "presence-foo"}
    ]

test :: Spec
test =
  describe "Webhook.parseWebhookPayloadWith" $ do
    it "parses and validates a channel_occupied event"
      $ property
      $ testWebhookPayloadParses channelOccupiedPayload
    it "parses and validates a Channel_vacated event"
      $ property
      $ testWebhookPayloadParses channelVacatedPayload
    it "parses and validates a member_added event"
      $ property
      $ testWebhookPayloadParses memberAddedPayload
    it "parses and validates a member_removed event"
      $ property
      $ testWebhookPayloadParses memberRemovedPayload
    it "parses and validates a client event"
      $ property
      $ testWebhookPayloadParses clientEventPayload
    it "parses and validates multiple batched events"
      $ property
      $ testWebhookPayloadParses batchEventPayload