content: {-# LANGUAGE TemplateHaskell, CPP, ScopedTypeVariables #-}
  
  {-| Unittests for ganeti-htools.
  
  -}
  
  {-
  
  Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
  All rights reserved.
  
  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions are
  met:
  
  1. Redistributions of source code must retain the above copyright notice,
  this list of conditions and the following disclaimer.
  
  2. Redistributions in binary form must reproduce the above copyright
  notice, this list of conditions and the following disclaimer in the
  documentation and/or other materials provided with the distribution.
  
  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  
  -}
  
  module Test.Ganeti.Utils (testUtils) where
  
  import Test.QuickCheck hiding (Result)
  import Test.HUnit
  
  import Data.Char (isSpace)
  import qualified Data.Either as Either
  import qualified Data.List.NonEmpty as NonEmpty
  import Data.List.NonEmpty (NonEmpty((:|)), nonEmpty)
  import Data.List
  import Data.Maybe (listToMaybe)
  import qualified Data.Set as S
  import qualified Text.JSON as J
  import Ganeti.Query.RegEx ((=~))
  
  import Test.Ganeti.TestHelper
  import Test.Ganeti.TestCommon
  
  import Ganeti.BasicTypes
  import qualified Ganeti.Constants as C
  import qualified Ganeti.JSON as JSON
  import Ganeti.Utils as Utils
  
  {-# ANN module "HLint: ignore Use camelCase" #-}
  
  
  -- | Helper to generate a small string that doesn't contain commas.
  genNonCommaString :: Gen String
  genNonCommaString = do
    size <- choose (0, 20) -- arbitrary max size
    vectorOf size (arbitrary `suchThat` (/=) ',')
  
  genNonEmpty :: (Arbitrary a) => Gen (NonEmpty a)
  genNonEmpty = fmap (uncurry (:|)) arbitrary
  
  -- | If the list is not just an empty element, and if the elements do
  -- not contain commas, then join+split should be idempotent.
  prop_commaJoinSplit :: Property
  prop_commaJoinSplit =
    forAll (choose (0, 20)) $ \llen ->
    forAll (vectorOf llen genNonCommaString `suchThat` (/=) [""]) $ \lst ->
    sepSplit ',' (commaJoin lst) ==? lst
  
  -- | Split and join should always be idempotent.
  prop_commaSplitJoin :: String -> Property
  prop_commaSplitJoin s =
    commaJoin (sepSplit ',' s) ==? s
  
  -- | Test 'findFirst' on several possible inputs.
  prop_findFirst :: Property
  prop_findFirst =
    forAll (genSublist [0..5 :: Int]) $ \xs ->
    forAll (choose (-2, 7)) $ \base ->
    counterexample "findFirst utility function" $
    let r = findFirst base (S.fromList xs)
        (ss, es) = partition (< r) $ dropWhile (< base) xs
        -- the prefix must be a range of numbers
        -- and the suffix must not start with 'r'
     in conjoin [ and $ zipWith ((==) . (+ 1)) ss (drop 1 ss)
                , maybe True (> r) (listToMaybe es)
                ]
  
  
  -- | fromObjWithDefault, we test using the Maybe monad and an integer
  -- value.
  prop_fromObjWithDefault :: Integer -> String -> Bool
  prop_fromObjWithDefault def_value random_key =
    -- a missing key will be returned with the default
    JSON.fromObjWithDefault [] random_key def_value == Just def_value &&
    -- a found key will be returned as is, not with default
    JSON.fromObjWithDefault [(random_key, J.showJSON def_value)]
         random_key (def_value+1) == Just def_value
  
  -- | Test that functional if' behaves like the syntactic sugar if.
  prop_if'if :: Bool -> Int -> Int -> Property
  prop_if'if cnd a b =
    if' cnd a b ==? if cnd then a else b
  
  -- | Test basic select functionality
  prop_select :: Int      -- ^ Default result
              -> [Int]    -- ^ List of False values
              -> [Int]    -- ^ List of True values
              -> Property -- ^ Test result
  prop_select def lst1 lst2 =
    select def (flist ++ tlist) ==? expectedresult
      where expectedresult = defaultHead def lst2
            flist = zip (repeat False) lst1
            tlist = zip (repeat True)  lst2
  
  -- | Test basic select functionality with undefined default
  prop_select_undefd_plain
                     :: [Int]            -- ^ List of False values
                     -> NonEmpty Int     -- ^ List of True values
                     -> Property         -- ^ Test result
  prop_select_undefd_plain lst1 lst2 =
    select undefined (flist ++ tlist) ==? NonEmpty.head lst2
      where flist = zip (repeat False) lst1
            tlist = zip (repeat True)  (NonEmpty.toList lst2)
  
  prop_select_undefd :: [Int] -> Property
  prop_select_undefd lst1 = forAll genNonEmpty $ prop_select_undefd_plain lst1
  
  -- | Test basic select functionality with undefined list values
  prop_select_undefv_plain
                     :: [Int]            -- ^ List of False values
                     -> NonEmpty Int     -- ^ List of True values
                     -> Property         -- ^ Test result
  prop_select_undefv_plain lst1 lst2 =
    select undefined cndlist ==? NonEmpty.head lst2
      where flist = zip (repeat False) lst1
            tlist = zip (repeat True)  (NonEmpty.toList lst2)
            cndlist = flist ++ tlist ++ [undefined]
  
  prop_select_undefv :: [Int] -> Property
  prop_select_undefv lst1 = forAll genNonEmpty $ prop_select_undefv_plain lst1
  
  prop_parseUnit :: NonNegative Int -> Property
  prop_parseUnit (NonNegative n) =
    conjoin
    [ parseUnit (show n) ==? (Ok n::Result Int)
    , parseUnit (show n ++ "m") ==? (Ok n::Result Int)
    , parseUnit (show n ++ "M") ==? (Ok (truncate n_mb)::Result Int)
    , parseUnit (show n ++ "g") ==? (Ok (n*1024)::Result Int)
    , parseUnit (show n ++ "G") ==? (Ok (truncate n_gb)::Result Int)
    , parseUnit (show n ++ "t") ==? (Ok (n*1048576)::Result Int)
    , parseUnit (show n ++ "T") ==? (Ok (truncate n_tb)::Result Int)
    , counterexample "Internal error/overflow?"
      (n_mb >=0 && n_gb >= 0 && n_tb >= 0)
    , property (isBad (parseUnit (show n ++ "x")::Result Int))
    ]
    where n_mb = (fromIntegral n::Rational) * 1000 * 1000 / 1024 / 1024
          n_gb = n_mb * 1000
          n_tb = n_gb * 1000
  
  {-# ANN case_niceSort_static "HLint: ignore Use camelCase" #-}
  
  case_niceSort_static :: Assertion
  case_niceSort_static = do
    assertEqual "empty list" [] $ niceSort []
    assertEqual "punctuation" [",", "."] $ niceSort [",", "."]
    assertEqual "decimal numbers" ["0.1", "0.2"] $ niceSort ["0.1", "0.2"]
    assertEqual "various numbers" ["0,099", "0.1", "0.2", "0;099"] $
                niceSort ["0;099", "0,099", "0.1", "0.2"]
  
    assertEqual "simple concat" ["0000", "a0", "a1", "a2", "a20", "a99",
                                 "b00", "b10", "b70"] $
      niceSort ["a0", "a1", "a99", "a20", "a2", "b10", "b70", "b00", "0000"]
  
    assertEqual "ranges" ["A", "Z", "a0-0", "a0-4", "a1-0", "a9-1", "a09-2",
                        "a20-3", "a99-3", "a99-10", "b"] $
      niceSort ["a0-0", "a1-0", "a99-10", "a20-3", "a0-4", "a99-3", "a09-2",
                "Z", "a9-1", "A", "b"]
  
    assertEqual "large"
      ["3jTwJPtrXOY22bwL2YoW", "Eegah9ei", "KOt7vn1dWXi",
       "KVQqLPDjcPjf8T3oyzjcOsfkb", "WvNJd91OoXvLzdEiEXa6",
       "Z8Ljf1Pf5eBfNg171wJR", "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
       "cPRi0lM7HLnSuWA2G9", "guKJkXnkULealVC8CyF1xefym",
       "pqF8dkU5B1cMnyZuREaSOADYx", "uHXAyYYftCSG1o7qcCqe",
       "xij88brTulHYAv8IEOyU", "xpIUJeVT1Rp"] $
      niceSort ["Eegah9ei", "xij88brTulHYAv8IEOyU", "3jTwJPtrXOY22bwL2YoW",
               "Z8Ljf1Pf5eBfNg171wJR", "WvNJd91OoXvLzdEiEXa6",
               "uHXAyYYftCSG1o7qcCqe", "xpIUJeVT1Rp", "KOt7vn1dWXi",
               "a07h8feON165N67PIE", "bH4Q7aCu3PUPjK3JtH",
               "cPRi0lM7HLnSuWA2G9", "KVQqLPDjcPjf8T3oyzjcOsfkb",
               "guKJkXnkULealVC8CyF1xefym", "pqF8dkU5B1cMnyZuREaSOADYx"]
  
    assertEqual "hostnames"
      ["host1.example.com", "host2.example.com", "host03.example.com",
       "host11.example.com", "host255.example.com"] $
      niceSort ["host2.example.com", "host11.example.com", "host03.example.com",
       "host1.example.com", "host255.example.com"]
  
  -- | Tests single-string behaviour of 'niceSort'.
  prop_niceSort_single :: Property
  prop_niceSort_single =
    forAll genName $ \name ->
    conjoin
    [ counterexample "single string" $ [name] ==? niceSort [name]
    , counterexample "single plus empty" $ ["", name] ==? niceSort [name, ""]
    ]
  
  -- | Tests some generic 'niceSort' properties. Note that the last test
  -- must add a non-digit prefix; a digit one might change ordering.
  prop_niceSort_generic :: Property
  prop_niceSort_generic =
    forAll (resize 20 arbitrary) $ \names ->
    let n_sorted = niceSort names in
    conjoin [ counterexample "length" $ length names ==? length n_sorted
            , counterexample "same strings" $ sort names ==? sort n_sorted
            , counterexample "idempotence" $ n_sorted ==? niceSort n_sorted
            , counterexample "static prefix" $ n_sorted ==?
                map tail (niceSort $ map (" "++) names)
            ]
  
  -- | Tests that niceSorting numbers is identical to actual sorting
  -- them (in numeric form).
  prop_niceSort_numbers :: Property
  prop_niceSort_numbers =
    forAll (listOf (arbitrary::Gen (NonNegative Int))) $ \numbers ->
    map show (sort numbers) ==? niceSort (map show numbers)
  
  -- | Tests that 'niceSort' and 'niceSortKey' are equivalent.
  prop_niceSortKey_equiv :: Property
  prop_niceSortKey_equiv =
    forAll (resize 20 arbitrary) $ \names ->
    forAll (vectorOf (length names) (arbitrary::Gen Int)) $ \numbers ->
    let n_sorted = niceSort names in
    conjoin
    [ counterexample "key id" $ n_sorted ==? niceSortKey id names
    , counterexample "key rev" $ niceSort (map reverse names) ==?
                                 map reverse (niceSortKey reverse names)
    , counterexample "key snd" $ n_sorted ==? map snd (niceSortKey snd $
                                                       zip numbers names)
    ]
  
  -- | Tests 'rStripSpace'.
  prop_rStripSpace :: NonEmptyList Char -> Property
  prop_rStripSpace (NonEmpty str) =
    forAll (resize 50 $ listOf1 (arbitrary `suchThat` isSpace)) $ \whitespace ->
    conjoin [ counterexample "arb. string last char is not space" $
                case nonEmpty $ rStripSpace str of
                  Nothing -> True
                  Just xs -> not . isSpace $ NonEmpty.last xs
            , counterexample "whitespace suffix is stripped" $
                rStripSpace str ==? rStripSpace (str ++ whitespace)
            , counterexample "whitespace reduced to null" $
                rStripSpace whitespace ==? ""
            , counterexample "idempotent on empty strings" $
                rStripSpace "" ==? ""
            ]
  
  -- | Tests that the newUUID function produces valid UUIDs.
  case_new_uuid :: Assertion
  case_new_uuid = do
    uuid <- newUUID
    assertBool "newUUID" $ isUUID uuid
  
  {-# ANN case_new_uuid_regex "HLint: ignore Use camelCase" #-}
  
  -- | Tests that the newUUID function produces valid UUIDs.
  case_new_uuid_regex :: Assertion
  case_new_uuid_regex = do
    uuid <- newUUID
    assertBool "newUUID" $ uuid =~ C.uuidRegex
  
  
  -- | Test normal operation for 'chompPrefix'.
  --
  -- Any random prefix of a string must be stripped correctly, including the empty
  -- prefix, and the whole string.
  prop_chompPrefix_normal :: String -> Property
  prop_chompPrefix_normal str =
    forAll (choose (0, length str)) $ \size ->
    chompPrefix (take size str) str ==? (Just $ drop size str)
  
  -- | Test that 'chompPrefix' correctly allows the last char (the separator) to
  -- be absent if the string terminates there.
  prop_chompPrefix_last :: Property
  prop_chompPrefix_last =
    forAll (choose (1, 20)) $ \len ->
    forAll (vectorOf len arbitrary) $ \pfx ->
    chompPrefix pfx pfx ==? Just "" .&&.
    chompPrefix pfx (init pfx) ==? Just ""
  
  -- | Test that chompPrefix on the empty string always returns Nothing for
  -- prefixes of length 2 or more.
  prop_chompPrefix_empty_string :: Property
  prop_chompPrefix_empty_string =
    forAll (choose (2, 20)) $ \len ->
    forAll (vectorOf len arbitrary) $ \pfx ->
    chompPrefix pfx "" ==? Nothing
  
  -- | Test 'chompPrefix' returns Nothing when the prefix doesn't match.
  prop_chompPrefix_nothing :: Property
  prop_chompPrefix_nothing =
    forAll (choose (1, 20)) $ \len ->
    forAll (vectorOf len arbitrary) $ \pfx ->
    forAll (arbitrary `suchThat`
            (\s -> not (pfx `isPrefixOf` s) && s /= init pfx)) $ \str ->
    chompPrefix pfx str ==? Nothing
  
  -- | Tests 'trim'.
  prop_trim :: NonEmptyList Char -> Property
  prop_trim (NonEmpty str) =
    forAll (listOf1 $ elements " \t\n\r\f") $ \whitespace ->
    forAll (choose (0, length whitespace)) $ \n ->
    let (preWS, postWS) = splitAt n whitespace in
    conjoin [ counterexample "arb. string first and last char are not space" $
                case nonEmpty $ trim str of
                  Nothing -> True
                  Just xs ->
                      (not . isSpace . NonEmpty.head) xs
                      &&
                      (not . isSpace . NonEmpty.last) xs
            , counterexample "whitespace is striped" $
                trim str ==? trim (preWS ++ str ++ postWS)
            , counterexample "whitespace reduced to null" $
                trim whitespace ==? ""
            , counterexample "idempotent on empty strings" $
                trim "" ==? ""
            ]
  
  -- | Tests 'splitEithers' and 'recombineEithers'.
  prop_splitRecombineEithers :: [Either Int Int] -> Property
  prop_splitRecombineEithers es =
    conjoin
    [ counterexample "only lefts are mapped correctly" $
      splitEithers (map Left lefts) ==? (reverse lefts, emptylist, falses)
    , counterexample "only rights are mapped correctly" $
      splitEithers (map Right rights) ==? (emptylist, reverse rights, trues)
    , counterexample "recombination is no-op" $
      recombineEithers splitleft splitright trail ==? Ok es
    , counterexample "fail on too long lefts" $
      isBad (recombineEithers (0:splitleft) splitright trail)
    , counterexample "fail on too long rights" $
      isBad (recombineEithers splitleft (0:splitright) trail)
    , counterexample "fail on too long trail" $
      isBad (recombineEithers splitleft splitright (True:trail))
    ]
    where (lefts, rights) = Either.partitionEithers es
          falses = map (const False) lefts
          trues = map (const True) rights
          (splitleft, splitright, trail) = splitEithers es
          emptylist = []::[Int]
  
  testSuite "Utils"
              [ 'prop_commaJoinSplit
              , 'prop_commaSplitJoin
              , 'prop_findFirst
              , 'prop_fromObjWithDefault
              , 'prop_if'if
              , 'prop_select
              , 'prop_select_undefd
              , 'prop_select_undefv
              , 'prop_parseUnit
              , 'case_niceSort_static
              , 'prop_niceSort_single
              , 'prop_niceSort_generic
              , 'prop_niceSort_numbers
              , 'prop_niceSortKey_equiv
              , 'prop_rStripSpace
              , 'prop_trim
              , 'case_new_uuid
              , 'case_new_uuid_regex
              , 'prop_chompPrefix_normal
              , 'prop_chompPrefix_last
              , 'prop_chompPrefix_empty_string
              , 'prop_chompPrefix_nothing
              , 'prop_splitRecombineEithers
              ]
  