{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Test.Sandwich.Formatters.Internal.Core where

import Control.Lens hiding ((??))
import Control.Monad.Except
import Data.Aeson
import qualified Data.Aeson as A
import Data.Aeson.Lens
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import qualified Network.Wreq as W
import Test.Sandwich.Formatters.Internal.Types

postMessage :: (MonadError T.Text m, MonadIO m) => SlackConfig -> ChannelName -> T.Text -> [A.Value] -> Maybe [A.Value] -> m Value
postMessage :: SlackConfig
-> ChannelName
-> ChannelName
-> [Value]
-> Maybe [Value]
-> m Value
postMessage SlackConfig
conf ChannelName
cid ChannelName
msg [Value]
as Maybe [Value]
maybeBlocks =
  SlackConfig -> String -> Value -> m Value
forall (m :: * -> *).
(MonadError ChannelName m, MonadIO m) =>
SlackConfig -> String -> Value -> m Value
makeSlackCall SlackConfig
conf String
"chat.postMessage" (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [
    (ChannelName
"token", ChannelName -> Value
A.String (ChannelName -> Value) -> ChannelName -> Value
forall a b. (a -> b) -> a -> b
$ SlackConfig -> ChannelName
slackApiToken SlackConfig
conf)
    , (ChannelName
"channel", ChannelName -> Value
A.String ChannelName
cid)
    , (ChannelName
"text", ChannelName -> Value
A.String ChannelName
msg)
    , (ChannelName
"attachments", Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
as)
    , (ChannelName
"as_user", Bool -> Value
A.Bool Bool
True)
    ]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> (case Maybe [Value]
maybeBlocks of Maybe [Value]
Nothing -> []; Just [Value]
blocks -> [(ChannelName
"blocks", Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
blocks)])

updateMessage :: (MonadError T.Text m, MonadIO m) => SlackConfig -> ChannelName -> T.Text -> T.Text -> [A.Value] -> Maybe [A.Value] -> m ()
updateMessage :: SlackConfig
-> ChannelName
-> ChannelName
-> ChannelName
-> [Value]
-> Maybe [Value]
-> m ()
updateMessage SlackConfig
conf ChannelName
cid ChannelName
ts ChannelName
msg [Value]
as Maybe [Value]
maybeBlocks =
  m Value -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Value -> m ()) -> m Value -> m ()
forall a b. (a -> b) -> a -> b
$ SlackConfig -> String -> Value -> m Value
forall (m :: * -> *).
(MonadError ChannelName m, MonadIO m) =>
SlackConfig -> String -> Value -> m Value
makeSlackCall SlackConfig
conf String
"chat.update" (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [
    (ChannelName
"token", ChannelName -> Value
A.String (ChannelName -> Value) -> ChannelName -> Value
forall a b. (a -> b) -> a -> b
$ SlackConfig -> ChannelName
slackApiToken SlackConfig
conf)
    , (ChannelName
"channel", ChannelName -> Value
A.String ChannelName
cid)
    , (ChannelName
"text", ChannelName -> Value
A.String ChannelName
msg)
    , (ChannelName
"attachments", Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
as)
    , (ChannelName
"as_user", Bool -> Value
A.Bool Bool
True)
    , (ChannelName
"ts", ChannelName -> Value
A.String ChannelName
ts)
    ]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> (case Maybe [Value]
maybeBlocks of Maybe [Value]
Nothing -> []; Just [Value]
blocks -> [(ChannelName
"blocks", Array -> Value
A.Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList [Value]
blocks)])

encode' :: A.ToJSON a => a -> T.Text
encode' :: a -> ChannelName
encode' = ByteString -> ChannelName
T.decodeUtf8 (ByteString -> ChannelName)
-> (a -> ByteString) -> a -> ChannelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
encode

makeSlackCall :: (MonadError T.Text m, MonadIO m) => SlackConfig -> String -> A.Value -> m Value
makeSlackCall :: SlackConfig -> String -> Value -> m Value
makeSlackCall SlackConfig
conf String
method Value
body = do
  let url :: String
url = String
"https://slack.com/api/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
method
  let opts :: Options
opts = Options
W.defaults Options -> (Options -> Options) -> Options
forall a b. a -> (a -> b) -> b
& (HeaderName -> Lens' Options [ByteString]
W.header HeaderName
"Authorization" (([ByteString] -> Identity [ByteString])
 -> Options -> Identity Options)
-> [ByteString] -> Options -> Options
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ByteString
"Bearer " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ChannelName -> ByteString
T.encodeUtf8 (SlackConfig -> ChannelName
slackApiToken SlackConfig
conf)])
  Response ByteString
rawResp <- IO (Response ByteString) -> m (Response ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Options -> String -> Value -> IO (Response ByteString)
forall a.
Postable a =>
Options -> String -> a -> IO (Response ByteString)
W.postWith Options
opts String
url (Value
body)
  Value
resp <- Response ByteString
rawResp Response ByteString
-> Getting (First Value) (Response ByteString) Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ByteString -> Const (First Value) ByteString)
-> Response ByteString -> Const (First Value) (Response ByteString)
forall body0 body1.
Lens (Response body0) (Response body1) body0 body1
W.responseBody ((ByteString -> Const (First Value) ByteString)
 -> Response ByteString
 -> Const (First Value) (Response ByteString))
-> ((Value -> Const (First Value) Value)
    -> ByteString -> Const (First Value) ByteString)
-> Getting (First Value) (Response ByteString) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Value) Value)
-> ByteString -> Const (First Value) ByteString
forall t. AsValue t => Prism' t Value
_Value Maybe Value -> ChannelName -> m Value
forall e (m :: * -> *) a. MonadError e m => Maybe a -> e -> m a
?? ChannelName
"Couldn't parse response"
  case Value
resp Value -> Getting (First Bool) Value Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? ChannelName -> Traversal' Value Value
forall t. AsValue t => ChannelName -> Traversal' t Value
key ChannelName
"ok" ((Value -> Const (First Bool) Value)
 -> Value -> Const (First Bool) Value)
-> Getting (First Bool) Value Bool
-> Getting (First Bool) Value Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Bool) Value Bool
forall t. AsPrimitive t => Prism' t Bool
_Bool of
    Just Bool
True -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
resp
    Just Bool
False -> ChannelName -> m Value
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ChannelName -> m Value) -> ChannelName -> m Value
forall a b. (a -> b) -> a -> b
$ Value
resp Value -> Getting ChannelName Value ChannelName -> ChannelName
forall s a. s -> Getting a s a -> a
^. ChannelName -> Traversal' Value Value
forall t. AsValue t => ChannelName -> Traversal' t Value
key ChannelName
"error" ((Value -> Const ChannelName Value)
 -> Value -> Const ChannelName Value)
-> Getting ChannelName Value ChannelName
-> Getting ChannelName Value ChannelName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ChannelName Value ChannelName
forall t. AsPrimitive t => Prism' t ChannelName
_String
    Maybe Bool
Nothing -> ChannelName -> m Value
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ChannelName
"Couldn't parse key 'ok' from response"

infixl 7 ??
(??) :: MonadError e m => Maybe a -> e -> m a
Maybe a
x ?? :: Maybe a -> e -> m a
?? e
e = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
x