-- | Subscription to change notifications through webhooks
--
-- NB: Creating a subscription requires read scope to the resource. For example, to get change notifications on messages, your app needs the @Mail.Read@ permission.
--
-- Currently, subscriptions are enabled for the following resources. Note: Subscriptions to resources marked with an asterisk (*) are supported on the @\/beta@ endpoint only.
--
--
    -- * An alert from the Microsoft Graph Security API.
--
    -- * A baseTask (deprecated) of a user in Microsoft To-Do.*
--
    -- * A callRecord produced after a call or meeting in Microsoft Teams.
--
    -- * A channel in Microsoft Teams.
--
    -- * A chat in Microsoft Teams.
--
    -- * A chatMessage sent via teams or channels in Microsoft Teams.
--
    -- * A conversation in a Microsoft 365 group.
--
    -- * A conversationMember in a team, channel, or chat in Microsoft Teams.
--
    -- * Content in the hierarchy of a root folder 'DriveItem' in OneDrive for Business, or of a root folder or subfolder 'DriveItem' in a user's personal OneDrive.
--
    -- * A 'Group' in Azure Active Directory.
--
    -- * A list under a SharePoint site.
--
    -- * A message, event, or contact in Outlook.
--
    -- * An online meeting in Microsoft Teams.*
--
    -- * The presence of a user in Microsoft Teams.
--
    -- * A team in Microsoft Teams.
--
    -- * A printer (when a print job for the printer gets to JobFetchable state - ready to be fetched for printing) and a printTaskDefinition in Universal Print. For more information, see Subscribe to change notifications from cloud printing APIs.
--
    -- * A todoTask of a user in Microsoft To Do (webhooks are only available in the worldwide endpoint and no other national clouds).
--
    -- * A 'User' in Azure Active Directory.
--
--
-- See <https://learn.microsoft.com/en-us/graph/webhooks#supported-resources> for an up to date list of resources that can produce change notifications
--
-- see <https://learn.microsoft.com/en-us/graph/change-notifications-delivery-webhooks?tabs=http> for protocol details
module MSGraphAPI.ChangeNotifications.Subscription (
  -- * Sender
  createSubscription
  -- ** types
  , Subscription(..)
    , ChangeType(..)
  -- * Receiver
  -- ** types
  , ChangeNotification(..)
                                                   ) where

import Data.List.NonEmpty (NonEmpty(..))
import GHC.Generics (Generic(..))

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

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

-- | Represents the notification sent to the subscriber. https://learn.microsoft.com/en-us/graph/api/resources/changenotification?view=graph-rest-1.0
--
--
data ChangeNotification a = ChangeNotification {
  forall a. ChangeNotification a -> ChangeType
cnChangeType :: ChangeType -- ^ type of change that will raise the change notification.
  , forall a. ChangeNotification a -> Text
cnClientState :: Text -- ^ Value of the clientState property sent in the subscription request (if any). The maximum length is 255 characters. The client can check whether the change notification came from the service by comparing the values of the clientState property.
  , forall a. ChangeNotification a -> Text
cnId :: Text -- ^ Unique ID for the notification.
  , forall a. ChangeNotification a -> Text
cnResource :: Text -- ^ The URI of the resource that emitted the change notification relative to @https:\/\/graph.microsoft.com@
  , forall a. ChangeNotification a -> Maybe a
cnResourceData :: Maybe a
  , forall a. ChangeNotification a -> Text
cnSubscriptionId :: Text
  , forall a. ChangeNotification a -> Text
cnTenantId :: Text
                                             } deriving (ChangeNotification a -> ChangeNotification a -> Bool
forall a.
Eq a =>
ChangeNotification a -> ChangeNotification a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeNotification a -> ChangeNotification a -> Bool
$c/= :: forall a.
Eq a =>
ChangeNotification a -> ChangeNotification a -> Bool
== :: ChangeNotification a -> ChangeNotification a -> Bool
$c== :: forall a.
Eq a =>
ChangeNotification a -> ChangeNotification a -> Bool
Eq, Int -> ChangeNotification a -> ShowS
forall a. Show a => Int -> ChangeNotification a -> ShowS
forall a. Show a => [ChangeNotification a] -> ShowS
forall a. Show a => ChangeNotification a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeNotification a] -> ShowS
$cshowList :: forall a. Show a => [ChangeNotification a] -> ShowS
show :: ChangeNotification a -> String
$cshow :: forall a. Show a => ChangeNotification a -> String
showsPrec :: Int -> ChangeNotification a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ChangeNotification a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ChangeNotification a) x -> ChangeNotification a
forall a x. ChangeNotification a -> Rep (ChangeNotification a) x
$cto :: forall a x. Rep (ChangeNotification a) x -> ChangeNotification a
$cfrom :: forall a x. ChangeNotification a -> Rep (ChangeNotification a) x
Generic)
instance A.FromJSON a => A.FromJSON (ChangeNotification a) where
  parseJSON :: Value -> Parser (ChangeNotification a)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"cn")

-- | Create a subscription https://learn.microsoft.com/en-us/graph/api/subscription-post-subscriptions?view=graph-rest-1.0&tabs=http
--
-- @ POST https:\/\/graph.microsoft.com\/v1.0\/subscriptions@
--
-- NB: Creating a subscription requires read scope to the resource. For example, to get change notifications on messages, your app needs the @Mail.Read@ permission.
--
-- NB2: When you create a subscription to receive change notifications through webhooks, MS Graph first validates the notification endpoint that's provided in the @notificationUrl@ property of the subscription request. MS Graph encodes a validation token and includes it in a @POST@ request to the notification URL, the client must properly decode the URL to get the plain text validation token, and respond within 10 seconds.  See   https://learn.microsoft.com/en-us/graph/change-notifications-delivery-webhooks?tabs=http#notificationurl-validation for full details
createSubscription :: (A.FromJSON b) =>
                      Subscription -- ^ Configuration of the change webhook to be created by this request
                   -> AccessToken -> Req b
createSubscription :: forall b. FromJSON b => Subscription -> AccessToken -> Req b
createSubscription = forall a b.
(ToJSON a, FromJSON b) =>
[Text] -> Option 'Https -> a -> AccessToken -> Req b
MSG.post [Text
"subscriptions"] forall a. Monoid a => a
mempty

-- | A subscription allows a client app to receive change notifications about changes to data in Microsoft Graph.
--
-- https://learn.microsoft.com/en-us/graph/api/resources/subscription?view=graph-rest-1.0
data Subscription = Subscription {
  Subscription -> NonEmpty ChangeType
cnsChangeType :: NonEmpty ChangeType -- ^ Type of change in the subscribed resource that will raise a change notification. 
  , Subscription -> Text
cnsClientState :: Text -- ^ Value of the clientState property sent by the service in each change notification. The maximum length is 128 characters. The client can check that the change notification came from the service by comparing the value of the clientState property sent with the subscription with the value of the clientState property received with each change notification.
  , Subscription -> UTCTime
cnsExpirationDateTime :: UTCTime -- ^ date and time when the webhook subscription expires. The time is in UTC, and can be an amount of time from subscription creation that varies for the resource subscribed to. For the maximum supported subscription length of time, see https://learn.microsoft.com/en-us/graph/api/resources/subscription?view=graph-rest-1.0#maximum-length-of-subscription-per-resource-type
  , Subscription -> Text
cnsNotificationUrl :: Text -- ^ URL of the endpoint that will receive the change notifications. This URL must make use of the HTTPS protocol. Any query string parameter included in the notificationUrl property will be included in the HTTP POST request when Microsoft Graph sends the change notifications.
  , Subscription -> Text
cnsResource :: Text -- ^ The resource that will be monitored for changes, e.g. @"\/users\/{id}\/drive\/root"@. Do not include the base URL (@https:\/\/graph.microsoft.com\/v1.0\/@)
                   } deriving (Subscription -> Subscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subscription -> Subscription -> Bool
$c/= :: Subscription -> Subscription -> Bool
== :: Subscription -> Subscription -> Bool
$c== :: Subscription -> Subscription -> Bool
Eq, Int -> Subscription -> ShowS
[Subscription] -> ShowS
Subscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subscription] -> ShowS
$cshowList :: [Subscription] -> ShowS
show :: Subscription -> String
$cshow :: Subscription -> String
showsPrec :: Int -> Subscription -> ShowS
$cshowsPrec :: Int -> Subscription -> ShowS
Show, forall x. Rep Subscription x -> Subscription
forall x. Subscription -> Rep Subscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Subscription x -> Subscription
$cfrom :: forall x. Subscription -> Rep Subscription x
Generic)
instance A.FromJSON Subscription where
  parseJSON :: Value -> Parser Subscription
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"cns")
instance A.ToJSON Subscription where
  toEncoding :: Subscription -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
A.genericToEncoding (String -> Options
MSG.aesonOptions String
"cns")

data LatestTLSVer = LTV10 | LTV11 | LTV12 | LTV13 deriving (LatestTLSVer -> LatestTLSVer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LatestTLSVer -> LatestTLSVer -> Bool
$c/= :: LatestTLSVer -> LatestTLSVer -> Bool
== :: LatestTLSVer -> LatestTLSVer -> Bool
$c== :: LatestTLSVer -> LatestTLSVer -> Bool
Eq, Int -> LatestTLSVer -> ShowS
[LatestTLSVer] -> ShowS
LatestTLSVer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LatestTLSVer] -> ShowS
$cshowList :: [LatestTLSVer] -> ShowS
show :: LatestTLSVer -> String
$cshow :: LatestTLSVer -> String
showsPrec :: Int -> LatestTLSVer -> ShowS
$cshowsPrec :: Int -> LatestTLSVer -> ShowS
Show, forall x. Rep LatestTLSVer x -> LatestTLSVer
forall x. LatestTLSVer -> Rep LatestTLSVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LatestTLSVer x -> LatestTLSVer
$cfrom :: forall x. LatestTLSVer -> Rep LatestTLSVer x
Generic)
instance A.FromJSON LatestTLSVer where
  parseJSON :: Value -> Parser LatestTLSVer
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"LatestTLSVer" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text
t of
      Text
"v1_0" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LatestTLSVer
LTV10
      Text
"v1_1" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LatestTLSVer
LTV11
      Text
"v1_2" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LatestTLSVer
LTV12
      Text
"v1_3" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure LatestTLSVer
LTV13
      Text
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"LatestTLSVer : unexpected value:", Text -> String
unpack Text
x]
instance A.ToJSON LatestTLSVer where
  toEncoding :: LatestTLSVer -> Encoding
toEncoding = \case
    LatestTLSVer
LTV10 -> forall a. Text -> Encoding' a
A.text Text
"v1_0"
    LatestTLSVer
LTV11 -> forall a. Text -> Encoding' a
A.text Text
"v1_1"
    LatestTLSVer
LTV12 -> forall a. Text -> Encoding' a
A.text Text
"v1_2"
    LatestTLSVer
LTV13 -> forall a. Text -> Encoding' a
A.text Text
"v1_3"

-- | the type of change in the subscribed resource that will raise a change notification.
--
-- Note:
--
-- * Drive root item and list change notifications support only the updated changeType.
--
-- * User and group change notifications support updated and deleted changeType. Use updated to receive notifications when user or group is created, updated or soft deleted. Use deleted to receive notifications when user or group is permanently deleted.
data ChangeType = CTCreated -- ^ created
                | CTUpdated -- ^ updated
                | CTDeleted -- ^ deleted
                deriving (ChangeType -> ChangeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChangeType -> ChangeType -> Bool
$c/= :: ChangeType -> ChangeType -> Bool
== :: ChangeType -> ChangeType -> Bool
$c== :: ChangeType -> ChangeType -> Bool
Eq, Int -> ChangeType -> ShowS
[ChangeType] -> ShowS
ChangeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChangeType] -> ShowS
$cshowList :: [ChangeType] -> ShowS
show :: ChangeType -> String
$cshow :: ChangeType -> String
showsPrec :: Int -> ChangeType -> ShowS
$cshowsPrec :: Int -> ChangeType -> ShowS
Show, forall x. Rep ChangeType x -> ChangeType
forall x. ChangeType -> Rep ChangeType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangeType x -> ChangeType
$cfrom :: forall x. ChangeType -> Rep ChangeType x
Generic)
instance A.FromJSON ChangeType where
  parseJSON :: Value -> Parser ChangeType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"ChangeType" forall a b. (a -> b) -> a -> b
$ \Text
t ->
    case Text
t of
      Text
"created" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ChangeType
CTCreated
      Text
"updated" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ChangeType
CTUpdated
      Text
"deleted" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ChangeType
CTDeleted
      Text
x -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"ChangeType : unexpected value:", Text -> String
unpack Text
x]
instance A.ToJSON ChangeType where
  toEncoding :: ChangeType -> Encoding
toEncoding = \case
    ChangeType
CTCreated -> forall a. Text -> Encoding' a
A.text Text
"created"
    ChangeType
CTUpdated -> forall a. Text -> Encoding' a
A.text Text
"updated"
    ChangeType
CTDeleted -> forall a. Text -> Encoding' a
A.text Text
"deleted"