{-# LANGUAGE CPP #-}

module Test.Sandwich.Formatters.Slack.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.Slack.Internal.Types

#if MIN_VERSION_mtl(2,3,0)
import Control.Monad
import Control.Monad.IO.Class
#endif


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

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

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

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