{-|

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. Scope -> Rep Scope x)
-> (forall x. Rep Scope x -> Scope) -> Generic Scope
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
(Int -> Scope -> ShowS)
-> (Scope -> String) -> ([Scope] -> ShowS) -> Show Scope
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 b -> Scope -> Scope
NonEmpty Scope -> Scope
Scope -> Scope -> Scope
(Scope -> Scope -> Scope)
-> (NonEmpty Scope -> Scope)
-> (forall b. Integral b => b -> Scope -> Scope)
-> Semigroup 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 :: 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
(Scope -> Value)
-> (Scope -> Encoding)
-> ([Scope] -> Value)
-> ([Scope] -> Encoding)
-> ToJSON Scope
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
(Value -> Parser Scope)
-> (Value -> Parser [Scope]) -> FromJSON 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 Text -> Maybe Words
forall (m :: * -> *). MonadPlus m => Text -> m Words
toWords Text
t of
         Maybe Words
Nothing -> Words -> Scope
Scope (NonEmpty Text -> Words
Words (Text
t Text -> [Text] -> NonEmpty Text
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 Scope -> Scope -> Scope
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 Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) ([Text] -> Bool) -> (Scope -> [Text]) -> Scope -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Text -> [Text])
-> (Scope -> NonEmpty Text) -> Scope -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Words -> NonEmpty Text
toWordList (Words -> NonEmpty Text)
-> (Scope -> Words) -> Scope -> NonEmpty Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope -> Words
unScope (Scope -> Bool) -> Scope -> Bool
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", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
scopes)
  where
    scopes :: ByteString
    scopes :: ByteString
scopes = (Scope
scope Scope -> Scope -> Scope
forall a. Semigroup a => a -> a -> a
<> Scope
openid)
           Scope -> (Scope -> Words) -> Words
forall a b. a -> (a -> b) -> b
& Scope -> Words
unScope
           Words -> (Words -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Words -> Text
fromWords
           Text -> (Text -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
& Text -> ByteString
Text.encodeUtf8