@@ -41,13 +41,11 @@ import Network.HTTP.Types (urlEncode)
41-- with a 'Proxy' type, or explicitly specifying the type annotation without
41-- with a 'Proxy' type, or explicitly specifying the type annotation without
42-- having separate functions.
42-- having separate functions.
44−-- This seems sufficiently general, does it already exist?
46-- /See:/ '!'.
44-- /See:/ '!'.
47allow :: proxy s -> k s -> k s
45allow :: proxy s -> k s -> k s
48allow _ = id
46allow _ = id
50−-- | Type-restrict the supplied credentials etc. to no scopes.
48+-- | Type-restrict the supplied credentials (etc.) to no scopes.
51forbid :: k '[] -> k '[]
49forbid :: k '[] -> k '[]
52forbid = id
50forbid = id
@@ -61,16 +59,17 @@ forbid = id
61-- listed in the scopes the credentials supports.
59-- listed in the scopes the credentials supports.
63-- For error message/presentation purposes, this wraps the result of
61-- For error message/presentation purposes, this wraps the result of
64−-- the membership checks below.
62+-- the 'HasScope' membership check to show both lists of scopes before
65−type family Authorize (s :: [Symbol]) a :: Constraint where
64+type family HasScope (s :: [Symbol]) a :: Constraint where
66− Authorize s a = MatchAnyScope s (Scopes a) ~ 'True
65+ HasScope s a = (s `HasScope'` Scopes a) ~ 'True
68−-- | Check if any scope exists in both parameters.
67+-- | Check if any of actual supplied scopes 's' exist in the required set 'a'.
69−type family MatchAnyScope a b where
68+type family HasScope' s a where
70− MatchAnyScope a '[] = 'True
69+ HasScope' s '[] = 'True -- No scopes are required.
71− MatchAnyScope (x ': xs) b = x ∈ b || MatchAnyScope xs b
70+ HasScope' (x ': xs) a = x ∈ a || HasScope' xs a
73−-- | Set membership.
72+-- | Membership.
74type family (∈) a b where
73type family (∈) a b where
75 (∈) x '[] = 'False
74 (∈) x '[] = 'False
76 (∈) x (y ': xs) = x == y || x ∈ xs
75 (∈) x (y ': xs) = x == y || x ∈ xs
@@ -82,19 +81,19 @@ type family (++) xs ys where
82 (++) (a ': as) bs = a ': (as ++ bs)
81 (++) (a ': as) bs = a ': (as ++ bs)
84class Allow a where
83class Allow a where
85− -- | Obtain a list of supported 'OAuthScope's from a proxy type.
84+ -- | Obtain a list of supported 'OAuthScope' values from a proxy.
86− getScopes :: proxy a -> [OAuthScope]
85+ allowScopes :: proxy a -> [OAuthScope]
88instance Allow '[] where
87instance Allow '[] where
89− getScopes _ = []
88+ allowScopes _ = []
91instance (KnownSymbol x, Allow xs) => Allow (x ': xs) where
90instance (KnownSymbol x, Allow xs) => Allow (x ': xs) where
92− getScopes _ = scope (Proxy :: Proxy x) : getScopes (Proxy :: Proxy xs)
91+ allowScopes _ = scope (Proxy :: Proxy x) : allowScopes (Proxy :: Proxy xs)
94 scope = OAuthScope . Text.pack . symbolVal
93 scope = OAuthScope . Text.pack . symbolVal
96instance Allow s => Allow (Credentials s) where
95instance Allow s => Allow (Credentials s) where
97− getScopes _ = getScopes (Proxy :: Proxy s)
96+ allowScopes _ = allowScopes (Proxy :: Proxy s)
99concatScopes :: [OAuthScope] -> Text
98concatScopes :: [OAuthScope] -> Text
100concatScopes = Text.intercalate " " . coerce
99concatScopes = Text.intercalate " " . coerce