{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-| Unittests for ganeti-htools.



Copyright (C) 2009, 2010, 2011, 2012 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.


module Test.Ganeti.Confd.Utils (testConfd_Utils) where

import Test.QuickCheck
import qualified Text.JSON as J

import Test.Ganeti.TestHelper
import Test.Ganeti.TestCommon
import Test.Ganeti.Confd.Types ()

import qualified Ganeti.BasicTypes as BasicTypes
import qualified Ganeti.Confd.Types as Confd
import qualified Ganeti.Confd.Utils as Confd.Utils
import qualified Ganeti.Constants as C
import qualified Ganeti.Hash as Hash

-- | Test that signing messages and checking signatures is correct. It
-- also tests, indirectly the serialisation of messages so we don't
-- need a separate test for that.
prop_req_sign :: Hash.HashKey        -- ^ The hash key
              -> NonNegative Integer -- ^ The base timestamp
              -> Positive Integer    -- ^ Delta for out of window
              -> Bool                -- ^ Whether delta should be + or -
              -> Confd.ConfdRequest
              -> Property
prop_req_sign key (NonNegative timestamp) (Positive bad_delta)
                         pm crq =
  forAll (choose (0, fromIntegral C.confdMaxClockSkew)) $ \ good_delta ->
  let encoded = J.encode crq
      salt = show timestamp
      signed = J.encode $ Confd.Utils.signMessage key salt encoded
      good_timestamp = timestamp + if pm then good_delta else (-good_delta)
      bad_delta' = fromIntegral C.confdMaxClockSkew + bad_delta
      bad_timestamp = timestamp + if pm then bad_delta' else (-bad_delta')
      ts_ok = Confd.Utils.parseRequest key signed good_timestamp
      ts_bad = Confd.Utils.parseRequest key signed bad_timestamp
  in printTestCase "Failed to parse good message"
       (ts_ok ==? BasicTypes.Ok (encoded, crq)) .&&.
     printTestCase ("Managed to deserialise message with bad\
                    \ timestamp, got " ++ show ts_bad)
       (ts_bad ==? BasicTypes.Bad "Too old/too new timestamp or clock skew")

-- | Tests that a ConfdReply can be properly encoded, signed and parsed using
-- the proper salt, but fails parsing with the wrong salt.
prop_rep_salt :: Hash.HashKey     -- ^ The hash key
              -> Confd.ConfdReply -- ^ A Confd reply
              -> Property
prop_rep_salt hmac reply =
  forAll arbitrary $ \salt1 ->
  forAll (arbitrary `suchThat` (/= salt1)) $ \salt2 ->
  let innerMsg = J.encode reply
      msg = J.encode $ Confd.Utils.signMessage hmac salt1 innerMsg
    Confd.Utils.parseReply hmac msg salt1 ==? BasicTypes.Ok (innerMsg, reply)
      .&&. Confd.Utils.parseReply hmac msg salt2 ==?
           BasicTypes.Bad "The received salt differs from the expected salt"

-- | Tests that signing with a different key fails detects failure
-- correctly.
prop_bad_key :: String             -- ^ Salt
             -> Confd.ConfdRequest -- ^ Request
             -> Property
prop_bad_key salt crq =
  -- fixme: we hardcode here the expected length of a sha1 key, as
  -- otherwise we could have two short keys that differ only in the
  -- final zero elements count, and those will be expanded to be the
  -- same
  forAll (vector 20) $ \key_sign ->
  forAll (vector 20 `suchThat` (/= key_sign)) $ \key_verify ->
  let signed = Confd.Utils.signMessage key_sign salt (J.encode crq)
      encoded = J.encode signed
  in printTestCase ("Accepted message signed with different key" ++ encoded) $
     (Confd.Utils.parseSignedMessage key_verify encoded
      :: BasicTypes.Result (String, String, Confd.ConfdRequest)) ==?
       BasicTypes.Bad "HMAC verification failed"

testSuite "Confd/Utils"
  [ 'prop_req_sign
  , 'prop_rep_salt
  , 'prop_bad_key