3.3: reject if

biscuit/src/Auth/Biscuit/Datalog/AST.hs

@@ -90,6 +90,7 @@ module Auth.Biscuit.Datalog.AST
   , ruleHasNoScope
   , ruleHasNoV4Operators
   , isCheckOne
+  , isReject
   , renderBlock
   , renderAuthorizer
   , renderFact
@@ -453,7 +454,7 @@ makeQueryItem qBody qExpressions qScope =
         Just vs -> Failure vs
 
 
-data CheckKind = One | All
+data CheckKind = One | All | Reject
   deriving (Eq, Show, Ord, Lift)
 
 data Check' evalCtx ctx = Check
@@ -475,6 +476,9 @@ type EvalCheck = Check' 'Eval 'Representation
 isCheckOne :: Check' evalCtx ctx -> Bool
 isCheckOne Check{cKind} = cKind == One
 
+isReject :: Check' evalCtx ctx -> Bool
+isReject Check{cKind} = cKind == Reject
+
 data PolicyType = Allow | Deny
   deriving (Eq, Show, Ord, Lift)
 type Policy' evalCtx ctx = (PolicyType, Query' evalCtx ctx)
@@ -516,10 +520,11 @@ renderQueryItem QueryItem{..} =
 
 renderCheck :: Check -> Text
 renderCheck Check{..} =
-  let kindToken = case cKind of
-        One -> "if"
-        All -> "all"
-   in "check " <> kindToken <> " " <>
+  let keyword = case cKind of
+        One    -> "check if"
+        All    -> "check all"
+        Reject -> "reject if"
+   in keyword <> " " <>
       intercalate "\n or " (renderQueryItem <$> cQueries)
 
 listSymbolsInQueryItem :: QueryItem' evalCtx 'Representation -> Set.Set Text

biscuit/src/Auth/Biscuit/Datalog/Executor.hs

@@ -191,13 +191,25 @@ countFacts (FactGroup facts) = sum $ Set.size <$> Map.elems facts
 
 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
-  hasOkQueryItem <- anyM (fmap isJust . isQueryItemOk) cQueries
-  pure $ if hasOkQueryItem
-         then Success ()
-         else failure (toRepresentation c)
+  let queryMatchesOne = isQueryItemSatisfied l blockCount checkBlockId facts
+  let queryMatchesAll = isQueryItemSatisfiedForAllMatches l blockCount checkBlockId facts
+
+  case cKind of
+    One -> do
+       hasOkQueryItem <- anyM (fmap isJust . queryMatchesOne) cQueries
+       pure $ if hasOkQueryItem
+              then Success ()
+              else failure (toRepresentation c)
+    All -> do
+       hasOkQueryItem <- anyM (fmap isJust . queryMatchesAll) cQueries
+       pure $ if hasOkQueryItem
+              then Success ()
+              else failure (toRepresentation c)
+    Reject -> do
+       hasOkQueryItem <- anyM (fmap isJust . queryMatchesOne) cQueries
+       pure $ if not 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

biscuit/src/Auth/Biscuit/Datalog/Parser.hs

@@ -357,6 +357,7 @@ checkParser :: Bool -> Parser (Check' 'Repr 'WithSlices)
 checkParser inAuthorizer = do
   cKind <- l $ choice [ One <$ chunk "check if"
                       , All <$ chunk "check all"
+                      , Reject <$ chunk "reject if"
                       ]
   cQueries <- queryParser inAuthorizer
   pure Check{..}

biscuit/src/Auth/Biscuit/Proto.hs

@@ -137,6 +137,7 @@ data RuleV2 = RuleV2
 data CheckKind =
     One
   | All
+  | Reject
   deriving stock (Show, Enum, Bounded)
 
 data CheckV2 = CheckV2

biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs

@@ -132,7 +132,8 @@ pbToBlock ePk PB.Block{..} = do
     bRules <- traverse (pbToRule s) $ PB.getField rules_v2
     bChecks <- traverse (pbToCheck s) $ PB.getField checks_v2
     bScope <- Set.fromList <$> traverse (pbToScope s) (PB.getField scope)
-    let v5Plus = isJust ePk
+    let v6Plus = any isReject bChecks
+        v5Plus = isJust ePk
         v4Plus = not $ and
           [ Set.null bScope
           , all ruleHasNoScope bRules
@@ -141,18 +142,25 @@ pbToBlock ePk PB.Block{..} = do
           , all ruleHasNoV4Operators bRules
           , all (queryHasNoV4Operators . cQueries) bChecks
           ]
-    case (bVersion, v4Plus, v5Plus) of
-      (Just 5, _, _) -> pure Block {..}
-      (Just 4, _, False) -> pure Block {..}
-      (Just 4, _, True) ->
+    case (bVersion, v4Plus, v5Plus, v6Plus) of
+      (Just 6, _, _, _) -> pure Block {..}
+      (Just 5, _, _, True) ->
+        Left "Biscuit v6 features are present, but the block version is 5."
+      (Just 5, _, _, _) -> pure Block {..}
+      (Just 4, _, False, False) -> pure Block {..}
+      (Just 4, _, _, True) ->
+        Left "Biscuit v6 features are present, but the block version is 4."
+      (Just 4, _, True, False) ->
         Left "Biscuit v5 features are present, but the block version is 4."
-      (Just 3, False, False) -> pure Block {..}
-      (Just 3, True, False) ->
+      (Just 3, False, False, False) -> pure Block {..}
+      (Just 3, True, False, False) ->
         Left "Biscuit v4 features are present, but the block version is 3."
-      (Just 3, _, True) ->
+      (Just 3, _, True, False) ->
         Left "Biscuit v5 features are present, but the block version is 3."
+      (Just 3, _, _, True) ->
+        Left "Biscuit v6 features are present, but the block version is 3."
       _ ->
-        Left $ "Unsupported biscuit version: " <> maybe "0" show bVersion <> ". Only versions 3 and 4 are supported"
+        Left $ "Unsupported biscuit version: " <> maybe "0" show bVersion <> ". Only versions 3 to 6 are supported"
 
 -- | Turn a biscuit block into a protobuf block, for serialization,
 -- along with the newly defined symbols
@@ -227,9 +235,10 @@ pbToCheck s PB.CheckV2{queries,kind} = do
   rules <- traverse (pbToRule s) $ PB.getField queries
   let cQueries = toCheck <$> rules
   let cKind = case PB.getField kind of
-        Just PB.All -> All
-        Just PB.One -> One
-        Nothing     -> One
+        Just PB.All    -> All
+        Just PB.One    -> One
+        Just PB.Reject -> Reject
+        Nothing        -> One
   pure Check{..}
 
 checkToPb :: ReverseSymbols -> Check -> PB.CheckV2
@@ -242,8 +251,9 @@ checkToPb s Check{..} =
                           , scope = qScope
                           }
       pbKind = case cKind of
-        One -> Nothing
-        All -> Just PB.All
+        One    -> Nothing
+        All    -> Just PB.All
+        Reject -> Just PB.Reject
    in PB.CheckV2 { queries = PB.putField $ toQuery <$> cQueries
                  , kind = PB.putField pbKind
                  }

biscuit/test/Spec/Parser.hs

@@ -414,6 +414,12 @@ checkParsing = testGroup "check blocks"
           { cQueries = [QueryItem [] [EValue $ LBool True] []]
           , cKind = All
           }
+  , testCase "Simple reject if" $
+      parseCheck "reject if true" @?=
+        Right Check
+          { cQueries = [QueryItem [] [EValue $ LBool True] []]
+          , cKind = Reject
+          }
   , testCase "Multiple groups" $
       parseCheck
         "check if fact($var), $var === true or \
@@ -444,6 +450,21 @@ checkParsing = testGroup "check blocks"
                 ]
             , cKind = All
             }
+  , testCase "Multiple reject if groups" $
+      parseCheck
+        "reject if fact($var), $var === true or \
+        \other($var), $var === 2" @?=
+          Right Check
+            { cQueries =
+                [ QueryItem [Predicate "fact" [Variable "var"]]
+                            [EBinary Equal (EValue (Variable "var")) (EValue (LBool True))]
+                            []
+                , QueryItem [Predicate "other" [Variable "var"]]
+                            [EBinary Equal (EValue (Variable "var")) (EValue (LInteger 2))]
+                            []
+                ]
+            , cKind = Reject
+            }
   , testCase "Multiple groups, scoped" $
       parseCheck
         "check if fact($var), $var === true trusting previous or \

biscuit/test/Spec/SampleReader.hs

@@ -227,7 +227,7 @@ processTestCase step rootPk TestCase{..} =
   if fst filename == "test018_unbound_variables_in_rule.bc"
   then
     step "Skipping for now (unbound variables are now caught before evaluation)"
-  else if fst filename `elem` ["test029_reject_if.bc", "test030_null.bc", "test031_heterogeneous_equal.bc", "test032_laziness_closures.bc", "test033_typeof.bc", "test034_array_map.bc", "test035_ffi.bc", "test036_secp256r1.bc"]
+  else if fst filename `elem` ["test030_null.bc", "test031_heterogeneous_equal.bc", "test032_laziness_closures.bc", "test033_typeof.bc", "test034_array_map.bc", "test035_ffi.bc", "test036_secp256r1.bc"]
   then
     step "Skipping for now (not supported yet)"
   else do