From 9c3e413706f82dacb5716a7e4b1e269983fcbc94 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 10 Apr 2019 11:38:42 +0200 Subject: [PATCH] tokenRestrict & documentation --- src/Model/Token.hs | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) diff --git a/src/Model/Token.hs b/src/Model/Token.hs index d438965a4..e3b3148cf 100644 --- a/src/Model/Token.hs +++ b/src/Model/Token.hs @@ -3,6 +3,7 @@ module Model.Token ( BearerToken(..) , _tokenIdentifier, _tokenAuthority, _tokenRoutes, _tokenAddAuth, _tokenRestrictions, _tokenRestrictionIx, _tokenRestrictionAt, _tokenIssuedAt, _tokenIssuedBy, _tokenExpiresAt, _tokenStartsAt + , tokenRestrict , bearerToken , encodeToken, BearerTokenException(..), decodeToken, jwtEncoding , tokenToJSON, tokenParseJSON, tokenParseJSON' @@ -47,13 +48,20 @@ import Control.Monad.Random (MonadRandom(..)) import Control.Monad.Trans.Maybe (MaybeT(..)) --- | Presenting a `BearerToken` transfers some authorisation from `tokenAuthority` to _whoever_ presents the token +-- | Presenting a `BearerToken` transfers some authorisation from `tokenAuthority` to /whoever/ presents the token data BearerToken site = BearerToken - { tokenIdentifier :: TokenId -- ^ Unique identifier for each token; maybe useful for tracing usage of tokens - , tokenAuthority :: AuthId site -- ^ Tokens only grant rights the `tokenAuthority` has (i.e. `AuthTag`s are evaluated with the user set to `tokenAuthority`) - , tokenRoutes :: Maybe (HashSet (Route site)) -- ^ Tokens can optionally be restricted to only be usable on a subset of routes - , tokenAddAuth :: Maybe AuthDNF -- ^ Tokens can specify an additional predicate logic formula of `AuthTag`s that needs to evaluate to `Authorized` in order for the token to be valid. - , tokenRestrictions :: HashMap (Route site) Value -- ^ Tokens can be restricted to certain actions within the context of a route (i.e. creating an user only with a certain username, resetting a password only if the old matches a hash, ...) + { tokenIdentifier :: TokenId + -- ^ Unique identifier for each token; maybe useful for tracing usage of tokens + , tokenAuthority :: AuthId site + -- ^ Tokens only grant rights the `tokenAuthority` has (i.e. `AuthTag`s are evaluated with the user set to `tokenAuthority`) + , tokenRoutes :: Maybe (HashSet (Route site)) + -- ^ Tokens can optionally be restricted to only be usable on a subset of routes + , tokenAddAuth :: Maybe AuthDNF + -- ^ Tokens can specify an additional predicate logic formula of `AuthTag`s that needs to evaluate to `Authorized` in order for the token to be valid. + , tokenRestrictions :: HashMap (Route site) Value + -- ^ Tokens can be restricted to certain actions within the context of a route (i.e. creating an user only with a certain username, resetting a password only if the old matches a hash, ...) + -- + -- In general this is not encrypted; some care is required to not expose sensitive information to the bearer of the token , tokenIssuedAt :: UTCTime , tokenIssuedBy :: InstanceId , tokenExpiresAt @@ -69,13 +77,20 @@ makeLenses_ ''BearerToken _tokenRestrictionIx :: (FromJSON a, ToJSON a, Hashable (Route site), Eq (Route site)) => Route site -> Traversal' (BearerToken site) a -- ^ Focus a singular restriction (by route) if it exists -- --- This /cannot/ be used to add restrictions, use `_tokenRestrictionAt` instead +-- This /cannot/ be used to add restrictions, use `_tokenRestrictionAt` or `tokenRestrict` instead _tokenRestrictionIx route = _tokenRestrictions . ix route . _JSON _tokenRestrictionAt :: (FromJSON a, ToJSON a, Hashable (Route site), Eq (Route site)) => Route site -> Traversal' (BearerToken site) (Maybe a) -- ^ Focus a singular restriction (by route) whether it exists, or not _tokenRestrictionAt route = _tokenRestrictions . at route . maybePrism _JSON +tokenRestrict :: (ToJSON a, Hashable (Route site), Eq (Route site)) => Route site -> a -> BearerToken site -> BearerToken site +-- ^ Add a restriction to a `BearerToken` +-- +-- If a restriction already exists for the targeted route, it's silently overwritten +tokenRestrict route (toJSON -> resVal) = over _tokenRestrictions $ HashMap.insert route resVal + + tokenToJSON :: forall m. ( MonadHandler m @@ -163,7 +178,7 @@ bearerToken :: forall m. -> Maybe (Maybe UTCTime) -- ^ @Nothing@ determines default expiry time automatically -> Maybe UTCTime -- ^ @Nothing@ means token starts to be valid immediately -> m (BearerToken (HandlerSite m)) --- ^ Smart constructor for `Bearertoken`, does not set route restrictions (due to polymorphism), use `_tokenRestrictionAt` +-- ^ Smart constructor for `BearerToken`, does not set route restrictions (due to polymorphism), use `tokenRestrict` bearerToken tokenAuthority tokenRoutes tokenAddAuth mTokenExpiresAt tokenStartsAt = do tokenIdentifier <- liftIO getRandom tokenIssuedAt <- liftIO getCurrentTime