{-# 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