diff --git a/biscuit-haskell.cabal b/biscuit-haskell.cabal --- a/biscuit-haskell.cabal +++ b/biscuit-haskell.cabal @@ -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 @@ -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 diff --git a/src/Auth/Biscuit.hs b/src/Auth/Biscuit.hs --- a/src/Auth/Biscuit.hs +++ b/src/Auth/Biscuit.hs @@ -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 diff --git a/src/Auth/Biscuit/Datalog/AST.hs b/src/Auth/Biscuit/Datalog/AST.hs --- a/src/Auth/Biscuit/Datalog/AST.hs +++ b/src/Auth/Biscuit/Datalog/AST.hs @@ -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 diff --git a/src/Auth/Biscuit/Datalog/Executor.hs b/src/Auth/Biscuit/Datalog/Executor.hs --- a/src/Auth/Biscuit/Datalog/Executor.hs +++ b/src/Auth/Biscuit/Datalog/Executor.hs @@ -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 diff --git a/src/Auth/Biscuit/Datalog/Parser.hs b/src/Auth/Biscuit/Datalog/Parser.hs --- a/src/Auth/Biscuit/Datalog/Parser.hs +++ b/src/Auth/Biscuit/Datalog/Parser.hs @@ -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 diff --git a/src/Auth/Biscuit/Datalog/ScopedExecutor.hs b/src/Auth/Biscuit/Datalog/ScopedExecutor.hs --- a/src/Auth/Biscuit/Datalog/ScopedExecutor.hs +++ b/src/Auth/Biscuit/Datalog/ScopedExecutor.hs @@ -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 diff --git a/src/Auth/Biscuit/Proto.hs b/src/Auth/Biscuit/Proto.hs --- a/src/Auth/Biscuit/Proto.hs +++ b/src/Auth/Biscuit/Proto.hs @@ -208,6 +208,7 @@ | BitwiseAnd | BitwiseOr | BitwiseXor + | NotEqual deriving stock (Show, Enum, Bounded) newtype OpBinary = OpBinary diff --git a/src/Auth/Biscuit/ProtoBufAdapter.hs b/src/Auth/Biscuit/ProtoBufAdapter.hs --- a/src/Auth/Biscuit/ProtoBufAdapter.hs +++ b/src/Auth/Biscuit/ProtoBufAdapter.hs @@ -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 diff --git a/src/Auth/Biscuit/Token.hs b/src/Auth/Biscuit/Token.hs --- a/src/Auth/Biscuit/Token.hs +++ b/src/Auth/Biscuit/Token.hs @@ -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 diff --git a/src/Auth/Biscuit/Utils.hs b/src/Auth/Biscuit/Utils.hs --- a/src/Auth/Biscuit/Utils.hs +++ b/src/Auth/Biscuit/Utils.hs @@ -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 diff --git a/test/Spec/Executor.hs b/test/Spec/Executor.hs --- a/test/Spec/Executor.hs +++ b/test/Spec/Executor.hs @@ -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 diff --git a/test/Spec/Parser.hs b/test/Spec/Parser.hs --- a/test/Spec/Parser.hs +++ b/test/Spec/Parser.hs @@ -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 ] diff --git a/test/Spec/SampleReader.hs b/test/Spec/SampleReader.hs --- a/test/Spec/SampleReader.hs +++ b/test/Spec/SampleReader.hs @@ -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 diff --git a/test/samples/current/samples.json b/test/samples/current/samples.json --- a/test/samples/current/samples.json +++ b/test/samples/current/samples.json @@ -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" ] } } diff --git a/test/samples/current/test017_expressions.bc b/test/samples/current/test017_expressions.bc Binary files a/test/samples/current/test017_expressions.bc and b/test/samples/current/test017_expressions.bc differ diff --git a/test/samples/current/test027_integer_wraparound.bc b/test/samples/current/test027_integer_wraparound.bc new file mode 100644 Binary files /dev/null and b/test/samples/current/test027_integer_wraparound.bc differ