@@ -1,20 +1,10 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE ExplicitNamespaces #-}
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 #-}
3+{-# LANGUAGE PolyKinds #-}
13−{-# LANGUAGE RecordWildCards #-}
14−{-# LANGUAGE ScopedTypeVariables #-}
4+{-# LANGUAGE ScopedTypeVariables #-}
15−{-# LANGUAGE TypeFamilies #-}
5+{-# LANGUAGE TypeFamilies #-}
16−{-# LANGUAGE TypeOperators #-}
6+{-# LANGUAGE TypeOperators #-}
17−{-# LANGUAGE UndecidableInstances #-}
7+{-# LANGUAGE UndecidableInstances #-}
20-- Module : Network.Google.Auth.Scope
10-- Module : Network.Google.Auth.Scope
@@ -28,46 +18,15 @@
28-- from the underlying OS.
18-- from the underlying OS.
29module Network.Google.Auth.Scope where
19module Network.Google.Auth.Scope where
31−import Control.Applicative
32−import Control.Concurrent
33−import Control.Exception.Lens
34−import Control.Lens hiding (coerce, (.=))
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)
42−import Data.Aeson.Types
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
51−import Data.Default.Class (def)
54−import qualified Data.Text as Text
21+import qualified Data.Text as Text
55−import qualified Data.Text.Encoding as Text
57−import Data.Time.Clock.POSIX
58−import Data.Type.Bool
22+import Data.Type.Bool (type (||))
59−import Data.Type.Equality
23+import Data.Type.Equality (type (==))
60−import Data.Typeable
24+import Data.Typeable (Proxy (..))
62−import Data.X509.Memory
63−import GHC.Exts (Constraint)
25+import GHC.Exts (Constraint)
64−import GHC.TypeLits
26+import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
65−import Network.Google.Internal.Auth
27+import Network.Google.Internal.Auth (Credentials)
66−import Network.Google.Internal.Logger
67−import Network.Google.Prelude
28+import Network.Google.Prelude (GoogleRequest (Ss),
68−import Network.HTTP.Conduit hiding (Proxy)
29+ OAuthScope (..))
69−import qualified Network.HTTP.Conduit as Client
70−import Network.HTTP.Types
72-- | Type-restrict the supplied credentials/whatever to the specific scopes.
31-- | Type-restrict the supplied credentials/whatever to the specific scopes.
@@ -77,28 +36,34 @@ import Network.HTTP.Types
77-- This seems sufficiently general, does it already exist?
36-- This seems sufficiently general, does it already exist?
79-- /See:/ '(!)'.
38-- /See:/ '(!)'.
80−authorize :: proxy s -> k s -> k s
39+allow :: proxy s -> k s -> k s
81−authorize _ = id
40+allow _ = id
42+-- | Append the type-level lists of two 'Proxy' values.
45+(!) :: proxy xs -> proxy ys -> Proxy (xs ++ ys)
83-- | Determine if _any_ of the scopes a request requires is a subset
48-- | Determine if _any_ of the scopes a request requires is a subset
84-- of the scopes the credentials supports.
49-- of the scopes the credentials supports.
85type family Authorize (s :: [Symbol]) a :: Constraint where
50type 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
90-- | For error message/presentation purposes, this wraps the result of
53-- | For error message/presentation purposes, this wraps the result of
91−-- the existence checks below.
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.
92−type family (∈) p s :: Constraint where
57+type family HasScope p s :: Constraint where
93− (∈) 'True s = ()
58+ HasScope 'True s = ()
95−type family HasScope a s where
60+type family (⊆) a s where
96− HasScope a (x ': xs) = Elem x a || HasScope a xs
61+ (⊆) a (x ': xs) = x ∈ a || a ⊆ xs
98−-- | Does 'a :: *' exist in 'b :: [*]'.
63+-- | Is 'a :: *' an element of 'b :: [*]'.
99−type family Elem a b where
64+type family (∈) a b where
100− Elem x '[] = 'False
65+ (∈) x '[] = 'False
101− Elem x (y ': xs) = x == y || Elem x xs
66+ (∈) x (y ': xs) = x == y || x ∈ xs
103-- | Type-level append.
68-- | Type-level append.
104type family (++) xs ys where
69type family (++) xs ys where
@@ -120,7 +85,3 @@ instance (KnownSymbol x, Allow xs) => Allow (x ': xs) where
121instance Allow s => Allow (Credentials s) where
86instance Allow s => Allow (Credentials s) where
122 getScopes _ = getScopes (Proxy :: Proxy s)
87 getScopes _ = getScopes (Proxy :: Proxy s)
124−-- | Append the types of two 'Proxy' values.
125−(!) :: proxy xs -> proxy ys -> Proxy (xs ++ ys)