CollectorSpec.hs

{-# LANGUAGE OverloadedLists #-}

-- |  Directly ported from puppet specs
module Interpreter.CollectorSpec (spec) where

import Control.Lens
import qualified Data.Text as Text
import Helpers
import Test.Hspec

shouldNotify :: [Text] -> [PValue] -> Expectation
shouldNotify content expectedMessages = do
  catalog <- case pureCatalog (Text.unlines content) of
    Left rr -> fail rr
    Right (x, _) -> pure x
  let messages = itoList catalog ^.. folded . filtered (\rp -> rp ^. _1 . itype == "notify") . _2 . rattributes . ix "message"
  messages `shouldMatchList` expectedMessages

shouldFail :: [Text] -> Expectation
shouldFail content =
  let catalog = pureCatalog (Text.unlines content)
   in catalog `shouldSatisfy` has _Left

spec =
  describe "Collectors" $ do
    spec0
    spec1

spec0 :: Spec
spec0 = do
  it "matches everything when no query given" $
    [ "@notify { 'testing': message => 'the message' }",
      "@notify { 'other': message => 'the other message' }",
      "Notify <| |>"
    ]
      `shouldNotify` ["the other message", "the message"]
  it "matches regular resources" $
    [ "notify { \"testing\": message => \"the message\" }",
      "notify { \"other\": message => \"the other message\" }",
      "Notify <| |> { message => \"changed\" }"
    ]
      `shouldNotify` ["changed", "changed"]
  it "matches on tags" $
    [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
      "@notify { \"other\": tag => [\"two\"], message => \"unwanted\" }",
      "Notify <| tag == one |>"
    ]
      `shouldNotify` ["wanted"]
  it "matches on title" $
    [ "@notify { \"testing\": message => \"the message\" }",
      "Notify <| title == \"testing\" |>"
    ]
      `shouldNotify` ["the message"]
  it "matches on other parameters" $
    [ "@notify { \"testing\": message => \"the message\" }",
      "@notify { \"other testing\": message => \"the wrong message\" }",
      "Notify <| message == \"the message\" |>"
    ]
      `shouldNotify` ["the message"]
  it "matches against elements of an array valued parameter" $
    [ "@notify { \"testing\": message => [\"the\", \"message\"] }",
      "@notify { \"other testing\": message => [\"not\", \"here\"] }",
      "Notify <| message == \"message\" |>"
    ]
      `shouldNotify` [PArray ["the", "message"]]
  it "matches with bare word" $
    [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
      "Notify <| tag == one |>"
    ]
      `shouldNotify` ["wanted"]
  it "matches with single quoted string" $
    [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
      "Notify <| tag == 'one' |>"
    ]
      `shouldNotify` ["wanted"]
  it "matches with double quoted string" $
    [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
      "Notify <| tag == \"one\" |>"
    ]
      `shouldNotify` ["wanted"]
  it "matches with double quoted string with interpolated expression" $
    [ "@notify { \"testing\": tag => [\"one\"], message => \"wanted\" }",
      "$x = 'one'",
      "Notify <| tag == \"$x\" |>"
    ]
      `shouldNotify` ["wanted"]
  it "matches with resource references" $ do
    pending
    shouldNotify
      [ "@notify { \"foobar\": }",
        "@notify { \"testing\": require => Notify[\"foobar\"], message => \"wanted\" }",
        "Notify <| require == Notify[\"foobar\"] |>"
      ]
      ["wanted"]
  it "allows criteria to be combined with 'and'" $
    [ "@notify { \"testing\": message => \"the message\" }",
      "@notify { \"other\": message => \"the message\" }",
      "Notify <| title == \"testing\" and message == \"the message\" |>"
    ]
      `shouldNotify` ["the message"]
  it "allows criteria to be combined with 'or'" $
    [ "@notify { \"testing\": message => \"the message\" }",
      "@notify { \"other\": message => \"other message\" }",
      "@notify { \"yet another\": message => \"different message\" }",
      "Notify <| title == \"testing\" or message == \"other message\" |>"
    ]
      `shouldNotify` ["the message", "other message"]
  it "allows criteria to be grouped with parens" $
    [ "@notify { \"testing\":     message => \"different message\", withpath => true }",
      "@notify { \"other\":       message => \"the message\" }",
      "@notify { \"yet another\": message => \"the message\",       withpath => true }",
      "Notify <| (title == \"testing\" or message == \"the message\") and withpath == true |>"
    ]
      `shouldNotify` ["the message", "different message"]
  it "does not do anything if nothing matches" $
    [ "@notify { \"testing\": message => \"different message\" }",
      "Notify <| title == \"does not exist\" |>"
    ]
      `shouldNotify` []
  it "excludes items with inequalities" $
    [ "@notify { \"testing\": message => \"good message\" }",
      "@notify { \"the wrong one\": message => \"bad message\" }",
      "Notify <| title != \"the wrong one\" |>"
    ]
      `shouldNotify` ["good message"]
  it "does not exclude resources with unequal arrays" $
    [ "@notify { \"testing\": message => \"message\" }",
      "@notify { \"the wrong one\": message => [\"not this message\", \"or this one\"] }",
      "Notify <| message != \"not this message\" |>"
    ]
      `shouldNotify` ["message", PArray ["not this message", "or this one"]]
  it "does not exclude tags with inequalities" $
    [ "@notify { \"testing\": tag => [\"wanted\"], message => \"wanted message\" }",
      "@notify { \"other\": tag => [\"why\"], message => \"the way it works\" }",
      "Notify <| tag != \"why\" |>"
    ]
      `shouldNotify` ["wanted message", "the way it works"]
  it "does not collect classes" $
    shouldFail
      [ "class theclass {",
        "    @notify { \"testing\": message => \"good message\" }",
        "}",
        "Class <|  |>"
      ]
  it "does not collect resources that don't exist" $ do
    pending
    shouldFail
      [ "class theclass {",
        "    @notify { \"testing\": message => \"good message\" }",
        "}",
        "SomeResource <|  |>"
      ]
  it "modifies an existing array" $
    [ "@notify { \"testing\": message => [\"original message\"] }",
      "Notify <| |> {",
      "    message +> \"extra message\"",
      "}"
    ]
      `shouldNotify` [PArray ["original message", "extra message"]]
  it "converts a scalar to an array" $
    [ "@notify { \"testing\": message => \"original message\" }",
      "Notify <| |> {",
      "    message +> \"extra message\"",
      "}"
    ]
      `shouldNotify` [PArray ["original message", "extra message"]]
  it "collects and overrides virtual resources multiple times using multiple collects" $
    [ "@notify { \"testing\": message => \"original\" }",
      "Notify <|  |> { message => 'overridden1' }",
      "Notify <|  |> { message => 'overridden2' }"
    ]
      `shouldNotify` ["overridden2"]
  it "collects and overrides non virtual resources multiple times using multiple collects" $
    [ "notify { \"testing\": message => \"original\" }",
      "Notify <|  |> { message => 'overridden1' }",
      "Notify <|  |> { message => 'overridden2' }"
    ]
      `shouldNotify` ["overridden2"]

spec1 :: Spec
spec1 = do
  let computeWith = pureCatalog . arrowOperationInput
  describe "Resource Collector" $
    it "should append the new 'uid' attribute in the user resource" $
      getResAttr (computeWith "=>") ^. at "uid" `shouldBe` Just (PNumber 1000)
  describe "AppendArrow in AttributeDecl" $
    it "should add 'docker' to the 'groups' attribute of the user resource" $ do
      getResAttr (computeWith "+>") ^. at "groups" `shouldBe` Just (PArray ["ci", "docker"])
  describe "AssignArrow in AttributeDecl" $
    it "should override the 'groups' attributes from the user resource" $
      getResAttr (computeWith "=>") ^. at "groups" `shouldBe` Just (PArray ["docker"])
  where
    getResAttr :: Either String (FinalCatalog, InterpreterWriter) -> Container PValue
    getResAttr s = s ^. _Right . _1 . at (RIdentifier "user" "jenkins") . _Just . rattributes

    arrowOperationInput :: Text -> Text
    arrowOperationInput arr =
      Text.unlines
        [ "user { 'jenkins':",
          "  groups => 'ci'",
          "}",
          "User <| title == 'jenkins' |> {",
          "groups " <> arr <> " 'docker',",
          "uid => 1000}",
          "}"
        ]