{-|

Copyright:

  This file is part of the package openid-connect.  It is subject to
  the license terms in the LICENSE file found in the top-level
  directory of this distribution and at:

    https://code.devalot.com/open/openid-connect

  No part of this package, including this file, may be copied,
  modified, propagated, or distributed except according to the terms
  contained in the LICENSE file.

License: BSD-2-Clause

Scope values, defined in OAuth 2.0, as used in OpenID Connect 1.0.

-}
module OpenID.Connect.Scope
  ( Scope
  , openid
  , email
  , profile
  , auth
  , hasScope
  , scopeFromWords
  , scopeQueryItem

    -- * Re-exports
  , Words(..)
  , toWords
  , fromWords
  ) where

--------------------------------------------------------------------------------
-- Imports:
import Data.ByteString (ByteString)
import Data.Function ((&))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.String
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import GHC.Generics (Generic)
import Network.HTTP.Types (QueryItem)
import OpenID.Connect.JSON

--------------------------------------------------------------------------------
-- | A list of @scope@ values.
--
-- To create a scope value use the 'IsString' instance or one of the
-- helper functions such as 'openid' or 'email'.
--
-- @since 0.1.0.0
newtype Scope = Scope
  { Scope -> Words
unScope :: Words
  }
  deriving stock (forall x. Rep Scope x -> Scope
forall x. Scope -> Rep Scope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Scope x -> Scope
$cfrom :: forall x. Scope -> Rep Scope x
Generic, Int -> Scope -> ShowS
[Scope] -> ShowS
Scope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scope] -> ShowS
$cshowList :: [Scope] -> ShowS
show :: Scope -> String
$cshow :: Scope -> String
showsPrec :: Int -> Scope -> ShowS
$cshowsPrec :: Int -> Scope -> ShowS
Show)
  deriving newtype NonEmpty Scope -> Scope
Scope -> Scope -> Scope
forall b. Integral b => b -> Scope -> Scope
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Scope -> Scope
$cstimes :: forall b. Integral b => b -> Scope -> Scope
sconcat :: NonEmpty Scope -> Scope
$csconcat :: NonEmpty Scope -> Scope
<> :: Scope -> Scope -> Scope
$c<> :: Scope -> Scope -> Scope
Semigroup
  deriving ([Scope] -> Encoding
[Scope] -> Value
Scope -> Encoding
Scope -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Scope] -> Encoding
$ctoEncodingList :: [Scope] -> Encoding
toJSONList :: [Scope] -> Value
$ctoJSONList :: [Scope] -> Value
toEncoding :: Scope -> Encoding
$ctoEncoding :: Scope -> Encoding
toJSON :: Scope -> Value
$ctoJSON :: Scope -> Value
ToJSON, Value -> Parser [Scope]
Value -> Parser Scope
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Scope]
$cparseJSONList :: Value -> Parser [Scope]
parseJSON :: Value -> Parser Scope
$cparseJSON :: Value -> Parser Scope
FromJSON) via (NonEmpty Text)

--------------------------------------------------------------------------------
instance IsString Scope where
  fromString :: String -> Scope
fromString String
s =
    let t :: Text
t = String -> Text
Text.pack String
s
    in case forall (m :: * -> *). MonadPlus m => Text -> m Words
toWords Text
t of
         Maybe Words
Nothing -> Words -> Scope
Scope (NonEmpty Text -> Words
Words (Text
t forall a. a -> [a] -> NonEmpty a
:| []))
         Just Words
w  -> Words -> Scope
Scope Words
w


--------------------------------------------------------------------------------
-- | The @openid@ scope.
--
-- Redundant since the @openid@ scope is always added to requests.
--
-- @since 0.1.0.0
openid :: Scope
openid :: Scope
openid = Scope
"openid"

--------------------------------------------------------------------------------
-- | The @email@ scope.
--
-- @since 0.1.0.0
email :: Scope
email :: Scope
email = Scope
"email"

--------------------------------------------------------------------------------
-- | The @profile@ scope.
--
-- @since 0.1.0.0
profile :: Scope
profile :: Scope
profile = Scope
"profile"

--------------------------------------------------------------------------------
-- | Authentication request scope.
--
-- Equivalent to @openid <> email@.
--
-- @since 0.1.0.0
auth :: Scope
auth :: Scope
auth = Scope
openid forall a. Semigroup a => a -> a -> a
<> Scope
email

--------------------------------------------------------------------------------
-- | Test to see if the given scope includes a specific scope value.
--
-- @since 0.1.0.0
hasScope :: Scope -> Text -> Bool
hasScope :: Scope -> Text -> Bool
hasScope Scope
s Text
t= (Text
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NonEmpty.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Words -> NonEmpty Text
toWordList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> Words
unScope forall a b. (a -> b) -> a -> b
$ Scope
s

--------------------------------------------------------------------------------
-- | Convert a (non-empty) list of words into a 'Scope'.
--
-- @since 0.1.0.0
scopeFromWords :: Words -> Scope
scopeFromWords :: Words -> Scope
scopeFromWords = Words -> Scope
Scope

--------------------------------------------------------------------------------
-- | Encode a 'Scope' into a query string item.
--
-- @since 0.1.0.0
scopeQueryItem :: Scope -> QueryItem
scopeQueryItem :: Scope -> QueryItem
scopeQueryItem Scope
scope = (ByteString
"scope", forall a. a -> Maybe a
Just ByteString
scopes)
  where
    scopes :: ByteString
    scopes :: ByteString
scopes = (Scope
scope forall a. Semigroup a => a -> a -> a
<> Scope
openid)
           forall a b. a -> (a -> b) -> b
& Scope -> Words
unScope
           forall a b. a -> (a -> b) -> b
& Words -> Text
fromWords
           forall a b. a -> (a -> b) -> b
& Text -> ByteString
Text.encodeUtf8