From a2b54d3dbd920c622ea5471cc14a874d0fbcccb8 Mon Sep 17 00:00:00 2001 From: Clement Delafargue Date: Wed, 3 Jul 2024 22:20:38 +0200 Subject: [PATCH] wip: abort on evaluation error instead of silently ignoring errors, blow up the whole evaluation --- biscuit/src/Auth/Biscuit/Datalog/Executor.hs | 81 ++++++++++--------- .../Auth/Biscuit/Datalog/ScopedExecutor.hs | 71 ++++++++-------- biscuit/src/Auth/Biscuit/Token.hs | 6 +- biscuit/src/Auth/Biscuit/Utils.hs | 29 +++++++ biscuit/test/Spec/ScopedExecutor.hs | 12 +-- 5 files changed, 117 insertions(+), 82 deletions(-) diff --git a/biscuit/src/Auth/Biscuit/Datalog/Executor.hs b/biscuit/src/Auth/Biscuit/Datalog/Executor.hs index 700acbb..3098880 100644 --- a/biscuit/src/Auth/Biscuit/Datalog/Executor.hs +++ b/biscuit/src/Auth/Biscuit/Datalog/Executor.hs @@ -60,7 +60,7 @@ import qualified Text.Regex.TDFA.Text as Regex import Validation (Validation (..), failure) import Auth.Biscuit.Datalog.AST -import Auth.Biscuit.Utils (maybeToRight) +import Auth.Biscuit.Utils (maybeToRight, anyM, allM, setFilterM) -- | A variable name type Name = Text @@ -105,6 +105,8 @@ data ExecutionError | ResultError ResultError -- ^ The evaluation ran to completion, but checks and policies were not -- fulfilled. + | EvaluationError String + -- ^ Datalog evaluation failed while evaluating an expression deriving (Eq, Show) -- | Settings for the executor runtime restrictions. @@ -186,40 +188,40 @@ fromScopedFacts = FactGroup . Map.fromListWith (<>) . Set.toList . Set.map (fmap countFacts :: FactGroup -> Int countFacts (FactGroup facts) = sum $ Set.size <$> Map.elems facts --- todo handle Check All -checkCheck :: Limits -> Natural -> Natural -> FactGroup -> EvalCheck -> Validation (NonEmpty Check) () -checkCheck l blockCount checkBlockId facts c@Check{cQueries,cKind} = +checkCheck :: Limits -> Natural -> Natural -> FactGroup -> EvalCheck -> Either String (Validation (NonEmpty Check) ()) +checkCheck l blockCount checkBlockId facts c@Check{cQueries,cKind} = do let isQueryItemOk = case cKind of One -> isQueryItemSatisfied l blockCount checkBlockId facts All -> isQueryItemSatisfiedForAllMatches l blockCount checkBlockId facts - in if any (isJust . isQueryItemOk) cQueries - then Success () - else failure (toRepresentation c) - -checkPolicy :: Limits -> Natural -> FactGroup -> EvalPolicy -> Maybe (Either MatchedQuery MatchedQuery) -checkPolicy l blockCount facts (pType, query) = - let bindings = fold $ mapMaybe (isQueryItemSatisfied l blockCount blockCount facts) query - in if not (null bindings) - then Just $ case pType of - Allow -> Right $ MatchedQuery{matchedQuery = toRepresentation <$> query, bindings} - Deny -> Left $ MatchedQuery{matchedQuery = toRepresentation <$> query, bindings} - else Nothing - -isQueryItemSatisfied :: Limits -> Natural -> Natural -> FactGroup -> QueryItem' 'Eval 'Representation -> Maybe (Set Bindings) -isQueryItemSatisfied l blockCount blockId allFacts QueryItem{qBody, qExpressions, qScope} = + hasOkQueryItem <- anyM (fmap isJust . isQueryItemOk) cQueries + pure $ if hasOkQueryItem + then Success () + else failure (toRepresentation c) + +checkPolicy :: Limits -> Natural -> FactGroup -> EvalPolicy -> Either String (Maybe (Either MatchedQuery MatchedQuery)) +checkPolicy l blockCount facts (pType, query) = do + bindings <- fold . fold <$> traverse (isQueryItemSatisfied l blockCount blockCount facts) query + pure $ if not (null bindings) + then Just $ case pType of + Allow -> Right $ MatchedQuery{matchedQuery = toRepresentation <$> query, bindings} + Deny -> Left $ MatchedQuery{matchedQuery = toRepresentation <$> query, bindings} + else Nothing + +isQueryItemSatisfied :: Limits -> Natural -> Natural -> FactGroup -> QueryItem' 'Eval 'Representation -> Either String (Maybe (Set Bindings)) +isQueryItemSatisfied l blockCount blockId allFacts QueryItem{qBody, qExpressions, qScope} = do let removeScope = Set.map snd facts = toScopedFacts $ keepAuthorized' False blockCount allFacts qScope blockId - bindings = removeScope $ getBindingsForRuleBody l facts qBody qExpressions - in if Set.size bindings > 0 - then Just bindings - else Nothing + bindings <- removeScope <$> getBindingsForRuleBody l facts qBody qExpressions + pure $ if Set.size bindings > 0 + then Just bindings + else Nothing -- | Given a set of scoped facts and a rule body, we generate a set of variable -- bindings that satisfy the rule clauses (predicates match, and expression constraints -- are fulfilled), and ensure that all bindings where predicates match also fulfill -- expression constraints. This is the behaviour of `check all`. -isQueryItemSatisfiedForAllMatches :: Limits -> Natural -> Natural -> FactGroup -> QueryItem' 'Eval 'Representation -> Maybe (Set Bindings) -isQueryItemSatisfiedForAllMatches l blockCount blockId allFacts QueryItem{qBody, qExpressions, qScope} = +isQueryItemSatisfiedForAllMatches :: Limits -> Natural -> Natural -> FactGroup -> QueryItem' 'Eval 'Representation -> Either String (Maybe (Set Bindings)) +isQueryItemSatisfiedForAllMatches l blockCount blockId allFacts QueryItem{qBody, qExpressions, qScope} = do let removeScope = Set.map snd facts = toScopedFacts $ keepAuthorized' False blockCount allFacts qScope blockId allVariables = extractVariables qBody @@ -228,26 +230,24 @@ isQueryItemSatisfiedForAllMatches l blockCount blockId allFacts QueryItem{qBody, -- bindings that unify correctly (each variable has a single possible match) legalBindingsForFacts = reduceCandidateBindings allVariables candidateBindings -- bindings that fulfill the constraints - constraintFulfillingBindings = Set.filter (\b -> all (satisfies l b) qExpressions) legalBindingsForFacts - in if Set.size constraintFulfillingBindings > 0 -- there is at least one match that fulfills the constraints - && constraintFulfillingBindings == legalBindingsForFacts -- all matches fulfill the constraints - then Just $ removeScope constraintFulfillingBindings - else Nothing + constraintFulfillingBindings <- setFilterM (\b -> allM (satisfies l b) qExpressions) legalBindingsForFacts + pure $ if Set.size constraintFulfillingBindings > 0 -- there is at least one match that fulfills the constraints + && constraintFulfillingBindings == legalBindingsForFacts -- all matches fulfill the constraints + then Just $ removeScope constraintFulfillingBindings + else Nothing -- | Given a rule and a set of available (scoped) facts, we find all fact -- combinations that match the rule body, and generate new facts by applying -- the bindings to the rule head (while keeping track of the facts origins) -getFactsForRule :: Limits -> Set (Scoped Fact) -> EvalRule -> Set (Scoped Fact) -getFactsForRule l facts Rule{rhead, body, expressions} = - let legalBindings :: Set (Scoped Bindings) - legalBindings = getBindingsForRuleBody l facts body expressions - newFacts = mapMaybe (applyBindings rhead) $ Set.toList legalBindings - in Set.fromList newFacts +getFactsForRule :: Limits -> Set (Scoped Fact) -> EvalRule -> Either String (Set (Scoped Fact)) +getFactsForRule l facts Rule{rhead, body, expressions} = do + legalBindings <- getBindingsForRuleBody l facts body expressions + pure $ Set.fromList $ mapMaybe (applyBindings rhead) $ Set.toList legalBindings -- | Given a set of scoped facts and a rule body, we generate a set of variable -- bindings that satisfy the rule clauses (predicates match, and expression constraints -- are fulfilled) -getBindingsForRuleBody :: Limits -> Set (Scoped Fact) -> [Predicate] -> [Expression] -> Set (Scoped Bindings) +getBindingsForRuleBody :: Limits -> Set (Scoped Fact) -> [Predicate] -> [Expression] -> Either String (Set (Scoped Bindings)) getBindingsForRuleBody l facts body expressions = let -- gather bindings from all the facts that match the query's predicates candidateBindings = getCandidateBindings facts body @@ -255,13 +255,13 @@ getBindingsForRuleBody l facts body expressions = -- only keep bindings combinations where each variable has a single possible match legalBindingsForFacts = reduceCandidateBindings allVariables candidateBindings -- only keep bindings that satisfy the query expressions - in Set.filter (\b -> all (satisfies l b) expressions) legalBindingsForFacts + in setFilterM (\b -> allM (satisfies l b) expressions) legalBindingsForFacts satisfies :: Limits -> Scoped Bindings -> Expression - -> Bool -satisfies l b e = evaluateExpression l (snd b) e == Right (LBool True) + -> Either String Bool +satisfies l b e = (== LBool True) <$> evaluateExpression l (snd b) e applyBindings :: Predicate -> Scoped Bindings -> Maybe (Scoped Fact) applyBindings p@Predicate{terms} (origins, bindings) = @@ -475,3 +475,4 @@ evaluateExpression l b = \case EValue term -> applyVariable b term EUnary op e' -> evalUnary op =<< evaluateExpression l b e' EBinary op e' e'' -> uncurry (evalBinary l op) =<< join bitraverse (evaluateExpression l b) (e', e'') + diff --git a/biscuit/src/Auth/Biscuit/Datalog/ScopedExecutor.hs b/biscuit/src/Auth/Biscuit/Datalog/ScopedExecutor.hs index d8bec7f..a4d0305 100644 --- a/biscuit/src/Auth/Biscuit/Datalog/ScopedExecutor.hs +++ b/biscuit/src/Auth/Biscuit/Datalog/ScopedExecutor.hs @@ -37,7 +37,6 @@ import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map import Data.Map.Strict ((!?)) -import Data.Maybe (mapMaybe) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) @@ -58,11 +57,13 @@ import Auth.Biscuit.Datalog.Executor (Bindings, ExecutionError (..), keepAuthorized', toScopedFacts) import Auth.Biscuit.Datalog.Parser (fact) import Auth.Biscuit.Timer (timer) +import Data.Bitraversable (bisequence) +import Auth.Biscuit.Utils (foldMapM, mapMaybeM) type BlockWithRevocationId = (Block, ByteString, Maybe PublicKey) -- | A subset of 'ExecutionError' that can only happen during fact generation -data PureExecError = Facts | Iterations | BadRule +data PureExecError = Facts | Iterations | BadRule | BadExpression String deriving (Eq, Show) -- | Proof that a biscuit was authorized successfully. In addition to the matched @@ -172,6 +173,7 @@ runAuthorizerNoTimeout limits authority blocks authorizer = do Facts -> TooManyFacts Iterations -> TooManyIterations BadRule -> InvalidRule + BadExpression e -> EvaluationError e allFacts <- first toExecutionError $ computeAllFacts initState let checks = bChecks <$$> ( zip [0..] (fst' <$> authority : blocks) <> [(blockCount,vBlock authorizer)] @@ -179,13 +181,14 @@ runAuthorizerNoTimeout limits authority blocks authorizer = do policies = vPolicies authorizer checkResults = checkChecks limits blockCount allFacts (checkToEvaluation externalKeys <$$$> checks) policyResults = checkPolicies limits blockCount allFacts (policyToEvaluation externalKeys <$> policies) - case (checkResults, policyResults) of - (Success (), Left Nothing) -> Left $ ResultError $ NoPoliciesMatched [] - (Success (), Left (Just p)) -> Left $ ResultError $ DenyRuleMatched [] p - (Failure cs, Left Nothing) -> Left $ ResultError $ NoPoliciesMatched (NE.toList cs) - (Failure cs, Left (Just p)) -> Left $ ResultError $ DenyRuleMatched (NE.toList cs) p - (Failure cs, Right _) -> Left $ ResultError $ FailedChecks cs - (Success (), Right p) -> Right $ AuthorizationSuccess { matchedAllowQuery = p + case bisequence (checkResults, policyResults) of + Left e -> Left $ EvaluationError e + Right (Success (), Left Nothing) -> Left $ ResultError $ NoPoliciesMatched [] + Right (Success (), Left (Just p)) -> Left $ ResultError $ DenyRuleMatched [] p + Right (Failure cs, Left Nothing) -> Left $ ResultError $ NoPoliciesMatched (NE.toList cs) + Right (Failure cs, Left (Just p)) -> Left $ ResultError $ DenyRuleMatched (NE.toList cs) p + Right (Failure cs, Right _) -> Left $ ResultError $ FailedChecks cs + Right (Success (), Right p) -> Right $ AuthorizationSuccess { matchedAllowQuery = p , allFacts , limits } @@ -195,8 +198,10 @@ runStep = do state@ComputeState{sLimits,sFacts,sRules,sBlockCount,sIterations} <- get let Limits{maxFacts, maxIterations} = sLimits previousCount = countFacts sFacts - newFacts = sFacts <> extend sLimits sBlockCount sRules sFacts - newCount = countFacts newFacts + generatedFacts :: Either PureExecError FactGroup + generatedFacts = first BadExpression $ extend sLimits sBlockCount sRules sFacts + newFacts <- (sFacts <>) <$> lift generatedFacts + let newCount = countFacts newFacts -- counting the facts returned by `extend` is not equivalent to -- comparing complete counts, as `extend` may return facts that -- are already present in `sFacts` @@ -206,7 +211,7 @@ runStep = do put $ state { sIterations = sIterations + 1 , sFacts = newFacts } - return addedFactsCount + pure addedFactsCount -- | Check if every variable from the head is present in the body checkRuleHead :: EvalRule -> Bool @@ -234,39 +239,39 @@ runFactGeneration sLimits sBlockCount sRules sFacts = let initState = ComputeState{sIterations = 0, ..} in computeAllFacts initState -checkChecks :: Limits -> Natural -> FactGroup -> [(Natural, [EvalCheck])] -> Validation (NonEmpty Check) () +checkChecks :: Limits -> Natural -> FactGroup -> [(Natural, [EvalCheck])] -> Either String (Validation (NonEmpty Check) ()) checkChecks limits blockCount allFacts = - traverse_ (uncurry $ checkChecksForGroup limits blockCount allFacts) + fmap (traverse_ id) . traverse (uncurry $ checkChecksForGroup limits blockCount allFacts) -checkChecksForGroup :: Limits -> Natural -> FactGroup -> Natural -> [EvalCheck] -> Validation (NonEmpty Check) () +checkChecksForGroup :: Limits -> Natural -> FactGroup -> Natural -> [EvalCheck] -> Either String (Validation (NonEmpty Check) ()) checkChecksForGroup limits blockCount allFacts checksBlockId = - traverse_ (checkCheck limits blockCount checksBlockId allFacts) + fmap (traverse_ id) . traverse (checkCheck limits blockCount checksBlockId allFacts) -checkPolicies :: Limits -> Natural -> FactGroup -> [EvalPolicy] -> Either (Maybe MatchedQuery) MatchedQuery -checkPolicies limits blockCount allFacts policies = - let results = mapMaybe (checkPolicy limits blockCount allFacts) policies - in case results of - p : _ -> first Just p - [] -> Left Nothing +checkPolicies :: Limits -> Natural -> FactGroup -> [EvalPolicy] -> Either String (Either (Maybe MatchedQuery) MatchedQuery) +checkPolicies limits blockCount allFacts policies = do + results <- mapMaybeM (checkPolicy limits blockCount allFacts) policies + pure $ case results of + p : _ -> first Just p + [] -> Left Nothing -- | Generate new facts by applying rules on existing facts -extend :: Limits -> Natural -> Map Natural (Set EvalRule) -> FactGroup -> FactGroup +extend :: Limits -> Natural -> Map Natural (Set EvalRule) -> FactGroup -> Either String FactGroup extend l blockCount rules facts = - let buildFacts :: Natural -> Set EvalRule -> FactGroup -> Set (Scoped Fact) + let buildFacts :: Natural -> Set EvalRule -> FactGroup -> Either String (Set (Scoped Fact)) buildFacts ruleBlockId ruleGroup factGroup = - let extendRule :: EvalRule -> Set (Scoped Fact) + let extendRule :: EvalRule -> Either String (Set (Scoped Fact)) extendRule r@Rule{scope} = getFactsForRule l (toScopedFacts $ keepAuthorized' False blockCount factGroup scope ruleBlockId) r - in foldMap extendRule ruleGroup + in foldMapM extendRule ruleGroup - extendRuleGroup :: Natural -> Set EvalRule -> FactGroup + extendRuleGroup :: Natural -> Set EvalRule -> Either String FactGroup extendRuleGroup ruleBlockId ruleGroup = -- todo pre-filter facts based on the weakest rule scope to avoid passing too many facts -- to buildFacts let authorizedFacts = facts -- test $ keepAuthorized facts $ Set.fromList [0..ruleBlockId] addRuleOrigin = FactGroup . Map.mapKeysWith (<>) (Set.insert ruleBlockId) . getFactGroup - in addRuleOrigin . fromScopedFacts $ buildFacts ruleBlockId ruleGroup authorizedFacts + in addRuleOrigin . fromScopedFacts <$> buildFacts ruleBlockId ruleGroup authorizedFacts - in foldMap (uncurry extendRuleGroup) $ Map.toList rules + in foldMapM (uncurry extendRuleGroup) $ Map.toList rules collectWorld :: Natural -> EvalBlock -> (Map Natural (Set EvalRule), FactGroup) @@ -278,18 +283,18 @@ collectWorld blockId Block{..} = , FactGroup $ Map.singleton (Set.singleton blockId) $ Set.fromList bFacts ) -queryGeneratedFacts :: [Maybe PublicKey] -> AuthorizationSuccess -> Query -> Set Bindings +queryGeneratedFacts :: [Maybe PublicKey] -> AuthorizationSuccess -> Query -> Either String (Set Bindings) queryGeneratedFacts ePks AuthorizationSuccess{allFacts, limits} = queryAvailableFacts ePks allFacts limits -queryAvailableFacts :: [Maybe PublicKey] -> FactGroup -> Limits -> Query -> Set Bindings +queryAvailableFacts :: [Maybe PublicKey] -> FactGroup -> Limits -> Query -> Either String (Set Bindings) queryAvailableFacts ePks allFacts limits q = let blockCount = genericLength ePks getBindingsForQueryItem QueryItem{qBody,qExpressions,qScope} = let facts = toScopedFacts $ keepAuthorized' True blockCount allFacts qScope blockCount - in Set.map snd $ + in Set.map snd <$> getBindingsForRuleBody limits facts qBody qExpressions - in foldMap (getBindingsForQueryItem . toEvaluation ePks) q + in foldMapM (getBindingsForQueryItem . toEvaluation ePks) q -- | Extract a set of values from a matched variable for a specific type. -- Returning @Set Value@ allows to get all values, whatever their type. diff --git a/biscuit/src/Auth/Biscuit/Token.hs b/biscuit/src/Auth/Biscuit/Token.hs index 2651f3f..a3149d1 100644 --- a/biscuit/src/Auth/Biscuit/Token.hs +++ b/biscuit/src/Auth/Biscuit/Token.hs @@ -215,7 +215,7 @@ data Biscuit proof check -- with a @trusting@ annotation. Be careful with @trusting previous@, as it queries -- facts from all blocks, even untrusted ones. queryRawBiscuitFactsWithLimits :: Biscuit openOrSealed check -> Limits -> Query - -> Set Bindings + -> Either String (Set Bindings) queryRawBiscuitFactsWithLimits b@Biscuit{authority,blocks} = let ePks = externalKeys b getBlock ((_, block), _, _, _) = block @@ -235,7 +235,7 @@ queryRawBiscuitFactsWithLimits b@Biscuit{authority,blocks} = -- 💁 If the facts you want to query are part of an allow query in the authorizer, -- you can directly get values by calling 'getBindings' on 'AuthorizationSuccess'. queryRawBiscuitFacts :: Biscuit openOrSealed check -> Query - -> Set Bindings + -> Either String (Set Bindings) queryRawBiscuitFacts b = queryRawBiscuitFactsWithLimits b defaultLimits -- | Turn a 'Biscuit' statically known to be 'Open' into a more generic 'OpenOrSealed' 'Biscuit' @@ -621,7 +621,7 @@ data AuthorizedBiscuit p -- 💁 If you are trying to extract facts from a biscuit in order to generate an -- authorizer, have a look at 'queryRawBiscuitFacts' instead. queryAuthorizerFacts :: AuthorizedBiscuit p -> Query - -> Set Bindings + -> Either String (Set Bindings) queryAuthorizerFacts AuthorizedBiscuit{authorizedBiscuit, authorizationSuccess} = let ePks = externalKeys authorizedBiscuit in queryGeneratedFacts ePks authorizationSuccess diff --git a/biscuit/src/Auth/Biscuit/Utils.hs b/biscuit/src/Auth/Biscuit/Utils.hs index a0b9bdc..9805eda 100644 --- a/biscuit/src/Auth/Biscuit/Utils.hs +++ b/biscuit/src/Auth/Biscuit/Utils.hs @@ -11,6 +11,11 @@ module Auth.Biscuit.Utils encodeHex, encodeHex', decodeHex, + anyM, + allM, + setFilterM, + foldMapM, + mapMaybeM, ) where @@ -20,6 +25,11 @@ import qualified Data.Base16.Types as Hex import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import Data.Text (Text) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Bool (bool) +import Data.Maybe (maybeToList) +import Data.Monoid (Any(..), All (..)) encodeHex :: ByteString -> Text #if MIN_VERSION_base16(1,0,0) @@ -51,3 +61,22 @@ maybeToRight b = maybe (Left b) Right -- but without the dependency footprint rightToMaybe :: Either b a -> Maybe a rightToMaybe = either (const Nothing) Just + +anyM :: (Foldable t, Monad m) => (a -> m Bool) -> t a -> m Bool +anyM f = fmap getAny . foldMapM (fmap Any . f) + +allM :: (Foldable t, Monad m) => (a -> m Bool) -> t a -> m Bool +allM f = fmap getAll . foldMapM (fmap All . f) + +setFilterM :: (Ord a, Monad m) => (a -> m Bool) -> Set a -> m (Set a) +setFilterM p = foldMapM (\a -> bool mempty (Set.singleton a) <$> p a) + +-- from Relude +foldMapM :: (Monoid b, Monad m, Foldable f) => (a -> m b) -> f a -> m b +foldMapM f xs = foldr step return xs mempty + where + step x r z = f x >>= \y -> r $! z `mappend` y +{-# INLINE foldMapM #-} + +mapMaybeM :: (Monad m) => (a -> m (Maybe b)) -> [a] -> m [b] +mapMaybeM f = foldMapM (fmap maybeToList . f) diff --git a/biscuit/test/Spec/ScopedExecutor.hs b/biscuit/test/Spec/ScopedExecutor.hs index e589046..a50d101 100644 --- a/biscuit/test/Spec/ScopedExecutor.hs +++ b/biscuit/test/Spec/ScopedExecutor.hs @@ -269,7 +269,7 @@ authorizerFactsAreQueried = testGroup "AuthorizedBiscuit can be queried" expected = Set.singleton $ Map.fromList [ ("user", LInteger 1234) ] - getUser <$> result @?= Right expected + getUser <$> result @?= Right (Right expected) , testCase "Attenuation blocks can be accessed if asked nicely" $ do (p,s) <- (toPublic &&& id) <$> newSecret b <- mkBiscuit s [block|user(1234);|] @@ -280,7 +280,7 @@ authorizerFactsAreQueried = testGroup "AuthorizedBiscuit can be queried" [ Map.fromList [("user", LInteger 1234)] , Map.fromList [("user", LString "tampered value")] ] - getUser <$> result @?= Right expected + getUser <$> result @?= Right (Right expected) , testCase "Signed blocks can be accessed if asked nicely" $ do (p,s) <- (toPublic &&& id) <$> newSecret (p1,s1) <- (toPublic &&& id) <$> newSecret @@ -293,7 +293,7 @@ authorizerFactsAreQueried = testGroup "AuthorizedBiscuit can be queried" [ Map.fromList [("user", LInteger 1234)] , Map.fromList [("user", LString "from signed")] ] - getUser <$> result @?= Right expected + getUser <$> result @?= Right (Right expected) ] biscuitFactsAreQueried :: TestTree @@ -306,7 +306,7 @@ biscuitFactsAreQueried = testGroup "Biscuit can be queried" expected = Set.singleton $ Map.fromList [ ("user", LInteger 1234) ] - user @?= expected + user @?= Right expected , testCase "Attenuation blocks can be accessed if asked nicely" $ do (p,s) <- (toPublic &&& id) <$> newSecret b <- mkBiscuit s [block|user(1234);|] @@ -316,7 +316,7 @@ biscuitFactsAreQueried = testGroup "Biscuit can be queried" [ Map.fromList [("user", LInteger 1234)] , Map.fromList [("user", LString "tampered value")] ] - user @?= expected + user @?= Right expected , testCase "Signed blocks can be accessed if asked nicely" $ do (p,s) <- (toPublic &&& id) <$> newSecret (p1,s1) <- (toPublic &&& id) <$> newSecret @@ -328,5 +328,5 @@ biscuitFactsAreQueried = testGroup "Biscuit can be queried" [ Map.fromList [("user", LInteger 1234)] , Map.fromList [("user", LString "from signed")] ] - user @?= expected + user @?= Right expected ]