{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.Connect.Scopes
    ( ProductScope(..)
    ) where

import           Control.Monad (mzero)
import           Data.Aeson
import           GHC.Generics

-- | Scopes are an Atlassian Connect concept that declare how much access your addon requires to any give Cloud instance.
-- These scopes can be thought of as permissions are are well documented:
-- <https://developer.atlassian.com/static/connect/docs/scopes/scopes.html>
--
-- It is important to note that these scopes only give you restricted access to certain REST resources. You can not query
-- any REST url as you would with an Atlassian Server plugin. The restricted set of REST resources per application can be
-- found in the Atlassian Connect documentation.
data ProductScope
  = Read -- ^ The read scope means that you can pull data from the Cloud application.
  | Write -- ^ The write scope gives you the same access as a regular user of the Atlassian connect application.
  | Delete -- ^ The delete scope is required if you want to perform potentially destructive operations on data.
  | ProjectAdmin -- ^ A JIRA specific scope. Lets your add-on administer a project in JIRA.
  | SpaceAdmin -- ^ A Confluence specific scope. Lets your add-on administer a space in Confluence.
  | Admin -- ^ Gives your Atlassian Connect add-on administrative rights to the Cloud instance. (But NOT system
          -- administrator permission. Happily you cannot request that level of access.)
  | ActAsUser -- ^ Add-ons with this scope can access resources and perform actions in JIRA and Confluence on behalf of users.
  deriving (Int -> ProductScope -> ShowS
[ProductScope] -> ShowS
ProductScope -> String
(Int -> ProductScope -> ShowS)
-> (ProductScope -> String)
-> ([ProductScope] -> ShowS)
-> Show ProductScope
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProductScope] -> ShowS
$cshowList :: [ProductScope] -> ShowS
show :: ProductScope -> String
$cshow :: ProductScope -> String
showsPrec :: Int -> ProductScope -> ShowS
$cshowsPrec :: Int -> ProductScope -> ShowS
Show, ProductScope -> ProductScope -> Bool
(ProductScope -> ProductScope -> Bool)
-> (ProductScope -> ProductScope -> Bool) -> Eq ProductScope
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProductScope -> ProductScope -> Bool
$c/= :: ProductScope -> ProductScope -> Bool
== :: ProductScope -> ProductScope -> Bool
$c== :: ProductScope -> ProductScope -> Bool
Eq, (forall x. ProductScope -> Rep ProductScope x)
-> (forall x. Rep ProductScope x -> ProductScope)
-> Generic ProductScope
forall x. Rep ProductScope x -> ProductScope
forall x. ProductScope -> Rep ProductScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProductScope x -> ProductScope
$cfrom :: forall x. ProductScope -> Rep ProductScope x
Generic)

instance ToJSON ProductScope where
   toJSON :: ProductScope -> Value
toJSON ProductScope
Read         = Value
"read"
   toJSON ProductScope
Write        = Value
"write"
   toJSON ProductScope
Delete       = Value
"delete"
   toJSON ProductScope
ProjectAdmin = Value
"project_admin"
   toJSON ProductScope
SpaceAdmin   = Value
"space_admin"
   toJSON ProductScope
Admin        = Value
"admin"
   toJSON ProductScope
ActAsUser    = Value
"act_as_user"

instance FromJSON ProductScope where
  parseJSON :: Value -> Parser ProductScope
parseJSON (String Text
"read")             = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
Read
  parseJSON (String Text
"write")            = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
Write
  parseJSON (String Text
"delete")           = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
Delete
  parseJSON (String Text
"project_admin")    = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
ProjectAdmin
  parseJSON (String Text
"space_admin")      = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
SpaceAdmin
  parseJSON (String Text
"admin")            = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
Admin
  parseJSON (String Text
"act_as_user")      = ProductScope -> Parser ProductScope
forall (m :: * -> *) a. Monad m => a -> m a
return ProductScope
ActAsUser
  parseJSON Value
_                           = Parser ProductScope
forall (m :: * -> *) a. MonadPlus m => m a
mzero