-- | User
module MSGraphAPI.Users.Group where

import GHC.Generics (Generic(..))

-- aeson
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), eitherDecode, genericParseJSON, defaultOptions, Options(..), withObject, withText, (.:), (.:?), object, (.=))
-- hoauth
import Network.OAuth.OAuth2.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (Req)
-- text
import Data.Text (Text, pack, unpack)

import qualified MSGraphAPI.Internal.Common as MSG (Collection(..), get, post, 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. 
--
-- httpstea://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")

-- | Get the teams in Microsoft Teams that the 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
getUserJoinedTeams :: Text -- ^ User ID
                   -> AccessToken -> Req (MSG.Collection Group)
getUserJoinedTeams :: Text -> AccessToken -> Req (Collection Group)
getUserJoinedTeams 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 '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
getGroupsDriveItems :: Text -- ^ Group ID
                    -> AccessToken -> Req (MSG.Collection DriveItem)
getGroupsDriveItems :: Text -> AccessToken -> Req (Collection DriveItem)
getGroupsDriveItems 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}"