@@ -1,20 +1,10 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveGeneric #-}
5−{-# LANGUAGE FlexibleContexts #-}
6−{-# LANGUAGE FlexibleInstances #-}
7−{-# LANGUAGE FunctionalDependencies #-}
8−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9−{-# LANGUAGE KindSignatures #-}
10−{-# LANGUAGE LambdaCase #-}
11−{-# LANGUAGE OverloadedStrings #-}
12−{-# LANGUAGE PolyKinds #-}
13−{-# LANGUAGE RecordWildCards #-}
14−{-# LANGUAGE ScopedTypeVariables #-}
15−{-# LANGUAGE TypeFamilies #-}
16−{-# LANGUAGE TypeOperators #-}
17−{-# LANGUAGE UndecidableInstances #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE ExplicitNamespaces #-}
3+{-# LANGUAGE PolyKinds #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
5+{-# LANGUAGE TypeFamilies #-}
6+{-# LANGUAGE TypeOperators #-}
7+{-# LANGUAGE UndecidableInstances #-}
188
199-- |
2010-- Module : Network.Google.Auth.Scope
@@ -28,46 +18,15 @@
2818-- from the underlying OS.
2919module Network.Google.Auth.Scope where
3020
31−import Control.Applicative
32−import Control.Concurrent
33−import Control.Exception.Lens
34−import Control.Lens hiding (coerce, (.=))
35−import Control.Monad
36−import Control.Monad.Catch
37−import Control.Monad.IO.Class
38−import Crypto.Hash.Algorithms (SHA256 (..))
39−import Crypto.PubKey.RSA.PKCS15 (signSafer)
40−import Crypto.PubKey.RSA.Types (PrivateKey)
41−import Data.Aeson
42−import Data.Aeson.Types
43−import Data.ByteArray
44−import Data.ByteArray.Encoding
45−import Data.ByteString (ByteString)
46−import Data.ByteString.Builder (Builder)
47−import qualified Data.ByteString.Builder as Build
48−import qualified Data.ByteString.Char8 as BS8
49−import qualified Data.ByteString.Lazy as LBS
50−import Data.Coerce
51−import Data.Default.Class (def)
52−import Data.List
53−import Data.String
54−import qualified Data.Text as Text
55−import qualified Data.Text.Encoding as Text
56−import Data.Time
57−import Data.Time.Clock.POSIX
58−import Data.Type.Bool
59−import Data.Type.Equality
60−import Data.Typeable
61−import Data.X509
62−import Data.X509.Memory
63−import GHC.Exts (Constraint)
64−import GHC.TypeLits
65−import Network.Google.Internal.Auth
66−import Network.Google.Internal.Logger
67−import Network.Google.Prelude
68−import Network.HTTP.Conduit hiding (Proxy)
69−import qualified Network.HTTP.Conduit as Client
70−import Network.HTTP.Types
21+import qualified Data.Text as Text
22+import Data.Type.Bool (type (||))
23+import Data.Type.Equality (type (==))
24+import Data.Typeable (Proxy (..))
25+import GHC.Exts (Constraint)
26+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
27+import Network.Google.Internal.Auth (Credentials)
28+import Network.Google.Prelude (GoogleRequest (Ss),
29+ OAuthScope (..))
7130
7231-- | Type-restrict the supplied credentials/whatever to the specific scopes.
7332--
@@ -77,28 +36,34 @@ import Network.HTTP.Types
7736-- This seems sufficiently general, does it already exist?
7837--
7938-- /See:/ '(!)'.
80−authorize :: proxy s -> k s -> k s
81−authorize _ = id
39+allow :: proxy s -> k s -> k s
40+allow _ = id
41+
42+-- | Append the type-level lists of two 'Proxy' values.
43+--
44+-- /See:/ 'allow'.
45+(!) :: proxy xs -> proxy ys -> Proxy (xs ++ ys)
46+(!) _ _ = Proxy
8247
8348-- | Determine if _any_ of the scopes a request requires is a subset
8449-- of the scopes the credentials supports.
8550type family Authorize (s :: [Symbol]) a :: Constraint where
86− -- The use of 'HasScope' will show the reduced failing case,
87− -- and the use of '∈' will give the error context.
88− Authorize s a = HasScope (Ss a) s ∈ s
51+ Authorize s a = HasScope (Ss a ⊆ s) s
8952
9053-- | For error message/presentation purposes, this wraps the result of
91−-- the existence checks below.
92−type family (∈) p s :: Constraint where
93− (∈) 'True s = ()
54+-- the membership checks below. When 'False fails to match, it will show
55+-- the reduced error case for '⊆' compared against the full
56+-- set of scopes the credentials ('s') have.
57+type family HasScope p s :: Constraint where
58+ HasScope 'True s = ()
9459
95−type family HasScope a s where
96− HasScope a (x ': xs) = Elem x a || HasScope a xs
60+type family (⊆) a s where
61+ (⊆) a (x ': xs) = x ∈ a || a ⊆ xs
9762
98−-- | Does 'a :: *' exist in 'b :: [*]'.
99−type family Elem a b where
100− Elem x '[] = 'False
101− Elem x (y ': xs) = x == y || Elem x xs
63+-- | Is 'a :: *' an element of 'b :: [*]'.
64+type family (∈) a b where
65+ (∈) x '[] = 'False
66+ (∈) x (y ': xs) = x == y || x ∈ xs
10267
10368-- | Type-level append.
10469type family (++) xs ys where
@@ -120,7 +85,3 @@ instance (KnownSymbol x, Allow xs) => Allow (x ': xs) where
12085
12186instance Allow s => Allow (Credentials s) where
12287 getScopes _ = getScopes (Proxy :: Proxy s)
123−
124−-- | Append the types of two 'Proxy' values.
125−(!) :: proxy xs -> proxy ys -> Proxy (xs ++ ys)
126−(!) _ _ = Proxy