biscuit-haskell 0.3.0.0 → 0.3.0.1

raw patch · 16 files changed

+229/−58 lines, 16 filesdep ~base16dep ~megaparsecdep ~mtlbinary-addedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base16, megaparsec, mtl, template-haskell, validation-selective

API changes (from Hackage documentation)

Files

• biscuit-haskell.cabal +8/−8
• src/Auth/Biscuit.hs +4/−4
• src/Auth/Biscuit/Datalog/AST.hs +10/−6
• src/Auth/Biscuit/Datalog/Executor.hs +27/−7
• src/Auth/Biscuit/Datalog/Parser.hs +25/−14
• src/Auth/Biscuit/Datalog/ScopedExecutor.hs +2/−2
• src/Auth/Biscuit/Proto.hs +1/−0
• src/Auth/Biscuit/ProtoBufAdapter.hs +2/−1
• src/Auth/Biscuit/Token.hs +1/−2
• src/Auth/Biscuit/Utils.hs +42/−9
• test/Spec/Executor.hs +2/−0
• test/Spec/Parser.hs +25/−0
• test/Spec/SampleReader.hs +5/−3
• test/samples/current/samples.json +75/−2
• test/samples/current/test017_expressions.bc binary
• test/samples/current/test027_integer_wraparound.bc binary

@@ -1,7 +1,7 @@ cabal-version: 2.0  name:           biscuit-haskell-version:        0.3.0.0+version:        0.3.0.1 category:       Security synopsis:       Library support for the Biscuit security token description:    Please see the README on GitHub at <https://github.com/biscuit-auth/biscuit-haskell#readme>@@ -13,7 +13,7 @@ license:        BSD3 license-file:   LICENSE build-type:     Simple-tested-with:    GHC ==8.10.7 || == 9.0.2 || ==9.2.4+tested-with:    GHC ==9.0.2 || ==9.2.4 || ==9.6.5 || ==9.8.2 extra-source-files:     README.md     ChangeLog.md@@ -49,24 +49,24 @@   build-depends:     base                 >= 4.7 && <5,     async                ^>= 2.2,-    base16               ^>= 0.3,+    base16               >= 0.3 && <2.0,     bytestring           >= 0.10 && <0.12,     text                 >= 1.2 && <3,     containers           ^>= 0.6,     cryptonite           >= 0.27 && < 0.31,     memory               >= 0.15 && < 0.19,-    template-haskell     >= 2.16 && < 2.19,+    template-haskell     >= 2.16 && < 2.22,     base64               ^>= 0.4,     cereal               ^>= 0.5,-    mtl                  ^>= 2.2,+    mtl                  >= 2.2 && < 2.4,     parser-combinators   >= 1.2 && < 1.4,     protobuf             ^>= 0.2,     random               >= 1.0 && < 1.3,     regex-tdfa           ^>= 1.3,     th-lift-instances    ^>= 0.1,     time                 ^>= 1.9,-    validation-selective ^>= 0.1,-    megaparsec           ^>= 9.2+    validation-selective >= 0.1 && < 0.3,+    megaparsec           >= 9.2 && < 9.7   default-language: Haskell2010  test-suite biscuit-haskell-test@@ -89,7 +89,7 @@       async     , aeson     , base >=4.7 && <5-    , base16 ^>=0.3+    , base16 >=0.3 && <2.0     , base64     , biscuit-haskell     , bytestring

@@ -108,7 +108,6 @@ import           Control.Monad.Identity              (runIdentity) import           Data.Bifunctor                      (first) import           Data.ByteString                     (ByteString)-import qualified Data.ByteString.Base16              as Hex import qualified Data.ByteString.Base64.URL          as B64 import           Data.Foldable                       (toList) import           Data.Set                            (Set)@@ -159,6 +158,7 @@                                                       queryAuthorizerFacts,                                                       queryRawBiscuitFacts,                                                       seal, serializeBiscuit)+import Auth.Biscuit.Utils                            (decodeHex, encodeHex') import qualified Data.Text                           as Text  @@ -249,7 +249,7 @@  -- | Decode a base16-encoded bytestring, reporting errors via `MonadFail` fromHex :: MonadFail m => ByteString -> m ByteString-fromHex = either (fail . Text.unpack) pure . Hex.decodeBase16+fromHex = either (fail . Text.unpack) pure . decodeHex  -- $keypairs --@@ -273,11 +273,11 @@  -- | Serialize a 'SecretKey' to a hex-encoded bytestring serializeSecretKeyHex :: SecretKey -> ByteString-serializeSecretKeyHex = Hex.encodeBase16' . skBytes+serializeSecretKeyHex = encodeHex' . skBytes  -- | Serialize a 'PublicKey' to a hex-encoded bytestring serializePublicKeyHex :: PublicKey -> ByteString-serializePublicKeyHex = Hex.encodeBase16' . pkBytes+serializePublicKeyHex = encodeHex' . pkBytes  -- | Read a 'SecretKey' from raw bytes parseSecretKey :: ByteString -> Maybe SecretKey

@@ -112,9 +112,9 @@ import           Control.Applicative        ((<|>)) import           Control.Monad              ((<=<)) import           Data.ByteString            (ByteString)-import           Data.ByteString.Base16     as Hex import           Data.Foldable              (fold, toList) import           Data.Function              (on)+import           Data.Int                   (Int64) import           Data.List.NonEmpty         (NonEmpty, nonEmpty) import           Data.Map.Strict            (Map) import qualified Data.Map.Strict            as Map@@ -133,6 +133,7 @@ import           Validation                 (Validation (..), failure)  import           Auth.Biscuit.Crypto        (PublicKey, pkBytes)+import           Auth.Biscuit.Utils         (encodeHex)  data IsWithinSet = NotWithinSet | WithinSet data DatalogContext@@ -197,7 +198,7 @@ data Term' (inSet :: IsWithinSet) (pof :: PredicateOrFact) (ctx :: DatalogContext) =     Variable (VariableType inSet pof)   -- ^ A variable (eg. @$0@)-  | LInteger Int+  | LInteger Int64   -- ^ An integer literal (eg. @42@)   | LString Text   -- ^ A string literal (eg. @"file1"@)@@ -267,10 +268,10 @@   fromValue :: Value -> Maybe t  instance ToTerm Int inSet pof where-  toTerm = LInteger+  toTerm = LInteger . fromIntegral  instance FromValue Int where-  fromValue (LInteger v) = Just v+  fromValue (LInteger v) = Just $ fromIntegral v   fromValue _            = Nothing  instance ToTerm Integer inSet pof where@@ -346,7 +347,7 @@   LInteger int  -> pack $ show int   LString str   -> pack $ show str   LDate time    -> pack $ formatTime defaultTimeLocale "%FT%T%Q%Ez" time-  LBytes bs     -> "hex:" <> Hex.encodeBase16 bs+  LBytes bs     -> "hex:" <> encodeHex bs   LBool True    -> "true"   LBool False   -> "false"   TermSet terms -> set terms@@ -595,6 +596,7 @@   EBinary BitwiseAnd _ _ -> False   EBinary BitwiseOr _ _  -> False   EBinary BitwiseXor _ _ -> False+  EBinary NotEqual   _ _ -> False   EBinary _ l r -> expressionHasNoV4Operators l && expressionHasNoV4Operators r   _ -> True @@ -677,6 +679,7 @@   | BitwiseAnd   | BitwiseOr   | BitwiseXor+  | NotEqual   deriving (Eq, Ord, Show, Lift)  data Expression' (ctx :: DatalogContext) =@@ -758,6 +761,7 @@         EBinary BitwiseAnd e e'     -> rOp "&" e e'         EBinary BitwiseOr e e'      -> rOp "|" e e'         EBinary BitwiseXor e e'     -> rOp "^" e e'+        EBinary NotEqual e e'       -> rOp "!=" e e'  -- | A biscuit block, containing facts, rules and checks. --@@ -820,7 +824,7 @@   let renderScopeElem = \case         OnlyAuthority -> "authority"         Previous      -> "previous"-        BlockId bs    -> "ed25519/" <> Hex.encodeBase16 (pkBytes bs)+        BlockId bs    -> "ed25519/" <> encodeHex (pkBytes bs)    in intercalate ", " . Set.toList . Set.map renderScopeElem  renderBlock :: Block -> Text

@@ -6,6 +6,7 @@ {-# LANGUAGE NamedFieldPuns             #-} {-# LANGUAGE OverloadedStrings          #-} {-# LANGUAGE TupleSections              #-}+{-# LANGUAGE TypeApplications           #-} {-|   Module      : Auth.Biscuit.Datalog.Executor   Copyright   : © Clément Delafargue, 2021@@ -42,6 +43,7 @@ import qualified Data.ByteString          as ByteString import           Data.Foldable            (fold) import           Data.Functor.Compose     (Compose (..))+import           Data.Int                 (Int64) import           Data.List.NonEmpty       (NonEmpty) import qualified Data.List.NonEmpty       as NE import           Data.Map.Strict          (Map, (!?))@@ -370,9 +372,9 @@ evalUnary Parens t = pure t evalUnary Negate (LBool b) = pure (LBool $ not b) evalUnary Negate _ = Left "Only booleans support negation"-evalUnary Length (LString t) = pure . LInteger $ Text.length t-evalUnary Length (LBytes bs) = pure . LInteger $ ByteString.length bs-evalUnary Length (TermSet s) = pure . LInteger $ Set.size s+evalUnary Length (LString t) = pure . LInteger . fromIntegral $ Text.length t+evalUnary Length (LBytes bs) = pure . LInteger . fromIntegral $ ByteString.length bs+evalUnary Length (TermSet s) = pure . LInteger . fromIntegral $ Set.size s evalUnary Length _ = Left "Only strings, bytes and sets support `.length()`"  evalBinary :: Limits -> Binary -> Value -> Value -> Either String Value@@ -384,6 +386,13 @@ evalBinary _ Equal (LBool t) (LBool t')       = pure $ LBool (t == t') evalBinary _ Equal (TermSet t) (TermSet t')   = pure $ LBool (t == t') evalBinary _ Equal _ _                        = Left "Equality mismatch"+evalBinary _ NotEqual (LInteger i) (LInteger i') = pure $ LBool (i /= i')+evalBinary _ NotEqual (LString t) (LString t')   = pure $ LBool (t /= t')+evalBinary _ NotEqual (LDate t) (LDate t')       = pure $ LBool (t /= t')+evalBinary _ NotEqual (LBytes t) (LBytes t')     = pure $ LBool (t /= t')+evalBinary _ NotEqual (LBool t) (LBool t')       = pure $ LBool (t /= t')+evalBinary _ NotEqual (TermSet t) (TermSet t')   = pure $ LBool (t /= t')+evalBinary _ NotEqual _ _                        = Left "Inequity mismatch" evalBinary _ LessThan (LInteger i) (LInteger i') = pure $ LBool (i < i') evalBinary _ LessThan (LDate t) (LDate t')       = pure $ LBool (t < t') evalBinary _ LessThan _ _                        = Left "< mismatch"@@ -405,15 +414,15 @@                                                                | otherwise    = Left "Regex evaluation is disabled" evalBinary _ Regex _ _                       = Left "Only strings support `.matches()`" -- num operations-evalBinary _ Add (LInteger i) (LInteger i') = pure $ LInteger (i + i')+evalBinary _ Add (LInteger i) (LInteger i') = LInteger <$> checkedOp (+) i i' evalBinary _ Add (LString t) (LString t') = pure $ LString (t <> t') evalBinary _ Add _ _ = Left "Only integers and strings support addition"-evalBinary _ Sub (LInteger i) (LInteger i') = pure $ LInteger (i - i')+evalBinary _ Sub (LInteger i) (LInteger i') = LInteger <$> checkedOp (-) i i' evalBinary _ Sub _ _ = Left "Only integers support subtraction"-evalBinary _ Mul (LInteger i) (LInteger i') = pure $ LInteger (i * i')+evalBinary _ Mul (LInteger i) (LInteger i') = LInteger <$> checkedOp (*) i i' evalBinary _ Mul _ _ = Left "Only integers support multiplication" evalBinary _ Div (LInteger _) (LInteger 0) = Left "Divide by 0"-evalBinary _ Div (LInteger i) (LInteger i') = pure $ LInteger (i `div` i')+evalBinary _ Div (LInteger i) (LInteger i') = LInteger <$> checkedOp div i i' evalBinary _ Div _ _ = Left "Only integers support division" -- bitwise operations evalBinary _ BitwiseAnd (LInteger i) (LInteger i') = pure $ LInteger (i .&. i')@@ -438,6 +447,17 @@ evalBinary _ Intersection _ _ = Left "Only sets support `.intersection()`" evalBinary _ Union (TermSet t) (TermSet t') = pure $ TermSet (Set.union t t') evalBinary _ Union _ _ = Left "Only sets support `.union()`"++checkedOp :: (Integer -> Integer -> Integer)+          -> Int64 -> Int64+          -> Either String Int64+checkedOp f a b =+  let result = f (fromIntegral a) (fromIntegral b)+   in if result < fromIntegral (minBound @Int64)+      then Left "integer underflow"+      else if result > fromIntegral (maxBound @Int64)+      then Left "integer overflow"+      else Right (fromIntegral result)  regexMatch :: Text -> Text -> Either String Value regexMatch text regexT = do

@@ -15,14 +15,16 @@ import           Auth.Biscuit.Crypto            (PublicKey,                                                  readEd25519PublicKey) import           Auth.Biscuit.Datalog.AST+import           Auth.Biscuit.Utils             (decodeHex) import           Control.Monad                  (join) import qualified Control.Monad.Combinators.Expr as Expr import           Data.Bifunctor import           Data.ByteString                (ByteString)-import           Data.ByteString.Base16         as Hex import qualified Data.ByteString.Char8          as C8 import           Data.Char import           Data.Either                    (partitionEithers)+import           Data.Function                  ((&))+import           Data.Int                       (Int64) import           Data.List.NonEmpty             (NonEmpty) import qualified Data.List.NonEmpty             as NE import           Data.Map.Strict                (Map)@@ -128,7 +130,7 @@   , TermSet <$> parseSet <?> "set (eg. [1,2,3])"   , LBytes <$> (chunk "hex:" *> hexParser) <?> "hex-encoded bytestring (eg. hex:00ff99)"   , LDate <$> rfc3339DateParser <?> "RFC3339-formatted timestamp (eg. 2022-11-29T00:00:00Z)"-  , LInteger <$> L.signed C.space L.decimal <?> "(signed) integer"+  , LInteger <$> intParser <?> "(signed) integer"   , LString . T.pack <$> (C.char '"' *> manyTill L.charLiteral (C.char '"')) <?> "string literal"   , LBool <$> choice [ True <$ chunk "true"                      , False <$ chunk "false"@@ -136,17 +138,25 @@           <?> "boolean value (eg. true or false)"   ] +intParser :: Parser Int64+intParser = do+  integer :: Integer <- L.signed C.space L.decimal <?> "(signed) integer"+  if integer < fromIntegral (minBound @Int64)+     || integer > fromIntegral (maxBound @Int64)+  then fail "integer literals must fit in the int64 range"+  else pure $ fromIntegral integer+ hexParser :: Parser ByteString hexParser = do   (sp, hexStr) <- getSpan $ C8.pack <$> some C.hexDigitChar-  case Hex.decodeBase16 hexStr of+  case decodeHex hexStr of     Left e   -> registerError (InvalidBs e) sp     Right bs -> pure bs  publicKeyParser :: Parser PublicKey publicKeyParser = do   (sp, hexStr) <- getSpan $ C8.pack <$> (chunk "ed25519/" *> some C.hexDigitChar)-  case Hex.decodeBase16 hexStr of+  case decodeHex hexStr of     Left e -> registerError (InvalidPublicKey e) sp     Right bs -> case readEd25519PublicKey bs of       Nothing -> registerError (InvalidPublicKey "Invalid ed25519 public key") sp@@ -218,8 +228,7 @@  expressionParser :: Parser (Expression' 'WithSlices) expressionParser =-  let base = choice [ try binaryMethodParser-                    , try unaryMethodParser+  let base = choice [ try methodsParser                     , exprTerm                     ]    in Expr.makeExprParser base table@@ -246,14 +255,14 @@         , infixN  "<"  LessThan         , infixN  ">"  GreaterThan         , infixN  "==" Equal+        , infixN  "!=" NotEqual         ]       , [ infixL "&&" And ]       , [ infixL "||" Or ]       ] -binaryMethodParser :: Parser (Expression' 'WithSlices)+binaryMethodParser :: Parser (Expression' 'WithSlices -> Expression' 'WithSlices) binaryMethodParser = do-  e1 <- exprTerm   _ <- C.char '.'   method <- choice     [ Contains     <$ chunk "contains"@@ -266,18 +275,20 @@   _ <- l $ C.char '('   e2 <- l expressionParser   _ <- l $ C.char ')'-  pure $ EBinary method e1 e2+  pure $ \e1 -> EBinary method e1 e2 -unaryMethodParser :: Parser (Expression' 'WithSlices)+unaryMethodParser :: Parser (Expression' 'WithSlices -> Expression' 'WithSlices) unaryMethodParser = do-  e1 <- exprTerm   _ <- C.char '.'   method <- Length <$ chunk "length"   _ <- l $ chunk "()"-  pure $ EUnary method e1+  pure $ EUnary method -methodParser :: Parser (Expression' 'WithSlices)-methodParser = binaryMethodParser <|> unaryMethodParser+methodsParser :: Parser (Expression' 'WithSlices)+methodsParser = do+  e1 <- exprTerm+  methods <- some (try binaryMethodParser <|> unaryMethodParser)+  pure $ foldl (&) e1 methods  unaryParens :: Parser (Expression' 'WithSlices) unaryParens = do

@@ -30,7 +30,7 @@                                                 gets, lift, put) import           Data.Bifunctor                (first) import           Data.ByteString               (ByteString)-import           Data.Foldable                 (fold, traverse_)+import           Data.Foldable                 (traverse_) import           Data.List                     (genericLength) import           Data.List.NonEmpty            (NonEmpty) import qualified Data.List.NonEmpty            as NE@@ -146,7 +146,7 @@       firstBlock = fst' authority       otherBlocks = fst' <$> blocks       allBlocks = zip [0..] (firstBlock : otherBlocks) <> [(sBlockCount, vBlock authorizer)]-      (sRules, sFacts) = revocationWorld <> fold (uncurry collectWorld . fmap (toEvaluation externalKeys) <$> allBlocks)+      (sRules, sFacts) = revocationWorld <> foldMap (uncurry collectWorld . fmap (toEvaluation externalKeys)) allBlocks    in ComputeState         { sLimits = limits         , sRules

@@ -208,6 +208,7 @@   | BitwiseAnd   | BitwiseOr   | BitwiseXor+  | NotEqual   deriving stock (Show, Enum, Bounded)  newtype OpBinary = OpBinary

@@ -389,6 +389,7 @@   PB.BitwiseAnd     -> BitwiseAnd   PB.BitwiseOr      -> BitwiseOr   PB.BitwiseXor     -> BitwiseXor+  PB.NotEqual       -> NotEqual  binaryToPb :: Binary -> PB.OpBinary binaryToPb = PB.OpBinary . PB.putField . \case@@ -412,7 +413,7 @@   BitwiseAnd     -> PB.BitwiseAnd   BitwiseOr      -> PB.BitwiseOr   BitwiseXor     -> PB.BitwiseXor-+  NotEqual       -> PB.NotEqual  pbToThirdPartyBlockRequest :: PB.ThirdPartyBlockRequest -> Either String (Crypto.PublicKey, [Crypto.PublicKey]) pbToThirdPartyBlockRequest PB.ThirdPartyBlockRequest{previousPk, pkTable} = do

@@ -66,7 +66,6 @@ import           Data.Bifunctor                      (first) import           Data.ByteString                     (ByteString) import qualified Data.ByteString.Base64.URL          as B64-import           Data.Foldable                       (fold) import           Data.List.NonEmpty                  (NonEmpty ((:|))) import qualified Data.List.NonEmpty                  as NE import           Data.Set                            (Set)@@ -221,7 +220,7 @@   let ePks = externalKeys b       getBlock ((_, block), _, _, _) = block       allBlocks = zip [0..] $ getBlock <$> authority : blocks-      (_, sFacts) = fold (uncurry collectWorld . fmap (toEvaluation ePks) <$> allBlocks)+      (_, sFacts) = foldMap (uncurry collectWorld . fmap (toEvaluation ePks)) allBlocks    in queryAvailableFacts ePks sFacts  -- | Query the facts generated by the authority and authorizer blocks

@@ -1,13 +1,46 @@-{-|-  Module      : Auth.Biscuit.Utils-  Copyright   : © Clément Delafargue, 2021-  License     : MIT-  Maintainer  : clement@delafargue.name--}+{-# LANGUAGE CPP #-}++-- |+--  Module      : Auth.Biscuit.Utils+--  Copyright   : © Clément Delafargue, 2021+--  License     : MIT+--  Maintainer  : clement@delafargue.name module Auth.Biscuit.Utils-  ( maybeToRight-  , rightToMaybe-  ) where+  ( maybeToRight,+    rightToMaybe,+    encodeHex,+    encodeHex',+    decodeHex,+  )+where++#if MIN_VERSION_base16(1,0,0)+import qualified Data.Base16.Types as Hex+#endif+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base16 as Hex+import Data.Text (Text)++encodeHex :: ByteString -> Text+#if MIN_VERSION_base16(1,0,0)+encodeHex = Hex.extractBase16 . Hex.encodeBase16+#else+encodeHex = Hex.encodeBase16+#endif++encodeHex' :: ByteString -> ByteString+#if MIN_VERSION_base16(1,0,0)+encodeHex' = Hex.extractBase16 . Hex.encodeBase16'+#else+encodeHex' = Hex.encodeBase16'+#endif++decodeHex :: ByteString -> Either Text ByteString+#if MIN_VERSION_base16(1,0,0)+decodeHex = Hex.decodeBase16Untyped+#else+decodeHex = Hex.decodeBase16+#endif  -- | Exactly like `maybeToRight` from the `either` package, -- but without the dependency footprint

@@ -178,6 +178,8 @@   testGroup "Expressions evaluation (expected errors)" $ evalFail <$>     [ ("1 / 0", "Divide by 0")     , ("\"toto\".matches(\"to\")", "Regex evaluation is disabled")+    , ("9223372036854775807 + 1", "integer overflow")+    , ("-9223372036854775808 - 1", "integer underflow")     ]  rulesWithConstraints :: TestTree

@@ -89,6 +89,8 @@   [ testCase "String" $ parseTerm "\"file1 a hello - 123_\"" @?= Right (LString "file1 a hello - 123_")   , testCase "Positive integer" $ parseTerm "123" @?= Right (LInteger 123)   , testCase "Negative integer" $ parseTerm "-42" @?= Right (LInteger (-42))+  , testCase "Positive integer (too large)" $ isLeft (parseTerm "9223372036854775808") @? "Integer literals must fit in the int64 range"+  , testCase "Negative integer (too small)" $ isLeft (parseTerm "-9223372036854775809") @? "Integer literals must fit in the int64 range"   , testCase "Date" $ parseTerm "2019-12-02T13:49:53Z" @?=         Right (LDate $ read "2019-12-02 13:49:53 UTC")   , testCase "Variable" $ parseTerm "$1" @?= Right (Variable "1")@@ -210,6 +212,12 @@                  (EValue (Variable "0"))                  (EValue (LInteger 1))                  )+  , testCase "int comparison (NEQ)" $+      parseExpression "$0 != 1" @?=+        Right (EBinary NotEqual+                 (EValue (Variable "0"))+                 (EValue (LInteger 1))+                 )   , testCase "negative int comparison (GTE)" $       parseExpression "$0 >= -1234" @?=         Right (EBinary GreaterOrEqual@@ -222,6 +230,12 @@                  (EValue (Variable "0"))                  (EValue (LString "abc"))                  )+  , testCase "string comparison (NEQ)" $+      parseExpression "$0 != \"abc\"" @?=+        Right (EBinary NotEqual+                 (EValue (Variable "0"))+                 (EValue (LString "abc"))+                 )   , testCase "string comparison (starts_with)" $       parseExpression "$0.starts_with(\"abc\")" @?=         Right (EBinary Prefix@@ -277,6 +291,17 @@                     (EValue $ LInteger 10)                  )                  (EValue $ LInteger 2000)+              )+  , testCase "chained method calls" $+      parseExpression "$var.intersection([1]).union([2]).length()" @?=+        Right (EUnary Length+                 (EBinary Union+                    ( EBinary Intersection+                        (EValue $ Variable "var")+                        (EValue $ TermSet [LInteger 1])+                    )+                    (EValue $ TermSet [LInteger 2])+                 )               )   , operatorPrecedences   ]

@@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds          #-} {-# LANGUAGE DeriveAnyClass     #-}+{-# LANGUAGE DeriveFunctor      #-} {-# LANGUAGE DeriveGeneric      #-} {-# LANGUAGE DeriveTraversable  #-} {-# LANGUAGE DerivingStrategies #-}@@ -40,6 +41,7 @@                                                 ResultError (..)) import           Auth.Biscuit.Datalog.Parser   (authorizerParser, blockParser) import           Auth.Biscuit.Token+import           Auth.Biscuit.Utils            (encodeHex)  import           Spec.Parser                   (parseAuthorizer, parseBlock) @@ -93,7 +95,7 @@ data RustResult e a   = Err e   | Ok a-  deriving stock (Generic, Eq, Show)+  deriving stock (Generic, Eq, Show, Functor)  instance Bifunctor RustResult where   bimap f g = \case@@ -268,7 +270,7 @@   pols <- either (assertFailure . show) pure $ parseAuthorizer $ foldMap (<> ";") (policies w)   res <- authorizeBiscuit b (authorizer_code <> pols)   checkResult compareExecErrors result res-  let revocationIds = Hex.encodeBase16 <$> toList (getRevocationIds b)+  let revocationIds = encodeHex <$> toList (getRevocationIds b)   step "Comparing revocation ids"   revocation_ids @?= revocationIds @@ -313,7 +315,7 @@              }           , result = Ok 0           , authorizer_code = authorizer-          , revocation_ids = Hex.encodeBase16 <$> toList (getRevocationIds biscuit)+          , revocation_ids = encodeHex <$> toList (getRevocationIds biscuit)           }   BS.writeFile ("test/samples/current/" <> filename) (serialize biscuit)   let token = mkBlockDesc <$> getAuthority biscuit :| getBlocks biscuit

@@ -979,12 +979,13 @@             "b",             "de",             "abcD12",+            "abcD12x",             "abc",             "def"           ],           "public_keys": [],           "external_key": null,-          "code": "check if true;\ncheck if !false;\ncheck if !false && true;\ncheck if false or true;\ncheck if (true || false) && true;\ncheck if 1 < 2;\ncheck if 2 > 1;\ncheck if 1 <= 2;\ncheck if 1 <= 1;\ncheck if 2 >= 1;\ncheck if 2 >= 2;\ncheck if 3 == 3;\ncheck if 1 + 2 * 3 - 4 / 2 == 5;\ncheck if 1 | 2 ^ 3 == 0;\ncheck if \"hello world\".starts_with(\"hello\") && \"hello world\".ends_with(\"world\");\ncheck if \"aaabde\".matches(\"a*c?.e\");\ncheck if \"aaabde\".contains(\"abd\");\ncheck if \"aaabde\" == \"aaa\" + \"b\" + \"de\";\ncheck if \"abcD12\" == \"abcD12\";\ncheck if 2019-12-04T09:46:41Z < 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z > 2019-12-04T09:46:41Z;\ncheck if 2019-12-04T09:46:41Z <= 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z >= 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z >= 2019-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z >= 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z == 2020-12-04T09:46:41Z;\ncheck if hex:12ab == hex:12ab;\ncheck if [1, 2].contains(2);\ncheck if [2019-12-04T09:46:41Z, 2020-12-04T09:46:41Z].contains(2020-12-04T09:46:41Z);\ncheck if [false, true].contains(true);\ncheck if [\"abc\", \"def\"].contains(\"abc\");\ncheck if [hex:12ab, hex:34de].contains(hex:34de);\n"+          "code": "check if true;\ncheck if !false;\ncheck if !false && true;\ncheck if false or true;\ncheck if (true || false) && true;\ncheck if 1 < 2;\ncheck if 2 > 1;\ncheck if 1 <= 2;\ncheck if 1 <= 1;\ncheck if 2 >= 1;\ncheck if 2 >= 2;\ncheck if 3 == 3;\ncheck if 1 != 3;\ncheck if 1 + 2 * 3 - 4 / 2 == 5;\ncheck if 1 | 2 ^ 3 == 0;\ncheck if \"hello world\".starts_with(\"hello\") && \"hello world\".ends_with(\"world\");\ncheck if \"aaabde\".matches(\"a*c?.e\");\ncheck if \"aaabde\".contains(\"abd\");\ncheck if \"aaabde\" == \"aaa\" + \"b\" + \"de\";\ncheck if \"abcD12\" == \"abcD12\";\ncheck if \"abcD12x\" != \"abcD12\";\ncheck if 2019-12-04T09:46:41Z < 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z > 2019-12-04T09:46:41Z;\ncheck if 2019-12-04T09:46:41Z <= 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z >= 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z >= 2019-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z >= 2020-12-04T09:46:41Z;\ncheck if 2020-12-04T09:46:41Z == 2020-12-04T09:46:41Z;\ncheck if 2022-12-04T09:46:41Z != 2020-12-04T09:46:41Z;\ncheck if hex:12ab == hex:12ab;\ncheck if hex:12abcd != hex:12ab;\ncheck if [1, 2].contains(2);\ncheck if [2019-12-04T09:46:41Z, 2020-12-04T09:46:41Z].contains(2020-12-04T09:46:41Z);\ncheck if [false, true].contains(true);\ncheck if [\"abc\", \"def\"].contains(\"abc\");\ncheck if [hex:12ab, hex:34de].contains(hex:34de);\ncheck if [1, 2] == [1, 2];\ncheck if [1, 4] != [1, 2];\n"         }       ],       "validations": {@@ -999,8 +1000,10 @@               "check if \"aaabde\".contains(\"abd\")",               "check if \"aaabde\".matches(\"a*c?.e\")",               "check if \"abcD12\" == \"abcD12\"",+              "check if \"abcD12x\" != \"abcD12\"",               "check if \"hello world\".starts_with(\"hello\") && \"hello world\".ends_with(\"world\")",               "check if (true || false) && true",+              "check if 1 != 3",               "check if 1 + 2 * 3 - 4 / 2 == 5",               "check if 1 < 2",               "check if 1 <= 1",@@ -1015,14 +1018,18 @@               "check if 2020-12-04T09:46:41Z > 2019-12-04T09:46:41Z",               "check if 2020-12-04T09:46:41Z >= 2019-12-04T09:46:41Z",               "check if 2020-12-04T09:46:41Z >= 2020-12-04T09:46:41Z",+              "check if 2022-12-04T09:46:41Z != 2020-12-04T09:46:41Z",               "check if 3 == 3",               "check if [\"abc\", \"def\"].contains(\"abc\")",+              "check if [1, 2] == [1, 2]",               "check if [1, 2].contains(2)",+              "check if [1, 4] != [1, 2]",               "check if [2019-12-04T09:46:41Z, 2020-12-04T09:46:41Z].contains(2020-12-04T09:46:41Z)",               "check if [false, true].contains(true)",               "check if [hex:12ab, hex:34de].contains(hex:34de)",               "check if false or true",               "check if hex:12ab == hex:12ab",+              "check if hex:12abcd != hex:12ab",               "check if true"             ],             "policies": [@@ -1034,7 +1041,7 @@           },           "authorizer_code": "allow if true;\n",           "revocation_ids": [-            "1472c34b2854a24f5023f5c9a2ecead444b1ddb9c94ffc42f3ed1f062745d3983e8392cd0a94ec3b00e355f00fa5980e187bb86a625e289e2e723f373e3bcd05"+            "3e51db5f0453929a596485b59e89bf628a301a33d476132c48a1c0a208805809f15bdf99593733c1b5f30e8c1f473ee2f78042f81fd0557081bafb5370e65d0c"           ]         }       }@@ -1579,6 +1586,72 @@             "539cff0f5c311dcac843a9e6c8bb445aff0d6510bfa9b17d5350747be92dc365217e89e1d733f3ead1ecc05f287f312c41831338708e788503b55517af3ad000",             "5b10f7a7b4487f4421cf7f7f6d00b24a7a71939037b65b2e44241909564082a3e1e70cf7d866eb96f0a5119b9ea395adb772faaa33252fa62a579eb15a108a0b",             "3905351588cdfc4433b510cc1ed9c11ca5c1a7bd7d9cef338bcd3f6d374c711f34edd83dd0d53c25b63bf05b49fc78addceb47905d5495580c2fd36c11bc1e0a"+          ]+        }+      }+    },+    {+      "title": "integer wraparound",+      "filename": "test027_integer_wraparound.bc",+      "token": [+        {+          "symbols": [],+          "public_keys": [],+          "external_key": null,+          "code": "check if true || 10000000000 * 10000000000 != 0;\ncheck if true || 9223372036854775807 + 1 != 0;\ncheck if true || -9223372036854775808 - 1 != 0;\n"+        }+      ],+      "validations": {+        "": {+          "world": {+            "facts": [],+            "rules": [],+            "checks": [+              "check if true || -9223372036854775808 - 1 != 0",+              "check if true || 10000000000 * 10000000000 != 0",+              "check if true || 9223372036854775807 + 1 != 0"+            ],+            "policies": [+              "allow if true"+            ]+          },+          "result": {+            "Err": {+              "FailedLogic": {+                "Unauthorized": {+                  "policy": {+                    "Allow": 0+                  },+                  "checks": [+                    {+                      "Block": {+                        "block_id": 0,+                        "check_id": 0,+                        "rule": "check if true || 10000000000 * 10000000000 != 0"+                      }+                    },+                    {+                      "Block": {+                        "block_id": 0,+                        "check_id": 1,+                        "rule": "check if true || 9223372036854775807 + 1 != 0"+                      }+                    },+                    {+                      "Block": {+                        "block_id": 0,+                        "check_id": 2,+                        "rule": "check if true || -9223372036854775808 - 1 != 0"+                      }+                    }+                  ]+                }+              }+            }+          },+          "authorizer_code": "allow if true;\n",+          "revocation_ids": [+            "70d8941198ab5daa445a11357994d93278876ee95b6500f4c4a265ad668a0111440942b762e02513e471d40265d586ea76209921068524f588dc46eb4260db07"           ]         }       }

binary file changed (1385 → 1609 bytes)

binary file changed (absent → 329 bytes)