-- | Users.Group
--
-- A 'Group' is an AAD group, which can be a Microsoft 365 group, or a security group.
--
-- A team in Microsoft Teams is a collection of channel objects. A channel represents a topic, and therefore a logical isolation of discussion, within a team.
--
-- Every team is associated with a Microsoft 365 group. The group has the same ID as the team - for example, @\/groups\/{id}\/team is the same@ as @\/teams\/{id}@.
module MSGraphAPI.Users.Group (
  -- * Teams
  -- ** Joined teams
  listUserJoinedTeams
  , listMeJoinedTeams
  -- ** Associated teams
  , listUserAssociatedTeams
  , listMeAssociatedTeams
  -- * Team channels
  , listTeamChannels
  -- ** Channel messages
  , listChannelMessages
  , getChannelMessage
  , listMessageReplies
  -- * Drive items
  , listGroupsDriveItems
  -- * types
  , Group(..)
  , Channel(..)
  -- ** Chat messages
  , ChatMessage(..)
  , ChatMessageBody(..)
                              )where

import GHC.Generics (Generic(..))

-- aeson
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON)
-- hoauth
import Network.OAuth.OAuth2.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (Req)
-- text
import Data.Text (Text, unpack)
-- time
import Data.Time (ZonedTime)

import qualified MSGraphAPI.Internal.Common as MSG (Collection(..), get, aesonOptions)
import MSGraphAPI.Files.DriveItem (DriveItem)

-- | Groups are collections of principals with shared access to resources in Microsoft services or in your app. Different principals such as users, other groups, devices, and applications can be part of groups. 
--
-- https://learn.microsoft.com/en-us/graph/api/resources/groups-overview?view=graph-rest-1.0&tabs=http
data Group = Group {
  Group -> Text
gId :: Text
  , Group -> Text
gDisplayName :: Text
  , Group -> Text
gDescription :: Text
                   } deriving (Group -> Group -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Group -> Group -> Bool
$c/= :: Group -> Group -> Bool
== :: Group -> Group -> Bool
$c== :: Group -> Group -> Bool
Eq, Eq Group
Group -> Group -> Bool
Group -> Group -> Ordering
Group -> Group -> Group
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Group -> Group -> Group
$cmin :: Group -> Group -> Group
max :: Group -> Group -> Group
$cmax :: Group -> Group -> Group
>= :: Group -> Group -> Bool
$c>= :: Group -> Group -> Bool
> :: Group -> Group -> Bool
$c> :: Group -> Group -> Bool
<= :: Group -> Group -> Bool
$c<= :: Group -> Group -> Bool
< :: Group -> Group -> Bool
$c< :: Group -> Group -> Bool
compare :: Group -> Group -> Ordering
$ccompare :: Group -> Group -> Ordering
Ord, Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show, forall x. Rep Group x -> Group
forall x. Group -> Rep Group x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Group x -> Group
$cfrom :: forall x. Group -> Rep Group x
Generic)
instance A.FromJSON Group where
  parseJSON :: Value -> Parser Group
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"g")
instance A.ToJSON Group

-- | Teams are made up of channels, which are the conversations you have with your teammates. Each channel is dedicated to a specific topic, department, or project. Channels are where the work actually gets done - where text, audio, and video conversations open to the whole team happen, where files are shared, and where tabs are added.
--
-- https://learn.microsoft.com/en-us/graph/api/resources/channel?view=graph-rest-1.0
data Channel = Channel {
  Channel -> Text
chId :: Text
  , Channel -> Text
chDisplayName :: Text
  , Channel -> Text
chDescription :: Text
                       } deriving (Channel -> Channel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Eq, Eq Channel
Channel -> Channel -> Bool
Channel -> Channel -> Ordering
Channel -> Channel -> Channel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Channel -> Channel -> Channel
$cmin :: Channel -> Channel -> Channel
max :: Channel -> Channel -> Channel
$cmax :: Channel -> Channel -> Channel
>= :: Channel -> Channel -> Bool
$c>= :: Channel -> Channel -> Bool
> :: Channel -> Channel -> Bool
$c> :: Channel -> Channel -> Bool
<= :: Channel -> Channel -> Bool
$c<= :: Channel -> Channel -> Bool
< :: Channel -> Channel -> Bool
$c< :: Channel -> Channel -> Bool
compare :: Channel -> Channel -> Ordering
$ccompare :: Channel -> Channel -> Ordering
Ord, Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Show, forall x. Rep Channel x -> Channel
forall x. Channel -> Rep Channel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Channel x -> Channel
$cfrom :: forall x. Channel -> Rep Channel x
Generic)
instance A.FromJSON Channel where
  parseJSON :: Value -> Parser Channel
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"ch")
instance A.ToJSON Channel

-- | Get the list of channels either in this team or shared with this team (incoming channels).
--
-- @GET \/teams\/{team-id}\/allChannels@
listTeamChannels :: Text -- ^ team ID
                 -> AccessToken -> Req (MSG.Collection Channel)
listTeamChannels :: Text -> AccessToken -> Req (Collection Channel)
listTeamChannels Text
tid = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"teams", Text
tid, Text
"allChannels"] forall a. Monoid a => a
mempty



-- | Retrieve the list of messages (without the replies) in a channel of a team.
--
-- To get the replies for a message, call the 'listMessageReplies' or the get message reply API.
--
-- @GET \/teams\/{team-id}\/channels\/{channel-id}\/messages@
listChannelMessages ::
  Text -- ^ team ID
  -> Text -- ^ channel ID
  -> AccessToken -> Req (MSG.Collection ChatMessage)
listChannelMessages :: Text -> Text -> AccessToken -> Req (Collection ChatMessage)
listChannelMessages Text
tid Text
chid =
  forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"teams", Text
tid, Text
"channels", Text
chid, Text
"messages"] forall a. Monoid a => a
mempty

-- | Retrieve a single message or a message reply in a channel or a chat.
--
-- @GET \/teams\/{team-id}\/channels\/{channel-id}\/messages\/{message-id}@
getChannelMessage :: Text -- ^ team ID
                  -> Text -- ^ channel ID
                  -> Text -- ^ message ID
                  -> AccessToken -> Req ChatMessage
getChannelMessage :: Text -> Text -> Text -> AccessToken -> Req ChatMessage
getChannelMessage Text
tid Text
chid Text
mid =
  forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"teams", Text
tid, Text
"channels", Text
chid, Text
"messages", Text
mid] forall a. Monoid a => a
mempty

-- | List all the replies to a message in a channel of a team.
--
-- This method lists only the replies of the specified message, if any. To get the message itself, use 'getChannelMessage'.
--
-- GET /teams/{team-id}/channels/{channel-id}/messages/{message-id}/replies
listMessageReplies ::
  Text -- ^ team ID
  -> Text -- ^ channel ID
  -> Text -- ^ message ID
  -> AccessToken -> Req (MSG.Collection ChatMessage)
listMessageReplies :: Text -> Text -> Text -> AccessToken -> Req (Collection ChatMessage)
listMessageReplies Text
tid Text
chid Text
mid =
  forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"teams", Text
tid, Text
"channels", Text
chid, Text
"messages", Text
mid, Text
"replies"] forall a. Monoid a => a
mempty


-- | An individual chat message within a channel or chat. The message can be a root message or part of a thread
--
-- https://learn.microsoft.com/en-us/graph/api/resources/chatmessage?view=graph-rest-1.0
data ChatMessage = ChatMessage {
  ChatMessage -> ChatMessageBody
chamBody :: ChatMessageBody
  , ChatMessage -> Text
chamId :: Text
  , ChatMessage -> ZonedTime
chamCreatedDateTime :: ZonedTime
  , ChatMessage -> Maybe ZonedTime
chamDeletedDateTime :: Maybe ZonedTime
                               } deriving (Int -> ChatMessage -> ShowS
[ChatMessage] -> ShowS
ChatMessage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChatMessage] -> ShowS
$cshowList :: [ChatMessage] -> ShowS
show :: ChatMessage -> String
$cshow :: ChatMessage -> String
showsPrec :: Int -> ChatMessage -> ShowS
$cshowsPrec :: Int -> ChatMessage -> ShowS
Show, forall x. Rep ChatMessage x -> ChatMessage
forall x. ChatMessage -> Rep ChatMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatMessage x -> ChatMessage
$cfrom :: forall x. ChatMessage -> Rep ChatMessage x
Generic)
instance A.FromJSON ChatMessage where
  parseJSON :: Value -> Parser ChatMessage
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"cham")
instance A.ToJSON ChatMessage

data ChatMessageBody = ChatMessageBody {
  ChatMessageBody -> Text
chambId :: Text
                                       } deriving (ChatMessageBody -> ChatMessageBody -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChatMessageBody -> ChatMessageBody -> Bool
$c/= :: ChatMessageBody -> ChatMessageBody -> Bool
== :: ChatMessageBody -> ChatMessageBody -> Bool
$c== :: ChatMessageBody -> ChatMessageBody -> Bool
Eq, Eq ChatMessageBody
ChatMessageBody -> ChatMessageBody -> Bool
ChatMessageBody -> ChatMessageBody -> Ordering
ChatMessageBody -> ChatMessageBody -> ChatMessageBody
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChatMessageBody -> ChatMessageBody -> ChatMessageBody
$cmin :: ChatMessageBody -> ChatMessageBody -> ChatMessageBody
max :: ChatMessageBody -> ChatMessageBody -> ChatMessageBody
$cmax :: ChatMessageBody -> ChatMessageBody -> ChatMessageBody
>= :: ChatMessageBody -> ChatMessageBody -> Bool
$c>= :: ChatMessageBody -> ChatMessageBody -> Bool
> :: ChatMessageBody -> ChatMessageBody -> Bool
$c> :: ChatMessageBody -> ChatMessageBody -> Bool
<= :: ChatMessageBody -> ChatMessageBody -> Bool
$c<= :: ChatMessageBody -> ChatMessageBody -> Bool
< :: ChatMessageBody -> ChatMessageBody -> Bool
$c< :: ChatMessageBody -> ChatMessageBody -> Bool
compare :: ChatMessageBody -> ChatMessageBody -> Ordering
$ccompare :: ChatMessageBody -> ChatMessageBody -> Ordering
Ord, forall x. Rep ChatMessageBody x -> ChatMessageBody
forall x. ChatMessageBody -> Rep ChatMessageBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChatMessageBody x -> ChatMessageBody
$cfrom :: forall x. ChatMessageBody -> Rep ChatMessageBody x
Generic)
instance Show ChatMessageBody where
  show :: ChatMessageBody -> String
show = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChatMessageBody -> Text
chambId
instance A.FromJSON ChatMessageBody where
  parseJSON :: Value -> Parser ChatMessageBody
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"chamb")
instance A.ToJSON ChatMessageBody



-- | Get the list of teams in Microsoft Teams that a user is associated with.
--
-- @GET \/users\/{user-id}\/teamwork\/associatedTeams@
--
-- Currently, a user can be associated with a team in two different ways:
--
--  * A user can be a direct member of a team.
--  * A user can be a member of a shared channel that is hosted inside a team.
listUserAssociatedTeams :: Text -- ^ User ID
                       -> AccessToken -> Req (MSG.Collection Group)
listUserAssociatedTeams :: Text -> AccessToken -> Req (Collection Group)
listUserAssociatedTeams Text
uid = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"users", Text
uid, Text
"teamwork", Text
"associatedTeams"] forall a. Monoid a => a
mempty

-- | Get the teams in Microsoft Teams that the current user is associated with (see 'getUserAssociatedTeams').
listMeAssociatedTeams :: AccessToken -> Req (MSG.Collection Group)
listMeAssociatedTeams :: AccessToken -> Req (Collection Group)
listMeAssociatedTeams = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"me", Text
"teamwork", Text
"associatedTeams"] forall a. Monoid a => a
mempty

-- | Get the teams in Microsoft Teams that the given user is a direct member of.
--
-- @GET \/users\/{id | user-principal-name}\/joinedTeams@
--
-- https://learn.microsoft.com/en-us/graph/api/user-list-joinedteams?view=graph-rest-1.0&tabs=http
listUserJoinedTeams :: Text -- ^ User ID
                   -> AccessToken -> Req (MSG.Collection Group)
listUserJoinedTeams :: Text -> AccessToken -> Req (Collection Group)
listUserJoinedTeams Text
uid = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"users", Text
uid, Text
"joinedTeams"] forall a. Monoid a => a
mempty

-- | Get the teams in Microsoft Teams that the current user is a direct member of.
--
-- @GET \/me\/joinedTeams@
--
-- https://learn.microsoft.com/en-us/graph/api/user-list-joinedteams?view=graph-rest-1.0&tabs=http
listMeJoinedTeams :: AccessToken -> Req (MSG.Collection Group)
listMeJoinedTeams :: AccessToken -> Req (Collection Group)
listMeJoinedTeams = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"me", Text
"joinedTeams"] forall a. Monoid a => a
mempty

-- | Get the 'DriveItem's in the 'Group' storage, starting from the root item
--
-- @GET \/groups\/{group-id}\/drive\/root\/children@
--
-- https://learn.microsoft.com/en-us/graph/api/driveitem-list-children?view=graph-rest-1.0&tabs=http
--
-- NB : requires @Files.Read.All@, since it tries to access all files a user has access to.
listGroupsDriveItems :: Text -- ^ Group ID
                    -> AccessToken -> Req (MSG.Collection DriveItem)
listGroupsDriveItems :: Text -> AccessToken -> Req (Collection DriveItem)
listGroupsDriveItems Text
gid = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"groups", Text
gid, Text
"drive", Text
"root", Text
"children"] forall a. Monoid a => a
mempty


-- data X = X { xName :: Text } deriving (Eq, Ord, Show, Generic)
-- instance A.FromJSON X where
--   parseJSON = A.genericParseJSON (MSG.aesonOptions "x")

-- pt0 :: Either String (MSG.Collection DriveItem)
-- pt0 = A.eitherDecode t0
--   where
--     t0 = "{\r\n  \"value\": [\r\n    {\"name\": \"myfile.jpg\"  },\r\n    {\"name\": \"Documents\" },\r\n    {\"name\": \"Photos\" },\r\n    {\"name\": \"my sheet(1).xlsx\"}\r\n  ]\r\n}"