orizentic (empty) → 0.1.0.0
raw patch · 8 files changed
+709/−0 lines, 8 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, hspec, jwt, mtl, optparse-applicative, orizentic, random, text, time, uuid
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Orizentic.hs +97/−0
- orizentic.cabal +86/−0
- readme.md +86/−0
- src/LuminescentDreams/Orizentic.hs +221/−0
- test/Spec.hs +2/−0
- test/UnitSpec.hs +185/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Savanni D'Gerinel (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Savanni D'Gerinel nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Orizentic.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Prelude hiding (readFile, writeFile)++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Reader+import Data.Aeson (eitherDecode, encode)+import Data.ByteString (readFile, writeFile)+import Data.ByteString.Lazy (fromStrict, toStrict)+import Data.Monoid+import Data.Text+import Options.Applicative+import System.IO.Error (isDoesNotExistError)+import Web.JWT++import LuminescentDreams.Orizentic+++data Config = Config FilePath Command deriving Show+data Command = ListTokens+ | CreateToken Secret Issuer (Maybe TTL) ResourceName Username Permissions+ | RevokeToken Text+ | EncodeToken Secret Text+ deriving Show+++cliParser :: Parser Config+cliParser = Config <$> strOption (long "db" <> help "Path to the capabilities database")+ <*> subparser (+ command "list" (info (pure ListTokens) (progDesc "list tokens"))+ <> command "create" (info parseCreateToken (progDesc "create a token"))+ <> command "revoke" (info parseRevokeToken (progDesc "revoke a token"))+ <> command "encode" (info parseEncodeToken (progDesc "encode a token with a secret")))++parseRevokeToken :: Parser Command+parseRevokeToken =+ RevokeToken <$> (pack <$> strOption (long "id" <> help "Token ID"))++parseCreateToken :: Parser Command+parseCreateToken =+ CreateToken <$> (secret . pack <$> strOption (long "secret" <> help "The secret to use for encoding the token"))+ <*> (Issuer . pack <$> strOption (long "issuer" <> help "Token issuer (typically the owner)"))+ <*> optional (TTL . fromRational <$> option auto (long "ttl" <> help "Seconds until the token expires"))+ <*> (ResourceName . pack <$> strOption (long "resource" <> help "Name of the resource"))+ <*> (Username . pack <$> strOption (long "name" <> help "Name of the user"))+ <*> (Permissions . splitOn "," . pack <$> strOption (long "perms" <> help "Permissions"))++parseEncodeToken :: Parser Command+parseEncodeToken =+ EncodeToken <$> (secret . pack <$> strOption (long "secret" <> help "The secret to use for encoding the token"))+ <*> (pack <$> strOption (long "id" <> help "Token ID"))++newtype CapM a = CapM (ReaderT OrizenticCtx IO a)+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader OrizenticCtx)++runCapM :: OrizenticCtx -> CapM a -> IO a+runCapM ctx (CapM act) = runReaderT act ctx++main :: IO ()+main = do+ (Config path cmd) <- execParser (info (helper <*> cliParser)+ (fullDesc <> progDesc "description of the program"))++ claimsLst <- loadDB path+ case claimsLst of+ Left err -> error $ show err+ Right claims_ -> do+ ctx <- newOrizenticCtx (secret "") claims_+ case cmd of+ ListTokens -> runCapM ctx $ listClaims >>= \t -> forM_ t (liftIO . print)+ CreateToken s issuer ttl resourceName userName perms -> runCapM ctx $ do+ claim <- createClaims issuer ttl resourceName userName perms+ listClaims >>= \c -> liftIO $ saveDB c path+ liftIO $ print $ encodeSigned HS256 s claim+ RevokeToken uuid -> runCapM ctx $ do+ revokeByUUID uuid+ listClaims >>= \c -> liftIO $ saveDB c path+ EncodeToken s uuid -> runCapM ctx $ do+ claim <- findClaims uuid+ case claim of+ Nothing -> error "claim not found"+ Just claim_ -> liftIO $ print $ encodeSigned HS256 s claim_++loadDB :: FilePath -> IO (Either String [JWTClaimsSet])+loadDB path =+ catch ((eitherDecode . fromStrict) <$> readFile path)+ (\e -> if isDoesNotExistError e+ then pure $ Right []+ else throw e)++saveDB :: [JWTClaimsSet] -> FilePath -> IO ()+saveDB claimsLst path = writeFile path (toStrict $ encode claimsLst)+
+ orizentic.cabal view
@@ -0,0 +1,86 @@+name: orizentic+version: 0.1.0.0+synopsis: Token-based authentication and authorization+description: A library and CLI application for generating and validating authentication tokens and their accompanying database+homepage: https://github.com/luminescent-dreams/orizentic#readme+license: BSD3+license-file: LICENSE+author: Savanni D'Gerinel+maintainer: example@example.com+copyright: 2017 Savanni D'Gerinel+category: Authentication+build-type: Simple+extra-source-files: readme.md+cabal-version: >=1.10+++flag dev+ description: Turn on development settings+ manual: True+ default: False+++library+ exposed-modules: LuminescentDreams.Orizentic++ build-depends: base >= 4.7 && < 5+ , aeson >= 1.0.2 && < 1.1+ , bytestring >= 0.10 && < 0.11+ , containers >= 0.5.7 && < 0.6+ , jwt >= 0.7 && < 0.8+ , mtl >= 2.2 && < 2.3+ , random >= 1.1 && < 1.2+ , text >= 1.2 && < 1.3+ , time >= 1.6 && < 1.7+ , uuid >= 1.3 && < 1.4++ if flag(dev)+ ghc-options: -Wall+ else+ ghc-options: -Wall -Werror+ hs-source-dirs: src+ default-language: Haskell2010+++executable orizentic+ hs-source-dirs: app+ main-is: Orizentic.hs++ build-depends: base+ , orizentic+ , aeson+ , bytestring >= 0.10 && < 0.11+ , jwt+ , mtl+ , optparse-applicative >= 0.13 && < 0.14+ , text+ , time++ if flag(dev)+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ else+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Werror+ default-language: Haskell2010+++test-suite orizentic-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs++ other-modules: UnitSpec++ build-depends: base+ , orizentic+ , hspec+ , jwt+ , mtl+ , time++ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/luminescent-dreams/orizentic+
+ readme.md view
@@ -0,0 +1,86 @@+# Orizentic++Orizentic provides a library that streamlines token-based authentication and a CLI tool for maintaining the database.++## Credit++The name is a contraction of Auth(oriz)ation/Auth(entic)ation, and credit goes to [Daria Phoebe Brashear](https://github.com/dariaphoebe).++The original idea has been debated online for many years, but the push to make this useful comes from [Aria Stewart](https://github.com/aredridel).++## Tokens++Tokens are simple [JWTs](https://jwt.io/). This library simplifies the process by easily generating and checking JWTs that have only an issuer, an optional time-to-live, a resource name, a username, and a list of permissions. A typical resulting JWT would look like this:++ { iss = Savanni+ , sub = health+ , aud = "Savanni Desktop"+ , exp = null+ , nbf = null+ , iat = 1499650083+ , jti = 9d57a8d8-d11e-43b2-a4d6-7b82ad043994+ , unregisteredClaims = { perms: [ "read", "write" ] }+ }++The `issuer` and `audience` (or username) are almost entirely for human readability. In this instance, I issued a token that was intended to be used on my desktop system.++The `subject` in this case is synonymous with Resource and is a name for the resource for which access is being granted. Permissions are a simple list of freeform strings. Both of these are flexible within your application and your authorization checks will use them to verify that the token can be used for the specified purpose.++## Usage++A variety of workflows appear in the test code, however this is a workflow that I found to be typical in production code.++Start with creating the context:++```+claimsLst <- loadClaims "authDbPath"+ctx <- newOrizenticCtx ("JWT secret" :: Web.JWT.Secret) []+```++Your application monad will need to implement the `HasOrizenticCtx` type class, or you will need to call all of the orizentic functions with a reader monad.++```+data AppContext -- Your application context here++instance HasOrizenticCtx AppContext where+ hasOrizenticCtx = ...+```++A typical authentication/verification function will look like this:++```+authenticate :: (HasOrizenticCtx m) => JWT UnverifiedJWT -> m False+authenticate token = do+ res <- validateToken token+ case res of+ Nothing -> False -- The token is invalid. Perhaps not a token at all,+ -- perhaps not signed with the key for this application,+ -- or perhaps forged.+ Just jwt -> checkAuthorizations validatePermissions jwt+ where+ -- Validate permissions receives the resource name and a list of+ -- permissions. In this case, the "resource" is a name I designated to the+ -- entire app, and the only valid permissions are read+write. A more+ -- sophisticated app will want a validator with more resource names and more+ -- nuanced permissions.+ validatePermissions rn (Permissions perms) =+ (rn == ResourceName "health")+ && ("read" `elem` perms)+ && ("write" `elem` perms)+```++## CLI++`orizentic` is a command-line tool which manages a database stored to disk. The database is a plain text format containing JWT claims. It can be easily loaded with this function:++```+loadClaims :: FilePath -> IO (Either String [JWTClaimsSet])+loadClaims path =+ catch ((eitherDecode . fromStrict) <$> Data.ByteString.readFile path)+ (\e -> if isDoesNotExistError e+ then pure $ Right []+ else throw e)+```++The utility is provided as a convienence for simple applications with rare database changes. Production environments will likely wish to manage this within a more sophisticated application and may wish to use some other storage backend.+
+ src/LuminescentDreams/Orizentic.hs view
@@ -0,0 +1,221 @@+{-| Core functions for Orizentic+ -+ - The most conceptually confusing part of this is the relationship between the a Token, an unverified JWT, a verified JWT, and a claims set.+ -+ - A Token is a broad concept, and there is no particular data structure in this system that corresponds.+ -+ - Colloquially, however, a Token is synoymous with a JWT. JWTs can be either unverified or verified. An unverified JWT is anything that has been recieved from any outside source but whose signature has not yet been checked. a verified JWT has had the signature checked, at least as `Web.JWT` implements it. In this application, however, the process of checking the JWT signature also involves checking that the JWT is known to the application and that it has not expired.+ -+ - A ClaimsSet is an attribute of a JWT that is available for reading whether the JWT has been signed or whether the signature is valid. This describes all of the interesting parts of what the token is good for and who it should belong to.+ -+ - JWTs and their signatures typically get encoded into a Base64 format for transmission across the internet. `Web.JWT` provides the `encodeSigned` and `decode` functions to handle this process. This library provides `encodeToken` to do the conversion with a somewhat nicer API.+ -+ - Many operations in this library involve creating and managing claims sets. Additional functions are utilities for converting those claims sets both to and from JWT and fully encoded formats.+ - -}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module LuminescentDreams.Orizentic (+ ResourceName(..), Permissions(..), Issuer(..), TTL(..), Username(..)+ , OrizenticCtx(..), HasOrizenticCtx(..)+ , newOrizenticCtx+ , validateToken, checkAuthorizations+ , createClaims, revokeClaims, revokeByUUID, replaceClaims+ , listClaims, findClaims, encodeClaims, hasPermission, permissions+ ) where++import Prelude ( Bool(..), Either(..), Eq(..), Show(..)+ , ($), (.), (<), (>>=)+ , filter, fmap, id+ , error+ )++import Control.Applicative ((<$>), pure)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (MonadReader(..))+import Data.Aeson (ToJSON(..), Result(..), fromJSON)+import Data.IORef (IORef, newIORef, modifyIORef, readIORef, writeIORef)+import qualified Data.List as L+import qualified Data.Map as M+import Data.Maybe (Maybe(..), listToMaybe)+import Data.Text (Text)+import Data.Time (NominalDiffTime, addUTCTime, getCurrentTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Data.UUID (toText)+import System.Random (randomIO)+import Web.JWT+++-- | ResourceName is application-defined for however the resources in the application should be named+newtype ResourceName = ResourceName Text deriving (Eq, Show)++-- | Permissions are application-defined descriptions of what can be done with the named resource+newtype Permissions = Permissions [Text] deriving Show++-- | Issuers are typically informative, but should generally describe who or what created the token+newtype Issuer = Issuer Text deriving Show++-- | Time to live is the number of seconds until a token expires+newtype TTL = TTL NominalDiffTime deriving Show++-- | Username, or Audience in JWT terms, should describe who or what is supposed to be using this token+newtype Username = Username Text deriving Show++instance Eq (JWT VerifiedJWT) where+ j1 == j2 = claims j1 == claims j2++newtype ClaimsStore = ClaimsStore (IORef [JWTClaimsSet])++data OrizenticCtx = OrizenticCtx Secret ClaimsStore++-- data CapDb = CapDb [JWTClaimsSet]+-- +-- instance ToJSON CapDb where+-- toJSON (CapDb claims) = toJSON claims+-- +-- instance FromJSON CapDb where+-- parseJSON lst = CapDb <$> parseJSON lst++class HasOrizenticCtx ctx where+ hasOrizenticCtx :: ctx -> OrizenticCtx++instance HasOrizenticCtx OrizenticCtx where+ hasOrizenticCtx = id++type OrizenticM m r = (MonadIO m, MonadReader r m, HasOrizenticCtx r)++{- | Create a new `OrizenticCtx` that will use a particular JWT secret and set of claims. --}+newOrizenticCtx :: MonadIO m => Secret -> [JWTClaimsSet] -> m OrizenticCtx+newOrizenticCtx s initialClaims = do+ st <- liftIO $ ClaimsStore <$> newIORef initialClaims+ pure $ OrizenticCtx s st++{- | Validate a token by checking its signature, that it is not expired, and that it is still present in the database. Return Nothing if any check fails, but return a verified JWT if it all succeeds. This function requires IO because it checks both the current database state and the current time. -}+validateToken :: OrizenticM m r => JWT UnverifiedJWT -> m (Maybe (JWT VerifiedJWT))+validateToken jwt = do+ now <- utcTimeToPOSIXSeconds <$> liftIO getCurrentTime+ (OrizenticCtx s _) <- hasOrizenticCtx <$> ask+ case verify s jwt of+ Nothing -> pure Nothing+ Just vjwt -> if isExpired now (claims jwt)+ then pure Nothing+ else do lst <- listClaims+ if claims jwt `L.elem` lst+ then pure $ Just vjwt+ else pure Nothing+ where+ isExpired now claimsSet =+ case secondsSinceEpoch <$> exp claimsSet of+ Nothing -> False+ Just expiration -> expiration < now+++{- | Given a verified JWT, pass the resource name and permissions to a user-defined function. The function should return true if the caller should be granted access to the resource and falls, otherwise. That result will be passed back to the caller. -}+checkAuthorizations :: (ResourceName -> Permissions -> Bool) -> JWT VerifiedJWT -> Bool+checkAuthorizations fn token = + let claimsSet = claims token+ rn = ResourceName . stringOrURIToText <$> sub claimsSet+ in case rn of+ Nothing -> False+ Just rn_ -> fn rn_ (permissions claimsSet)+++{- | Create a new JWTClaimsSet. This will create the claims (a tedious process with JWT) and add it to the database. It will also calculate and set the expiration time if a TTL is provided. -}+createClaims :: OrizenticM m r => Issuer -> Maybe TTL -> ResourceName -> Username -> Permissions -> m JWTClaimsSet+createClaims (Issuer issuer) ttl (ResourceName resourceName) (Username name) (Permissions perms) =+ let ttl_ = (\(TTL val) -> val) <$> ttl+ in do+ (OrizenticCtx _ (ClaimsStore store)) <- hasOrizenticCtx <$> ask+ now <- liftIO getCurrentTime+ uuid <- liftIO randomIO+ let tok = JWTClaimsSet { iss = stringOrURI issuer+ , sub = stringOrURI resourceName+ , aud = Left <$> stringOrURI name+ , exp = (utcTimeToPOSIXSeconds . (`addUTCTime` now) <$> ttl_) >>= numericDate+ , nbf = Nothing+ , iat = numericDate $ utcTimeToPOSIXSeconds now+ , jti = stringOrURI $ toText uuid+ , unregisteredClaims = M.fromList [("perms", toJSON perms)]+ }+ liftIO $ modifyIORef store ((:) tok)+ pure tok+++{- | Remove a claims set from the database so that all additional validation checks fail. -}+revokeClaims :: OrizenticM m r => JWTClaimsSet -> m ()+revokeClaims tok = do+ (OrizenticCtx _ (ClaimsStore store)) <- hasOrizenticCtx <$> ask+ liftIO $ modifyIORef store (L.delete tok)+ pure ()+++{- | Revoke a ClaimsSet given its UUID, which is set in the `jti` claim. -}+revokeByUUID :: OrizenticM m r => Text -> m ()+revokeByUUID uuid = do+ (OrizenticCtx _ (ClaimsStore store)) <- hasOrizenticCtx <$> ask+ liftIO $ modifyIORef store (filter (\c -> getUUID c /= Just uuid))+ where+ getUUID = fmap stringOrURIToText . jti+ ++{- | Replace the entire list of claims currently in memory. This is typically used when reloading a claims set from disk. -}+replaceClaims :: OrizenticM m r => [JWTClaimsSet] -> m ()+replaceClaims newClaims = do+ (OrizenticCtx _ (ClaimsStore store)) <- hasOrizenticCtx <$> ask+ liftIO $ writeIORef store newClaims+++{- | Return all of the ClaimsSets currently in the database. -}+listClaims :: OrizenticM m r => m [JWTClaimsSet]+listClaims = do+ (OrizenticCtx _ (ClaimsStore store)) <- hasOrizenticCtx <$> ask+ liftIO $ readIORef store+++{- | Find a ClaimsSet by UUID -}+findClaims :: OrizenticM m r => Text -> m (Maybe JWTClaimsSet)+findClaims uuid = do+ lst <- listClaims+ pure $ listToMaybe $ filter (\c -> getUUID c == Just uuid) lst+ where+ getUUID = fmap stringOrURIToText . jti++-- TODO: maybe this should become part of a utility library+-- saveDB :: TokenM m r => FilePath -> m ()+-- saveDB path = do+-- (OrizenticCtx s _) <- hasOrizenticCtx <$> ask+-- claims <- listClaims+-- liftIO $ writeFile path $ toStrict $ encode $ CapDb claims+-- +-- +-- reloadDB :: TokenM m r => FilePath -> m ()+-- reloadDB path = do+-- (OrizenticCtx s (ClaimsStore store)) <- hasOrizenticCtx <$> ask+-- db <- (eitherDecode . fromStrict) <$> (liftIO $ readFile path)+-- case db of+-- Left err -> undefined+-- Right (CapDb claims) -> liftIO $ writeIORef store claims+++{- | Encode a ClaimsSet using this context's secret. -}+encodeClaims :: OrizenticM m r => JWTClaimsSet -> m Text+encodeClaims token = do+ (OrizenticCtx s _) <- hasOrizenticCtx <$> ask+ pure $ encodeSigned HS256 s token+++hasPermission :: Permissions -> Text -> Bool+hasPermission (Permissions perms) p = p `L.elem` perms+++permissions :: JWTClaimsSet -> Permissions+permissions claimsSet =+ case M.lookup "perms" $ unregisteredClaims claimsSet of+ Nothing -> Permissions []+ Just claimsPermissions -> case fromJSON claimsPermissions of+ Error err -> error $ show err+ Success s -> Permissions s+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+
+ test/UnitSpec.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module UnitSpec where++import Control.Concurrent (threadDelay)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Reader (MonadReader(..), ReaderT(..))+import Test.Hspec+import Web.JWT++import LuminescentDreams.Orizentic+++newtype Context = Context OrizenticCtx++instance HasOrizenticCtx Context where+ hasOrizenticCtx (Context c) = c++newContext :: Secret -> IO Context+newContext secret = Context <$> newOrizenticCtx secret []++newtype CapSpecM a = CapSpecM (ReaderT Context IO a)+ deriving (Functor, Applicative, Monad, MonadIO, MonadReader Context)++runCapSpec :: Context -> CapSpecM a -> IO a+runCapSpec ctx (CapSpecM act) = runReaderT act ctx++spec :: Spec+spec = describe "Orizentic Unit Tests" $ do+ it "can create a new token" $ do+ ctx <- newContext (secret "ctx")+ (tok, tok2, tokList) <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ tok2 <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-2")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ tokList <- listClaims+ pure (tok, tok2, tokList)+ tokList `shouldSatisfy` elem tok+ tokList `shouldSatisfy` elem tok2+ length tokList `shouldBe` 2+++ it "can revoke a token" $ do+ ctx <- newContext (secret "ctx")+ (tok, tok2, tokList) <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ tok2 <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-2")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ revokeClaims tok+ tokList <- listClaims+ pure (tok, tok2, tokList)++ tokList `shouldNotSatisfy` elem tok+ tokList `shouldSatisfy` elem tok2+ length tokList `shouldBe` 1+++ it "rejects tokens with an invalid secret" $ do+ ctx1 <- newContext (secret "ctx1")+ ctx2 <- newContext (secret "ctx2")+ Just unverifiedJWT <- runCapSpec ctx1 $ do+ token <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ decode <$> encodeClaims token+ res <- runCapSpec ctx2 $ validateToken unverifiedJWT+ res `shouldBe` Nothing++ it "rejects tokens that are absent from the database" $ do+ ctx <- newContext (secret "ctx")+ (tok, validity) <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ revokeClaims tok+ validity <- validateToken unverifiedJWT+ pure (tok, validity)+ validity `shouldBe` Nothing++ it "validates present tokens with a valid secret" $ do+ ctx <- newContext (secret "ctx")+ (tok, validity) <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ validity <- validateToken unverifiedJWT+ pure (tok, validity)+ (claims <$> validity) `shouldBe` Just tok++ it "rejects expired tokens" $ do+ ctx <- newContext (secret "ctx")+ (tok, validity1, validity2) <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 1)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ validity1 <- validateToken unverifiedJWT+ liftIO $ threadDelay 2000000+ validity2 <- validateToken unverifiedJWT+ pure (tok, validity1, validity2)+ (claims <$> validity1) `shouldBe` Just tok+ validity2 `shouldBe` Nothing++ it "accepts tokens that have no expiration" $ do+ ctx <- newContext (secret "ctx")+ (tok, validity1, validity2) <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ Nothing+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ validity1 <- validateToken unverifiedJWT+ liftIO $ threadDelay 2000000+ validity2 <- validateToken unverifiedJWT+ pure (tok, validity1, validity2)+ (claims <$> validity1) `shouldBe` Just tok+ (claims <$> validity2) `shouldBe` Just tok++ it "authorizes a token with the correct resource and permissions" $ do+ ctx <- newContext (secret "ctx")+ res <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read", "write", "grant"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ Just jwt <- validateToken unverifiedJWT+ pure $ checkAuthorizations (\rn perms -> (rn == ResourceName "resource-1") && (perms `hasPermission` "grant"))+ jwt+ res `shouldBe` True++ it "rejects a token with the incorrect permissions" $ do+ ctx <- newContext (secret "ctx")+ res <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource-1")+ (Username "Savanni")+ (Permissions ["read"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ Just jwt <- validateToken unverifiedJWT+ pure $ checkAuthorizations (\rn perms -> (rn == ResourceName "resource-1") && (perms `hasPermission` "grant"))+ jwt+ res `shouldBe` False++ it "rejects a token with the incorrect resource name" $ do+ ctx <- newContext (secret "ctx")+ res <- runCapSpec ctx $ do+ tok <- createClaims (Issuer "test")+ (Just $ TTL 3600)+ (ResourceName "resource")+ (Username "Savanni")+ (Permissions ["read, write, grant"])+ Just unverifiedJWT <- decode <$> encodeClaims tok+ Just jwt <- validateToken unverifiedJWT+ pure $ checkAuthorizations (\rn perms -> (rn == ResourceName "resource-1") && (perms `hasPermission` "grant"))+ jwt+ res `shouldBe` False+