fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tokenRestrict & documentation

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-10 11:38:42 +02:00
parent 0b33becbc9
commit 9c3e413706
1 changed files with 23 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/Model/Token.hs
View File

@ -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