{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedLists   #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Spec.Parser (specs, parseExpression, parseBlock, parseAuthorizer) where

import           Control.Monad               ((<=<))
import           Data.Bifunctor              (first)
import           Data.Either                 (isLeft)
import           Data.List.NonEmpty          (NonEmpty)
import           Data.Maybe                  (fromJust)
import qualified Data.Set                    as Set
import           Data.Text                   (Text)
import           Test.Tasty
import           Test.Tasty.HUnit
import           Validation                  (Validation, validationToEither)

import           Auth.Biscuit                (PublicKey, parsePublicKeyHex)
import           Auth.Biscuit.Datalog.AST
import           Auth.Biscuit.Datalog.Parser (Parser, authorizerParser,
                                              blockParser, checkParser,
                                              expressionParser, policyParser,
                                              predicateParser,
                                              predicateTermParser, ruleParser,
                                              run)

pk1, pk2, pk3, pk4, pk5 :: PublicKey
pk1 = fromJust $ parsePublicKeyHex "a1b712761c609039f878edad694d762652f1548a68acccc96735b3196a240e8b"
pk2 = fromJust $ parsePublicKeyHex "b82c748be51784a58496675752e04cc48009a7e78bcfae8cad51fba959102af1"
pk3 = fromJust $ parsePublicKeyHex "083aae4ba29a9a3781cdee7a800f4f8ab90591f65ca983fc429687628311aedd"
pk4 = fromJust $ parsePublicKeyHex "c6864578bc03596d52878bd70025ec966c95c60727cb6573198453e82132510d"
pk5 = fromJust $ parsePublicKeyHex "a0d3dc7ab62a0a2732ba267e0d57894170458ec1659ca1226240b99764554a2e"

runWithNoParams :: Parser a
                -> (a -> Validation (NonEmpty Text) b)
                -> Text
                -> Either String b
runWithNoParams p s = validationToEither . first show . s <=< run p

parseTerm :: Text -> Either String Term
parseTerm = runWithNoParams predicateTermParser $ substitutePTerm mempty

parseTermQQ :: Text -> Either String QQTerm
parseTermQQ = run predicateTermParser

parsePredicate :: Text -> Either String Predicate
parsePredicate = runWithNoParams predicateParser $ substitutePredicate mempty

parseRule :: Text -> Either String Rule
parseRule = runWithNoParams (ruleParser False) $ substituteRule mempty mempty

parseExpression :: Text -> Either String Expression
parseExpression = runWithNoParams expressionParser $ substituteExpression mempty

parseCheck :: Text -> Either String Check
parseCheck = runWithNoParams (checkParser False) $ substituteCheck mempty mempty

parseAuthorizer :: Text -> Either String Authorizer
parseAuthorizer = runWithNoParams authorizerParser $ substituteAuthorizer mempty mempty

parsePolicy :: Text -> Either String Policy
parsePolicy = runWithNoParams policyParser $ substitutePolicy mempty mempty

parseBlock :: Text -> Either String Block
parseBlock = runWithNoParams blockParser $ substituteBlock mempty mempty

specs :: TestTree
specs = testGroup "datalog parser"
  [ factWithDate
  , simpleFact
  , oneLetterFact
  , simpleRule
  , multilineRule
  , termsGroup
  , termsGroupQQ
  , constraints
  , constrainedRule
  , constrainedRuleOrdering
  , ruleVariables
  , ruleWithScopeParsing
  , checkParsing
  , policyParsing
  , authorizerParsing
  , blockParsing
  ]

termsGroup :: TestTree
termsGroup = testGroup "Parse terms"
  [ 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 "Date" $ parseTerm "2019-12-02T13:49:53Z" @?=
        Right (LDate $ read "2019-12-02 13:49:53 UTC")
  , testCase "Variable" $ parseTerm "$1" @?= Right (Variable "1")
  , testCase "Antiquote" $ isLeft (parseTerm "{toto}") @? "Unsubstituted parameters triggers an error"
  ]

termsGroupQQ :: TestTree
termsGroupQQ = testGroup "Parse terms (in a QQ setting)"
  [ testCase "String" $ parseTermQQ "\"file1 a hello - 123_\"" @?= Right (LString "file1 a hello - 123_")
  , testCase "Positive integer" $ parseTermQQ "123" @?= Right (LInteger 123)
  , testCase "Negative integer" $ parseTermQQ "-42" @?= Right (LInteger (-42))
  , testCase "Date" $ parseTermQQ "2019-12-02T13:49:53Z" @?=
        Right (LDate $ read "2019-12-02 13:49:53 UTC")
  , testCase "Variable" $ parseTermQQ "$1" @?= Right (Variable "1")
  , testGroup "Antiquote"
     [ testCase "Variable name" $ parseTermQQ "{toto2_'}" @?= Right (Antiquote "toto2_'")
     , testCase "Leading underscore" $ parseTermQQ "{_toto}" @?= Right (Antiquote "_toto")
     , testCase "`_` is reserved" $ parseTermQQ "{_}" @?= Left "1:3:\n  |\n1 | {_}\n  |   ^\nunexpected '}'\nexpecting letter\n"
     , testCase "Variables are lower-cased" $ parseTermQQ "{Toto}" @?= Left "1:2:\n  |\n1 | {Toto}\n  |  ^\nunexpected 'T'\nexpecting '_' or lowercase letter\n"
     , testCase "_ is lower-case" $ parseTermQQ "{_Toto}" @?= Right (Antiquote "_Toto")
     , testCase "unicode is allowed" $ parseTermQQ "{éllo}" @?= Right (Antiquote "éllo")
     ]
  ]

simpleFact :: TestTree
simpleFact = testCase "Parse simple fact" $
  parsePredicate "right(\"file1\", \"read\")" @?=
    Right (Predicate "right" [LString "file1", LString "read"])

oneLetterFact :: TestTree
oneLetterFact = testCase "Parse one-letter fact" $
  parsePredicate "a(12)" @?=
    Right (Predicate "a" [LInteger 12])

factWithDate :: TestTree
factWithDate = testCase "Parse fact containing a date" $ do
  parsePredicate "date(2019-12-02T13:49:53Z)" @?=
    Right (Predicate "date" [LDate $ read "2019-12-02 13:49:53 UTC"])
  parsePredicate "date(2019-12-02T13:49:53.001Z)" @?=
    Right (Predicate "date" [LDate $ read "2019-12-02 13:49:53.001 UTC"])
  parsePredicate "date(2019-12-02T13:49:53+00:00)" @?=
    Right (Predicate "date" [LDate $ read "2019-12-02 13:49:53 UTC"])

simpleRule :: TestTree
simpleRule = testCase "Parse simple rule" $
  parseRule "right($0, \"read\") <- resource( $0), operation(\"read\")" @?=
    Right (Rule (Predicate "right" [Variable "0", LString "read"])
                [ Predicate "resource" [Variable "0"]
                , Predicate "operation" [LString "read"]
                ] [] [])

multilineRule :: TestTree
multilineRule = testCase "Parse multiline rule" $
  parseRule "right($0, \"read\") <-\n resource( $0),\n operation(\"read\")" @?=
    Right (Rule (Predicate "right" [Variable "0", LString "read"])
                [ Predicate "resource" [Variable "0"]
                , Predicate "operation" [LString "read"]
                ] [] [])

constrainedRule :: TestTree
constrainedRule = testCase "Parse constained rule" $
  parseRule "valid_date(\"file1\") <- time($0), resource(\"file1\"), $0 <= 2019-12-04T09:46:41+00:00" @?=
    Right (Rule (Predicate "valid_date" [LString "file1"])
                [ Predicate "time" [Variable "0"]
                , Predicate "resource" [LString "file1"]
                ]
                [ EBinary LessOrEqual
                    (EValue $ Variable "0")
                    (EValue $ LDate $ read "2019-12-04 09:46:41 UTC")
                ] [])

constrainedRuleOrdering :: TestTree
constrainedRuleOrdering = testCase "Parse constained rule (interleaved)" $
  parseRule "valid_date(\"file1\") <- time($0), $0 <= 2019-12-04T09:46:41+00:00, resource(\"file1\")" @?=
    Right (Rule (Predicate "valid_date" [LString "file1"])
                [ Predicate "time" [Variable "0"]
                , Predicate "resource" [LString "file1"]
                ]
                [ EBinary LessOrEqual
                    (EValue $ Variable "0")
                    (EValue $ LDate $ read "2019-12-04 09:46:41 UTC")
                ] [])

constraints :: TestTree
constraints = testGroup "Parse expressions"
  [ testCase "date comparison (LTE)" $
      parseExpression "$0 <= 2030-12-31T12:59:59+00:00" @?=
        Right (EBinary LessOrEqual
                 (EValue (Variable "0"))
                 (EValue (LDate $ read "2030-12-31 12:59:59 UTC"))
                 )
  , testCase "date comparison (GTE)" $
      parseExpression "$0 >= 2030-12-31T12:59:59+00:00" @?=
        Right (EBinary GreaterOrEqual
                 (EValue (Variable "0"))
                 (EValue (LDate $ read "2030-12-31 12:59:59 UTC"))
                 )
  , testCase "int comparison (LT)" $
      parseExpression "$0 < 1234" @?=
        Right (EBinary LessThan
                 (EValue (Variable "0"))
                 (EValue (LInteger 1234))
                 )
  , testCase "int comparison (GT)" $
      parseExpression "$0 > 1234" @?=
        Right (EBinary GreaterThan
                 (EValue (Variable "0"))
                 (EValue (LInteger 1234))
                 )
  , testCase "int comparison (LTE)" $
      parseExpression "$0 <= 1234" @?=
        Right (EBinary LessOrEqual
                 (EValue (Variable "0"))
                 (EValue (LInteger 1234))
                 )
  , testCase "int comparison (EQ)" $
      parseExpression "$0 == 1" @?=
        Right (EBinary Equal
                 (EValue (Variable "0"))
                 (EValue (LInteger 1))
                 )
  , testCase "negative int comparison (GTE)" $
      parseExpression "$0 >= -1234" @?=
        Right (EBinary GreaterOrEqual
                 (EValue (Variable "0"))
                 (EValue (LInteger (-1234)))
                 )
  , testCase "string comparison" $
      parseExpression "$0 == \"abc\"" @?=
        Right (EBinary Equal
                 (EValue (Variable "0"))
                 (EValue (LString "abc"))
                 )
  , testCase "string comparison (starts_with)" $
      parseExpression "$0.starts_with(\"abc\")" @?=
        Right (EBinary Prefix
                 (EValue (Variable "0"))
                 (EValue (LString "abc"))
                 )
  , testCase "string comparison (ends_with)" $
      parseExpression "$0.ends_with(\"abc\")" @?=
        Right (EBinary Suffix
                 (EValue (Variable "0"))
                 (EValue (LString "abc"))
                 )
  , testCase "string comparison (matches)" $
      parseExpression "$0.matches(\"abc\")" @?=
        Right (EBinary Regex
                 (EValue (Variable "0"))
                 (EValue (LString "abc"))
                 )
  , testCase "int set operation" $
      parseExpression "[1, 2].contains($0)" @?=
        Right (EBinary Contains
                 (EValue (TermSet $ Set.fromList [LInteger 1, LInteger 2]))
                 (EValue (Variable "0"))
                 )
  , testCase "negated int set operation" $
      parseExpression "![1, 2].contains($0)" @?=
        Right (EUnary Negate
                 (EBinary Contains
                    (EValue (TermSet $ Set.fromList [LInteger 1, LInteger 2]))
                    (EValue (Variable "0"))
                    ))
  , testCase "string set operation" $
      parseExpression "[\"abc\", \"def\"].contains($0)" @?=
        Right (EBinary Contains
                 (EValue (TermSet $ Set.fromList [LString "abc", LString "def"]))
                 (EValue (Variable "0"))
                 )
  , testCase "negated string set operation" $
      parseExpression "![\"abc\", \"def\"].contains($0)" @?=
        Right (EUnary Negate
                 (EBinary Contains
                    (EValue (TermSet $ Set.fromList [LString "abc", LString "def"]))
                    (EValue (Variable "0"))
                    ))
  , testCase "arithmetic operation that looks like the beginning of a RFC3339 date" $
      parseExpression "2022-12-10==2000" @?=
        Right (EBinary Equal
                 (EBinary Sub
                    (EBinary Sub
                       (EValue $ LInteger 2022)
                       (EValue $ LInteger 12)
                    )
                    (EValue $ LInteger 10)
                 )
                 (EValue $ LInteger 2000)
              )
  , operatorPrecedences
  ]

operatorPrecedences :: TestTree
operatorPrecedences = testGroup "mixed-precedence operators"
  [ testCase "< +" $
      parseExpression " 1 < $test + 2 " @?=
        Right (EBinary LessThan
                 (EValue $ LInteger 1)
                 (EBinary Add
                    (EValue $ Variable "test")
                    (EValue $ LInteger 2)
                 )
              )
  , testCase "< && starts_with" $
      parseExpression " 2 < $test && $var2.starts_with(\"test\") && true " @?=
        Right (EBinary And
                 (EBinary And
                    (EBinary LessThan
                       (EValue $ LInteger 2)
                       (EValue $ Variable "test")
                    )
                    (EBinary Prefix
                       (EValue $ Variable "var2")
                       (EValue $ LString "test")
                    )
                 )
                 (EValue $ LBool True)
              )
  , testCase "+ *" $
      parseExpression "1 + 2 * 3" @?=
        Right (EBinary Add
                 (EValue $ LInteger 1)
                 (EBinary Mul
                    (EValue $ LInteger 2)
                    (EValue $ LInteger 3)
                 )
              )
  , testCase "+ * parens" $
      parseExpression "(1 + 2) * 3" @?=
        Right (EBinary Mul
                 (EUnary Parens
                    (EBinary Add
                       (EValue $ LInteger 1)
                       (EValue $ LInteger 2)
                    )
                 )
                 (EValue $ LInteger 3)
              )
  , testCase "+ & | *" $
      parseExpression "1 + 2 | 4 * 3 & 4" @?=
        Right (EBinary BitwiseOr
                  (EBinary Add
                    (EValue $ LInteger 1)
                    (EValue $ LInteger 2)
                  )
                  (EBinary BitwiseAnd
                    (EBinary Mul
                      (EValue $ LInteger 4)
                      (EValue $ LInteger 3)
                    )
                    (EValue $ LInteger 4)
                  )
              )
  ]

ruleVariables :: TestTree
ruleVariables = testGroup "Make sure rule & query variables are correctly introduced"
  [ testCase "Head variables are correctly introduced" $
      parseRule "head($unbound) <- body(true)" @?=
        Left "1:1:\n  |\n1 | head($unbound) <- body(true)\n  | ^\nUnbound variables: unbound\n"
  , testCase "Expression variables are correctly introduced (rule)" $
      parseRule "head(true) <- body(true), $unbound" @?=
        Left "1:1:\n  |\n1 | head(true) <- body(true), $unbound\n  | ^\nUnbound variables: unbound\n"
  , testCase "Expression variables are correctly introduced (check)" $
      parseCheck "check if body(true), $unbound" @?=
        Left "1:10:\n  |\n1 | check if body(true), $unbound\n  |          ^\nUnbound variables: unbound\n"
  , testCase "Expression variables are correctly introduced (allow policy)" $
      parsePolicy "allow if body(true), $unbound" @?=
        Left "1:10:\n  |\n1 | allow if body(true), $unbound\n  |          ^\nUnbound variables: unbound\n"
  , testCase "Expression variables are correctly introduced (deny policy)" $
      parsePolicy "deny if body(true), $unbound" @?=
        Left "1:9:\n  |\n1 | deny if body(true), $unbound\n  |         ^\nUnbound variables: unbound\n"
  ]

ruleWithScopeParsing :: TestTree
ruleWithScopeParsing = testCase "Parse constained rule with scope annotation" $
  parseRule "valid_date(\"file1\") <- time($0), resource(\"file1\"), $0 <= 2019-12-04T09:46:41+00:00 trusting previous" @?=
    Right (Rule (Predicate "valid_date" [LString "file1"])
                [ Predicate "time" [Variable "0"]
                , Predicate "resource" [LString "file1"]
                ]
                [ EBinary LessOrEqual
                    (EValue $ Variable "0")
                    (EValue $ LDate $ read "2019-12-04 09:46:41 UTC")
                ] [Previous])

checkParsing :: TestTree
checkParsing = testGroup "check blocks"
  [ testCase "Simple check" $
      parseCheck "check if true" @?=
        Right Check
          { cQueries = [QueryItem [] [EValue $ LBool True] []]
          , cKind = One
          }
  , testCase "Simple check all" $
      parseCheck "check all true" @?=
        Right Check
          { cQueries = [QueryItem [] [EValue $ LBool True] []]
          , cKind = All
          }
  , testCase "Multiple groups" $
      parseCheck
        "check 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 = One
            }
  , testCase "Multiple check all groups" $
      parseCheck
        "check all 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 = All
            }
  , testCase "Multiple groups, scoped" $
      parseCheck
        "check if fact($var), $var == true trusting previous or \
        \other($var), $var == 2 trusting authority" @?=
          Right Check
            { cQueries =
                [ QueryItem [Predicate "fact" [Variable "var"]]
                            [EBinary Equal (EValue (Variable "var")) (EValue (LBool True))]
                            [Previous]
                , QueryItem [Predicate "other" [Variable "var"]]
                            [EBinary Equal (EValue (Variable "var")) (EValue (LInteger 2))]
                            [OnlyAuthority]
                ]
            , cKind = One
            }
  , testCase "Multiple check all groups, scoped" $
      parseCheck
        "check all fact($var), $var == true trusting previous or \
        \other($var), $var == 2 trusting authority" @?=
          Right Check
            { cQueries =
                [ QueryItem [Predicate "fact" [Variable "var"]]
                            [EBinary Equal (EValue (Variable "var")) (EValue (LBool True))]
                            [Previous]
                , QueryItem [Predicate "other" [Variable "var"]]
                            [EBinary Equal (EValue (Variable "var")) (EValue (LInteger 2))]
                            [OnlyAuthority]
                ]
            , cKind = All
            }
  ]

policyParsing :: TestTree
policyParsing = testGroup "policy blocks"
  [ testCase "Simple allow policy" $
      parsePolicy "allow if true" @?=
        Right (Allow, [QueryItem [] [EValue $ LBool True] []])
  , testCase "Simple deny policy" $
      parsePolicy "deny if true" @?=
        Right (Deny, [QueryItem [] [EValue $ LBool True] []])
  , testCase "Allow with multiple groups" $
      parsePolicy
        "allow if fact($var), $var == true or \
        \other($var), $var == 2" @?=
          Right
            ( Allow
            , [ 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))]
                          []
              ]
            )
  , testCase "Deny with multiple groups" $
      parsePolicy
        "deny if fact($var), $var == true or \
        \other($var), $var == 2" @?=
          Right
            ( Deny
            , [ 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))]
                          []
              ]
            )
  , testCase "Deny with multiple groups, multiline" $
      parsePolicy
        "deny if\n\
           \fact($var), $var == true or //comment\n\
           \other($var), $var == 2" @?=
          Right
            ( Deny
            , [ 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))]
                          []
              ]
            )
  , testCase "Allow with multiple groups, scoped" $
      parsePolicy
        "allow if fact($var), $var == true trusting authority or \
        \other($var), $var == 2 trusting ed25519/a1b712761c609039f878edad694d762652f1548a68acccc96735b3196a240e8b,ed25519/083aae4ba29a9a3781cdee7a800f4f8ab90591f65ca983fc429687628311aedd,ed25519/c6864578bc03596d52878bd70025ec966c95c60727cb6573198453e82132510d " @?=
          Right
            ( Allow
            , [ QueryItem [Predicate "fact" [Variable "var"]]
                          [EBinary Equal (EValue (Variable "var")) (EValue (LBool True))]
                          [OnlyAuthority]
              , QueryItem [Predicate "other" [Variable "var"]]
                          [EBinary Equal (EValue (Variable "var")) (EValue (LInteger 2))]
                          [BlockId pk1, BlockId pk3, BlockId pk4]
              ]
            )
  ]

authorizerParsing :: TestTree
authorizerParsing = testGroup "Simple authorizers"
  [ testCase "Just a deny" $
      parseAuthorizer "deny if true;" @?=
        Right (Authorizer [(Deny, [QueryItem [] [EValue (LBool True)] []])] mempty
              )
  , testCase "Allow and deny" $
      parseAuthorizer "allow if operation(\"read\");\n deny if true;" @?=
        Right (Authorizer
                 [  (Allow, [QueryItem [Predicate "operation" [LString "read"]] [] []])
                 , (Deny, [QueryItem [] [EValue (LBool True)] []])
                 ]
                 mempty
              )
  , testCase "Previous is denied at the top level" $
      parseAuthorizer "trusting previous; allow if true;" @?=
        Left "1:10:\n  |\n1 | trusting previous; allow if true;\n  |          ^\n'previous' can't appear in an authorizer scope\n"
  , testCase "Previous is denied in rules" $
      parseAuthorizer "head(true) <- tail(true) trusting previous;" @?=
        Left "1:35:\n  |\n1 | head(true) <- tail(true) trusting previous;\n  |                                   ^\n'previous' can't appear in an authorizer scope\n"
  , testCase "Previous is denied in checks" $
      parseAuthorizer "check if true trusting previous;" @?=
        Left "1:24:\n  |\n1 | check if true trusting previous;\n  |                        ^\n'previous' can't appear in an authorizer scope\n"
  , testCase "Previous is denied in policies" $
      parseAuthorizer "allow if true trusting previous;" @?=
        Left "1:24:\n  |\n1 | allow if true trusting previous;\n  |                        ^\n'previous' can't appear in an authorizer scope\n"
  , testCase "Complete authorizer" $ do
      let spec :: Text
          spec =
            " trusting authority;\n\
            \// the owner has all rights\n\
            \right($blog_id, $article_id, $operation) <-\n\
            \    article($blog_id, $article_id),\n\
            \    operation($operation),\n\
            \    user($user_id),\n\
            \    owner($user_id, $blog_id);\n\
            \// premium users can access some restricted articles\n\
            \right($blog_id, $article_id, \"read\") <-\n\
            \  article($blog_id, $article_id),\n\
            \  premium_readable($blog_id, $article_id),\n\
            \  user($user_id),\n\
            \  premium_user($user_id, $blog_id);\n\
            \// define teams and roles\n\
            \right($blog_id, $article_id, $operation) <-\n\
            \  article($blog_id, $article_id),\n\
            \  operation($operation),\n\
            \  user($user_id),\n\
            \  member($user_id, $team_id),\n\
            \  team_role($team_id, $blog_id, \"contributor\"),\n\
            \  [\"read\", \"write\"].contains($operation);\n\
            \// unauthenticated users have read access on published articles\n\
            \allow if\n\
            \  operation(\"read\"),\n\
            \  article($blog_id, $article_id),\n\
            \  readable($blog_id, $article_id);\n\
            \// authorize if got the rights on this blog and article\n\
            \allow if\n\
            \  blog($blog_id),\n\
            \  article($blog_id, $article_id),\n\
            \  operation($operation),\n\
            \  right($blog_id, $article_id, $operation);\n\
            \// catch all rule in case the allow did not match\n\
            \deny if true;\
            \ "
          p = Predicate
          sRead = LString "read"
          sWrite = LString "write"
          sContributor = LString "contributor"
          vBlogId = Variable "blog_id"
          vArticleId = Variable "article_id"
          vUserId = Variable "user_id"
          vTeamId = Variable "team_id"
          vOp = Variable "operation"
          bRules =
            [ Rule (p "right" [vBlogId, vArticleId, vOp])
                   [ p "article" [vBlogId, vArticleId]
                   , p "operation" [vOp]
                   , p "user" [vUserId]
                   , p "owner" [vUserId, vBlogId]
                   ] [] []
            , Rule (p "right" [vBlogId, vArticleId, sRead])
                   [ p "article" [vBlogId, vArticleId]
                   , p "premium_readable" [vBlogId, vArticleId]
                   , p "user" [vUserId]
                   , p "premium_user" [vUserId, vBlogId]
                   ] [] []
            , Rule (p "right" [vBlogId, vArticleId, vOp])
                   [ p "article" [vBlogId, vArticleId]
                   , p "operation" [vOp]
                   , p "user" [vUserId]
                   , p "member" [vUserId, vTeamId]
                   , p "team_role" [vTeamId, vBlogId, sContributor]
                   ] [EBinary Contains (EValue (TermSet $ Set.fromList [sRead, sWrite]))
                                       (EValue vOp)] []
           ]
          bFacts = []
          bChecks = []
          bContext = Nothing
          bScope = [OnlyAuthority]
          vPolicies =
            [ (Allow, [QueryItem [ p "operation" [sRead]
                                 , p "article"   [vBlogId, vArticleId]
                                 , p "readable"  [vBlogId, vArticleId]
                                 ] [] []])
            , (Allow, [QueryItem [ p "blog" [vBlogId]
                                 , p "article" [vBlogId, vArticleId]
                                 , p "operation" [vOp]
                                 , p "right" [vBlogId, vArticleId, vOp]
                                 ] [] []])
            , (Deny, [QueryItem [] [EValue (LBool True)] []])
            ]
      parseAuthorizer spec @?= Right Authorizer{vBlock = Block{..}, ..}
  ]

blockParsing :: TestTree
blockParsing = testCase "Full block" $ do
  let spec :: Text
      spec =
        " trusting ed25519/b82c748be51784a58496675752e04cc48009a7e78bcfae8cad51fba959102af1,ed25519/083aae4ba29a9a3781cdee7a800f4f8ab90591f65ca983fc429687628311aedd,ed25519/a0d3dc7ab62a0a2732ba267e0d57894170458ec1659ca1226240b99764554a2e;\n\
        \// the owner has all rights\n\
        \right($blog_id, $article_id, $operation) <-\n\
        \    article($blog_id, $article_id),\n\
        \    operation($operation),\n\
        \    user($user_id),\n\
        \    owner($user_id, $blog_id);\n\
        \// premium users can access some restricted articles\n\
        \right($blog_id, $article_id, \"read\") <-\n\
        \  article($blog_id, $article_id),\n\
        \  premium_readable($blog_id, $article_id),\n\
        \  user($user_id),\n\
        \  premium_user($user_id, $blog_id);\n\
        \// define teams and roles\n\
        \right($blog_id, $article_id, $operation) <-\n\
        \  article($blog_id, $article_id),\n\
        \  operation($operation),\n\
        \  user($user_id),\n\
        \  member($user_id, $team_id),\n\
        \  team_role($team_id, $blog_id, \"contributor\"),\n\
        \  [\"read\", \"write\"].contains($operation);\n\
        \ "
      p = Predicate
      sRead = LString "read"
      sWrite = LString "write"
      sContributor = LString "contributor"
      vBlogId = Variable "blog_id"
      vArticleId = Variable "article_id"
      vUserId = Variable "user_id"
      vTeamId = Variable "team_id"
      vOp = Variable "operation"
      bRules =
        [ Rule (p "right" [vBlogId, vArticleId, vOp])
               [ p "article" [vBlogId, vArticleId]
               , p "operation" [vOp]
               , p "user" [vUserId]
               , p "owner" [vUserId, vBlogId]
               ] [] []
        , Rule (p "right" [vBlogId, vArticleId, sRead])
               [ p "article" [vBlogId, vArticleId]
               , p "premium_readable" [vBlogId, vArticleId]
               , p "user" [vUserId]
               , p "premium_user" [vUserId, vBlogId]
               ] [] []
        , Rule (p "right" [vBlogId, vArticleId, vOp])
               [ p "article" [vBlogId, vArticleId]
               , p "operation" [vOp]
               , p "user" [vUserId]
               , p "member" [vUserId, vTeamId]
               , p "team_role" [vTeamId, vBlogId, sContributor]
               ] [EBinary Contains (EValue (TermSet $ Set.fromList [sRead, sWrite]))
                                   (EValue vOp)] []
       ]
      bFacts = []
      bChecks = []
      bContext = Nothing
      bScope = Set.fromList $ BlockId <$> [pk2,pk3,pk5]
  parseBlock spec @?= Right Block{..}