{-# LANGUAGE DeriveGeneric #-}
module Data.Connect.Lifecycle
    ( Lifecycle(..)
    , emptyLifecycle
    , defaultLifecycle
    ) where

import           Data.Aeson
import           Data.Connect.AesonHelpers
import           Data.Connect.OrphanInstances ()
import           GHC.Generics
import qualified Network.URI                  as NU

-- | Every Atlassian Connect add-on can be installed, uninstalled, enabled and disabled. These are known as 'Lifecycle'
-- events. These events will fire on each and every Cloud instance that your add-on is installed on. You can request in
-- your Atlassian Connect add-on descriptor to be alerted of lifecycle events. When the event fires, if you have
-- requested it, you will be given the details of the event in a JSON blob by the host application.
--
-- The lifecycle events are documented fully in the Atlassian Connect documentation:
-- <https://developer.atlassian.com/static/connect/docs/modules/lifecycle.html>
--
-- It is important to note that the installed event is particularily important to any Atlassian Connect add-on that
-- needs to use 'Jwt' auth tokens because the installed handler will come with the shared secret for your add-on on
-- that particular instance.
data Lifecycle = Lifecycle
   { Lifecycle -> Maybe URI
installed   :: Maybe NU.URI -- ^ Potential relative URI to call every time an add-on is installed on an instance.
   , Lifecycle -> Maybe URI
uninstalled :: Maybe NU.URI -- ^ Potential relative URI to call every time an add-on is uninstalled on an instance.
   , Lifecycle -> Maybe URI
enabled     :: Maybe NU.URI -- ^ Potential relative URI to call every time an add-on is enabled on an instance.
   , Lifecycle -> Maybe URI
disabled    :: Maybe NU.URI -- ^ Potential relative URI to call every time an add-on is disabled on an instance.
   } deriving (Int -> Lifecycle -> ShowS
[Lifecycle] -> ShowS
Lifecycle -> String
(Int -> Lifecycle -> ShowS)
-> (Lifecycle -> String)
-> ([Lifecycle] -> ShowS)
-> Show Lifecycle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lifecycle] -> ShowS
$cshowList :: [Lifecycle] -> ShowS
show :: Lifecycle -> String
$cshow :: Lifecycle -> String
showsPrec :: Int -> Lifecycle -> ShowS
$cshowsPrec :: Int -> Lifecycle -> ShowS
Show, (forall x. Lifecycle -> Rep Lifecycle x)
-> (forall x. Rep Lifecycle x -> Lifecycle) -> Generic Lifecycle
forall x. Rep Lifecycle x -> Lifecycle
forall x. Lifecycle -> Rep Lifecycle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Lifecycle x -> Lifecycle
$cfrom :: forall x. Lifecycle -> Rep Lifecycle x
Generic) -- TODO

instance ToJSON Lifecycle where
   toJSON :: Lifecycle -> Value
toJSON = Options -> Lifecycle -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
baseOptions

-- | The empty 'Lifecycle' allowing you to specify exactly which events you wish to handle with Haskell record syntax.
emptyLifecycle :: Lifecycle
emptyLifecycle :: Lifecycle
emptyLifecycle = Maybe URI -> Maybe URI -> Maybe URI -> Maybe URI -> Lifecycle
Lifecycle Maybe URI
forall a. Maybe a
Nothing Maybe URI
forall a. Maybe a
Nothing Maybe URI
forall a. Maybe a
Nothing Maybe URI
forall a. Maybe a
Nothing

-- | The default 'Lifecycle' where installed goes to /installed and so on and so forth for every lifecycle event. You
-- can choose to disclude certain events by 'Nothing' them out.
defaultLifecycle :: Lifecycle
defaultLifecycle :: Lifecycle
defaultLifecycle = Lifecycle :: Maybe URI -> Maybe URI -> Maybe URI -> Maybe URI -> Lifecycle
Lifecycle
   { installed :: Maybe URI
installed = String -> Maybe URI
NU.parseRelativeReference String
"/installed"
   , uninstalled :: Maybe URI
uninstalled = String -> Maybe URI
NU.parseRelativeReference String
"/uninstalled"
   , enabled :: Maybe URI
enabled = String -> Maybe URI
NU.parseRelativeReference String
"/enabled"
   , disabled :: Maybe URI
disabled = String -> Maybe URI
NU.parseRelativeReference String
"/disabled"
   }