module MSGraphAPI.ChangeNotifications.Subscription where

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

-- aeson
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), 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 (LocalTime)

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

-- | Creating a subscription requires read scope to the resource. For example, to get change notifications on messages, your app needs the Mail.Read permission.
createSubscription :: (A.FromJSON b) => Subscription -> 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 -> Text
cnsId :: Text
  , Subscription -> NonEmpty ChangeType
cnsChangeType :: NonEmpty ChangeType
  , Subscription -> Text
cnsClientState :: Text
  , Subscription -> LocalTime
cnsExpirationDateTime :: LocalTime
  , Subscription -> Text
cnsNotificationUrl :: Text -- ^ The 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 -- ^ Specifies the resource that will be monitored for changes. Do not include the base URL (https://graph.microsoft.com/v1.0/)
  , Subscription -> LatestTLSVer
cnsLatestSupportedTLSVersion :: LatestTLSVer
                   } 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"

data ChangeType = CTCreated
                | CTUpdated
                | CTDeleted
                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"