{-# options_ghc -Wno-unused-imports #-}
module MSAzureAPI.BotService (
sendMessage
, sendReply
, Activity(..)
, Attachment(..)
, AdaptiveCard(..)
, ACElement(..)
, Image(..)
, TextBlock(..)
, ColumnSet(..)
, Column(..)
) where
import Data.Char (toLower)
import GHC.Exts (IsString(..))
import GHC.Generics (Generic(..))
import qualified Data.Aeson as A (ToJSON(..), genericToJSON, object, (.=), encode, ToJSONKey(..), FromJSON(..), genericParseJSON, withObject, withText, Value(..))
import Network.OAuth.OAuth2.Internal (AccessToken(..))
import Network.HTTP.Req (HttpException, runReq, HttpConfig, defaultHttpConfig, Req, Url, Option, Scheme(..), header, (=:))
import Data.Text (Text, pack, unpack)
import MSAzureAPI.Internal.Common (run, APIPlane(..), Location(..), locationDisplayName, (==:), get, getBs, post, postRaw, getLbs, put, tryReq, aesonOptions, say)
sendReply :: Activity
-> Text
-> [Attachment]
-> AccessToken -> Req ()
sendReply :: Activity -> Text -> [Attachment] -> AccessToken -> Req ()
sendReply Activity
acti Text
txt [Attachment]
atts AccessToken
atok =
case Activity -> Maybe Text
aReplyToId Activity
acti of
Maybe Text
Nothing -> do
forall (m :: * -> *). MonadIO m => String -> m ()
say String
"sendReply: replyToId is null"
Just Text
aid -> forall b a.
(FromJSON b, ToJSON a) =>
Text -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
postRaw Text
urib [Text
"v3", Text
"conversations", Text
cid, Text
"activities", Text
aid] forall a. Monoid a => a
mempty Activity
actO AccessToken
atok
where
urib :: Text
urib = Activity -> Text
aServiceUrl Activity
acti
cid :: Text
cid = ConversationAccount -> Text
coaId forall a b. (a -> b) -> a -> b
$ Activity -> ConversationAccount
aConversation Activity
acti
actO :: Activity
actO = Activity -> Text -> [Attachment] -> Activity
mkReplyActivity Activity
acti Text
txt [Attachment]
atts
mkReplyActivity :: Activity
-> Text
-> [Attachment]
-> Activity
mkReplyActivity :: Activity -> Text -> [Attachment] -> Activity
mkReplyActivity Activity
actI = ActivityType
-> Maybe Text
-> Maybe Text
-> ConversationAccount
-> ChannelAccount
-> ChannelAccount
-> Text
-> Maybe Text
-> Text
-> [Attachment]
-> Activity
Activity ActivityType
ATMessage forall a. Maybe a
Nothing forall a. Maybe a
Nothing ConversationAccount
conO ChannelAccount
froO ChannelAccount
recO Text
surl Maybe Text
replid
where
conO :: ConversationAccount
conO = Activity -> ConversationAccount
aConversation Activity
actI
froO :: ChannelAccount
froO = Activity -> ChannelAccount
aRecipient Activity
actI
recO :: ChannelAccount
recO = Activity -> ChannelAccount
aFrom Activity
actI
surl :: Text
surl = Activity -> Text
aServiceUrl Activity
actI
replid :: Maybe Text
replid = Activity -> Maybe Text
aReplyToId Activity
actI
sendMessage :: (A.FromJSON b) =>
Text
-> Text
-> Activity
-> AccessToken -> Req b
sendMessage :: forall b.
FromJSON b =>
Text -> Text -> Activity -> AccessToken -> Req b
sendMessage Text
urib Text
cid =
forall b a.
(FromJSON b, ToJSON a) =>
Text -> [Text] -> Option 'Https -> a -> AccessToken -> Req b
postRaw Text
urib [Text
"v3", Text
"conversations", Text
cid, Text
"activities"] forall a. Monoid a => a
mempty
data Activity = Activity {
Activity -> ActivityType
aType :: ActivityType
, Activity -> Maybe Text
aId :: Maybe Text
, Activity -> Maybe Text
aChannelId :: Maybe Text
, Activity -> ConversationAccount
aConversation :: ConversationAccount
, Activity -> ChannelAccount
aFrom :: ChannelAccount
, Activity -> ChannelAccount
aRecipient :: ChannelAccount
, Activity -> Text
aServiceUrl :: Text
, Activity -> Maybe Text
aReplyToId :: Maybe Text
, Activity -> Text
aText :: Text
, Activity -> [Attachment]
aAttachments :: [Attachment]
} deriving (Int -> Activity -> ShowS
[Activity] -> ShowS
Activity -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Activity] -> ShowS
$cshowList :: [Activity] -> ShowS
show :: Activity -> String
$cshow :: Activity -> String
showsPrec :: Int -> Activity -> ShowS
$cshowsPrec :: Int -> Activity -> ShowS
Show, forall x. Rep Activity x -> Activity
forall x. Activity -> Rep Activity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Activity x -> Activity
$cfrom :: forall x. Activity -> Rep Activity x
Generic)
instance A.FromJSON Activity where
parseJSON :: Value -> Parser Activity
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"a")
instance A.ToJSON Activity where
toJSON :: Activity -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"a")
data Attachment = Attachment {
Attachment -> AdaptiveCard
attContent :: AdaptiveCard
} deriving (Int -> Attachment -> ShowS
[Attachment] -> ShowS
Attachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Attachment] -> ShowS
$cshowList :: [Attachment] -> ShowS
show :: Attachment -> String
$cshow :: Attachment -> String
showsPrec :: Int -> Attachment -> ShowS
$cshowsPrec :: Int -> Attachment -> ShowS
Show, forall x. Rep Attachment x -> Attachment
forall x. Attachment -> Rep Attachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Attachment x -> Attachment
$cfrom :: forall x. Attachment -> Rep Attachment x
Generic)
instance A.FromJSON Attachment where
parseJSON :: Value -> Parser Attachment
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"att")
instance A.ToJSON Attachment where
toJSON :: Attachment -> Value
toJSON (Attachment AdaptiveCard
ac) = [Pair] -> Value
A.object [
Key
"contentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (String
"application/vnd.microsoft.card.adaptive" :: String)
, Key
"content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= AdaptiveCard
ac
]
data AdaptiveCard = AdaptiveCard {
AdaptiveCard -> [ACElement]
acBody :: [ACElement] } deriving (Int -> AdaptiveCard -> ShowS
[AdaptiveCard] -> ShowS
AdaptiveCard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AdaptiveCard] -> ShowS
$cshowList :: [AdaptiveCard] -> ShowS
show :: AdaptiveCard -> String
$cshow :: AdaptiveCard -> String
showsPrec :: Int -> AdaptiveCard -> ShowS
$cshowsPrec :: Int -> AdaptiveCard -> ShowS
Show, forall x. Rep AdaptiveCard x -> AdaptiveCard
forall x. AdaptiveCard -> Rep AdaptiveCard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AdaptiveCard x -> AdaptiveCard
$cfrom :: forall x. AdaptiveCard -> Rep AdaptiveCard x
Generic)
instance A.FromJSON AdaptiveCard where
parseJSON :: Value -> Parser AdaptiveCard
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"ac")
instance A.ToJSON AdaptiveCard where
toJSON :: AdaptiveCard -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"ac")
data ACElement = ACEColumnSet ColumnSet
| ACEColumn Column
| ACETextBlock TextBlock
| ACEImage Image
deriving (Int -> ACElement -> ShowS
[ACElement] -> ShowS
ACElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ACElement] -> ShowS
$cshowList :: [ACElement] -> ShowS
show :: ACElement -> String
$cshow :: ACElement -> String
showsPrec :: Int -> ACElement -> ShowS
$cshowsPrec :: Int -> ACElement -> ShowS
Show)
instance A.FromJSON ACElement where
parseJSON :: Value -> Parser ACElement
parseJSON Value
j =
(ColumnSet -> ACElement
ACEColumnSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
j)
instance A.ToJSON ACElement where
toJSON :: ACElement -> Value
toJSON = \case
ACEColumnSet ColumnSet
cs -> [Pair] -> Value
A.object [
Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (String
"ColumnSet" :: String)
, Key
"columns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= ColumnSet
cs ]
ACEColumn Column
c -> [Pair] -> Value
A.object [
Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (String
"Column" :: String)
, Key
"items" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Column
c ]
ACETextBlock TextBlock
tb -> [Pair] -> Value
A.object [
Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (String
"TextBlock" :: String)
, Key
"text" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= TextBlock
tb ]
ACEImage Image
imu -> [Pair] -> Value
A.object [
Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= (String
"Image" :: String)
, Key
"url" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
A..= Image
imu ]
data Image = Image {
Image -> Text
imgUrl :: Text } deriving (Int -> Image -> ShowS
[Image] -> ShowS
Image -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Image] -> ShowS
$cshowList :: [Image] -> ShowS
show :: Image -> String
$cshow :: Image -> String
showsPrec :: Int -> Image -> ShowS
$cshowsPrec :: Int -> Image -> ShowS
Show, forall x. Rep Image x -> Image
forall x. Image -> Rep Image x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Image x -> Image
$cfrom :: forall x. Image -> Rep Image x
Generic)
instance A.ToJSON Image where
toJSON :: Image -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"img")
newtype TextBlock = TextBlock {
TextBlock -> Text
tbText :: Text } deriving (Int -> TextBlock -> ShowS
[TextBlock] -> ShowS
TextBlock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextBlock] -> ShowS
$cshowList :: [TextBlock] -> ShowS
show :: TextBlock -> String
$cshow :: TextBlock -> String
showsPrec :: Int -> TextBlock -> ShowS
$cshowsPrec :: Int -> TextBlock -> ShowS
Show, forall x. Rep TextBlock x -> TextBlock
forall x. TextBlock -> Rep TextBlock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextBlock x -> TextBlock
$cfrom :: forall x. TextBlock -> Rep TextBlock x
Generic) deriving newtype (String -> TextBlock
forall a. (String -> a) -> IsString a
fromString :: String -> TextBlock
$cfromString :: String -> TextBlock
IsString)
instance A.ToJSON TextBlock where
toJSON :: TextBlock -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"tb")
data ColumnSet = ColumnSet {
ColumnSet -> [Column]
colsColumns :: [Column] } deriving (Int -> ColumnSet -> ShowS
[ColumnSet] -> ShowS
ColumnSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnSet] -> ShowS
$cshowList :: [ColumnSet] -> ShowS
show :: ColumnSet -> String
$cshow :: ColumnSet -> String
showsPrec :: Int -> ColumnSet -> ShowS
$cshowsPrec :: Int -> ColumnSet -> ShowS
Show, forall x. Rep ColumnSet x -> ColumnSet
forall x. ColumnSet -> Rep ColumnSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ColumnSet x -> ColumnSet
$cfrom :: forall x. ColumnSet -> Rep ColumnSet x
Generic)
instance A.FromJSON ColumnSet where
parseJSON :: Value -> Parser ColumnSet
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"cols")
instance A.ToJSON ColumnSet where
toJSON :: ColumnSet -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"cols")
data Column = Column {
Column -> [ACElement]
colItems :: [ACElement] } deriving (Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show, forall x. Rep Column x -> Column
forall x. Column -> Rep Column x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Column x -> Column
$cfrom :: forall x. Column -> Rep Column x
Generic)
instance A.FromJSON Column where
parseJSON :: Value -> Parser Column
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"col")
instance A.ToJSON Column where
toJSON :: Column -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"col")
data ConversationAccount = ConversationAccount {
ConversationAccount -> Text
coaAadObjectId :: Text
, ConversationAccount -> Text
coaId :: Text
, ConversationAccount -> Text
coaName :: Text
, ConversationAccount -> Bool
coaIsGroup :: Bool
} deriving (Int -> ConversationAccount -> ShowS
[ConversationAccount] -> ShowS
ConversationAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversationAccount] -> ShowS
$cshowList :: [ConversationAccount] -> ShowS
show :: ConversationAccount -> String
$cshow :: ConversationAccount -> String
showsPrec :: Int -> ConversationAccount -> ShowS
$cshowsPrec :: Int -> ConversationAccount -> ShowS
Show, forall x. Rep ConversationAccount x -> ConversationAccount
forall x. ConversationAccount -> Rep ConversationAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConversationAccount x -> ConversationAccount
$cfrom :: forall x. ConversationAccount -> Rep ConversationAccount x
Generic)
instance A.FromJSON ConversationAccount where
parseJSON :: Value -> Parser ConversationAccount
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"coa")
instance A.ToJSON ConversationAccount where
toJSON :: ConversationAccount -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"coa")
data ChannelAccount = ChannelAccount {
ChannelAccount -> Text
caAadObjectId :: Text
, ChannelAccount -> Text
caId :: Text
, ChannelAccount -> Text
caName :: Text
} deriving (Int -> ChannelAccount -> ShowS
[ChannelAccount] -> ShowS
ChannelAccount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChannelAccount] -> ShowS
$cshowList :: [ChannelAccount] -> ShowS
show :: ChannelAccount -> String
$cshow :: ChannelAccount -> String
showsPrec :: Int -> ChannelAccount -> ShowS
$cshowsPrec :: Int -> ChannelAccount -> ShowS
Show, forall x. Rep ChannelAccount x -> ChannelAccount
forall x. ChannelAccount -> Rep ChannelAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChannelAccount x -> ChannelAccount
$cfrom :: forall x. ChannelAccount -> Rep ChannelAccount x
Generic)
instance A.FromJSON ChannelAccount where
parseJSON :: Value -> Parser ChannelAccount
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
aesonOptions String
"ca")
instance A.ToJSON ChannelAccount where
toJSON :: ChannelAccount -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
A.genericToJSON (String -> Options
aesonOptions String
"ca")
data ActivityType = ATMessage
| ATContactRelationUpdate
| ATConversationUpdate
| ATTyping
| ATEndOfConversation
| ATEvent
| ATInvoke
| ATDeleteUserData
| ATMessageUpdate
| ATMessageDelete
| ATInstallationUpdate
| ATMessageReaction
| ATSuggestion
| ATTrace
| ATHandoff deriving (ActivityType -> ActivityType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivityType -> ActivityType -> Bool
$c/= :: ActivityType -> ActivityType -> Bool
== :: ActivityType -> ActivityType -> Bool
$c== :: ActivityType -> ActivityType -> Bool
Eq, Int -> ActivityType -> ShowS
[ActivityType] -> ShowS
ActivityType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivityType] -> ShowS
$cshowList :: [ActivityType] -> ShowS
show :: ActivityType -> String
$cshow :: ActivityType -> String
showsPrec :: Int -> ActivityType -> ShowS
$cshowsPrec :: Int -> ActivityType -> ShowS
Show)
instance A.FromJSON ActivityType where
parseJSON :: Value -> Parser ActivityType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"ActivityType" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text
t of
Text
"message" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATMessage
Text
"contactRelationUpdate" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATContactRelationUpdate
Text
"conversationUpdate" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATConversationUpdate
Text
"typing" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATTyping
Text
"endOfConversation" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATEndOfConversation
Text
"event" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATEvent
Text
"invoke" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATInvoke
Text
"deleteUserData" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATDeleteUserData
Text
"messageUpdate" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATMessageUpdate
Text
"messageDelete" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATMessageDelete
Text
"installationUpdate" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATInstallationUpdate
Text
"messageReaction" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATMessageReaction
Text
"suggestion" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATSuggestion
Text
"trace" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATTrace
Text
"handoff" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivityType
ATHandoff
Text
errstr -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [Text -> String
unpack Text
errstr, String
"not a valid ActivityType"]
instance A.ToJSON ActivityType where
toJSON :: ActivityType -> Value
toJSON ActivityType
v = Text -> Value
A.String forall a b. (a -> b) -> a -> b
$ (String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
headLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) ActivityType
v
where
headLower :: ShowS
headLower (Char
x:String
xs) = Char -> Char
toLower Char
x forall a. a -> [a] -> [a]
: String
xs
headLower [] = []