content: {-# LANGUAGE RecordWildCards #-}
  
  -- | Tests for 'VssCertData': certificates with TTL.
  
  module Test.Pos.Ssc.VssCertDataSpec
         ( spec
         ) where
  
  import           Universum hiding (id)
  
  import qualified Data.HashMap.Strict as HM
  import qualified Data.HashSet as HS
  import           Data.List.Extra (nubOrdOn)
  import qualified Data.Set as S
  import           Data.Tuple (swap)
  import           Test.Hspec (Spec, describe, runIO)
  import           Test.Hspec.QuickCheck (prop)
  import           Test.QuickCheck (Arbitrary (..), Gen, Property, choose,
                       conjoin, counterexample, generate, suchThat, vectorOf,
                       (.&&.), (==>))
  
  import           Pos.Chain.Ssc (SscGlobalState (..), VssCertData (..),
                       VssCertificate (..), expiryEoS, getCertId,
                       getVssCertificatesMap, mkVssCertificate, rollbackSsc,
                       runPureToss, setLastKnownSlot, sgsVssCertificates)
  import qualified Pos.Chain.Ssc as Ssc
  import           Pos.Core (EpochIndex (..), EpochOrSlot (..), SlotId (..))
  import           Pos.Core.Chrono (NewestFirst (..))
  import           Pos.Core.Slotting (flattenEpochOrSlot, unflattenSlotId)
  import           Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..))
  
  import           Test.Pos.Chain.Genesis.Dummy (dummyEpochSlots,
                       dummySlotSecurityParam)
  import           Test.Pos.Core.Arbitrary ()
  import           Test.Pos.Infra.Arbitrary.Ssc ()
  import           Test.Pos.Util.QuickCheck.Property (qcIsJust)
  
  spec :: Spec
  spec = do
      runWithMagic RequiresNoMagic
      runWithMagic RequiresMagic
  
  runWithMagic :: RequiresNetworkMagic -> Spec
  runWithMagic rnm = do
      pm <- (\ident -> ProtocolMagic ident rnm) <$> runIO (generate arbitrary)
      describe ("(requiresNetworkMagic=" ++ show rnm ++ ")") $
          specBody pm
  
  specBody :: ProtocolMagic -> Spec
  specBody _pm = describe "Ssc.VssCertData" $ do
      describe "verifyInsertVssCertData" $
          prop description_verifyInsertVssCertData verifyInsertVssCertData
      describe "verifyDeleteVssCertData" $
          prop description_verifyDeleteVssCertData verifyDeleteVssCertData
      describe "verifyCorrectVssCertDataIsConsistent" $
          prop description_verifyCorrectVssCertDataIsConsistent isConsistent
      describe "verifySetLastKnownSlot" $
          prop description_verifySetLastKnownSlot verifySetLastKnownSlot
      describe "verifyDeleteAndFilter" $
          prop description_verifyDeleteAndFilter verifyDeleteAndFilter
      describe "verifyRollback" $
          prop description_verifyRollback verifyRollback
    where
      description_verifyInsertVssCertData =
          "successfully verifies if certificate is in certificate data\
          \ after insertion this certificate in data"
      description_verifyDeleteVssCertData =
          "successfully verifies if certificate is not in certificate data\
          \ after deletion of this certificate from data"
      description_verifyCorrectVssCertDataIsConsistent =
          "successfully verifies if inserts create consistent VssCertData"
      description_verifySetLastKnownSlot =
          "successfully verifies if new last known slot is set properly"
      description_verifyDeleteAndFilter =
          "successfully verifies if filter saves consistency"
      description_verifyRollback =
          "successfully rollsback certificates older than slot to which state was rolled\
          \ back to"
  
  ----------------------------------------------------------------------------
  -- Utility functions not present in VssCertData
  ----------------------------------------------------------------------------
  
  expiresAfter :: VssCertificate -> EpochOrSlot -> Bool
  expiresAfter certificate expirySlot = expiryEoS certificate > expirySlot
  
  canBeIn :: VssCertificate -> VssCertData -> Bool
  canBeIn certificate certData = certificate `expiresAfter` lastKnownEoS certData
  
  ----------------------------------------------------------------------------
  -- Wrapper around VssCertData which Arbitrary instance should be consistent
  ----------------------------------------------------------------------------
  
  newtype CorrectVssCertData = CorrectVssCertData
      { getVssCertData :: VssCertData
      } deriving (Show)
  
  instance Arbitrary CorrectVssCertData where
      arbitrary = (CorrectVssCertData <$>) $ do
          certificatesToAdd <- choose (0, 100)
          lkeos             <- arbitrary :: Gen EpochOrSlot
          let notExpiredGen  = arbitrary `suchThat` (`expiresAfter` lkeos)
          vssCertificates   <- vectorOf @VssCertificate certificatesToAdd notExpiredGen
          let dataUpdaters   = map Ssc.insert vssCertificates
          pure $ foldl' (&) (Ssc.empty {lastKnownEoS = lkeos}) dataUpdaters
  
  ----------------------------------------------------------------------------
  -- Properties for VssCertData
  ----------------------------------------------------------------------------
  
  verifyInsertVssCertData :: VssCertificate -> VssCertData -> Property
  verifyInsertVssCertData certificate certData =
      certificate `canBeIn` certData ==>
      counterexample
          ("expected " <> show shid <> " to be in certdata")
          (shid `Ssc.member` Ssc.insert certificate certData)
    where
      shid = getCertId certificate
  
  verifyDeleteVssCertData :: VssCertificate -> VssCertData -> Property
  verifyDeleteVssCertData certificate certData =
      let shid = getCertId certificate
          certWithShid    = Ssc.insert certificate certData
          certWithoutShid = Ssc.delete shid certWithShid
      in  counterexample
              ("expected " <> show shid <> " not to be in certdata")
              (not (shid `Ssc.member` certWithoutShid))
  
  -- | This function checks all imaginable properties for correctly created 'VssCertData'.
  -- TODO: some checks are not assimptotically efficient but nobody cares untill time is reasonable
  isConsistent :: CorrectVssCertData -> Bool
  isConsistent (getVssCertData -> VssCertData{..}) =
         -- (1) all certificates inserted not later than lastknownslot
         all (<= lastKnownEoS) insertedSlots
         -- (2) all expiredslots greater than lastKnownSlot
      && all (>  lastKnownEoS) expiredSlots
         -- (3) @certs@ keys and @certsIns@ keys are equal
      && certsStakeholders == certsInsStakeholders
         -- (4) @insSlotset@ equals to hashmap of @certsInts@
      && slotsFromCertsIns == whenInsSet
         -- (5) there is expiry slot for every inserted certificate
      && insSlotSetStakeholders == expirySlotSetStakeholders
         -- (*) every expire slot strictly greater than corresponding inserted slot
         -- consequence of (1) && (2) && (5)
         -- && all (\(expireSlot, shid) -> certsIns ! shid < expireSlot) expirySlotPairs
         -- (6) intersection of expired certificates and not expired is empty
      && null (notExpiredCertificates `S.intersection` expiredCertificates)
         -- (7) all expired certificates are stored for no longer than +epochSlots from lks
      && all (<= addEpoch lastKnownEoS) expiredCertificatesSlots
    where
      insSlotSetPairs           = S.toList whenInsSet
      expirySlotSetPairs        = S.toList whenExpire
      insertedSlots             = map fst insSlotSetPairs
      expiredSlots              = map fst expirySlotSetPairs
      certsStakeholders         = S.fromList $ HM.keys $ getVssCertificatesMap certs
      certsInsStakeholders      = S.fromList $ HM.keys whenInsMap
      slotsFromCertsIns         = S.fromList $ map swap $ HM.toList whenInsMap
      insSlotSetStakeholders    = S.fromList $ map snd insSlotSetPairs
      expirySlotSetStakeholders = S.fromList $ map snd expirySlotSetPairs
      notExpiredCertificates    = S.fromList $ toList certs
      expiredCertificatesData   = S.toList expiredCerts
      expiredCertificatesSlots  = map fst expiredCertificatesData
      expiredCertificates       = S.fromList $ map (view _3 . snd) expiredCertificatesData
  
      addEpoch :: EpochOrSlot -> EpochOrSlot
      addEpoch (EpochOrSlot (Left (EpochIndex epoch))) =
          EpochOrSlot $ Left $ EpochIndex $ epoch + 1
      addEpoch (EpochOrSlot (Right (SlotId ep sl))) =
          EpochOrSlot $ Right $ SlotId (ep + 1) sl
  
  verifySetLastKnownSlot :: SlotId -> CorrectVssCertData -> Bool
  verifySetLastKnownSlot newLks (CorrectVssCertData vssCertData) =
      isConsistent $ CorrectVssCertData $ setLastKnownSlot newLks vssCertData
  
  -- | Verifies that filter (and 'delete' as consequences) save consintency.
  -- TODO: add more checks here?
  verifyDeleteAndFilter :: CorrectVssCertData -> Bool
  verifyDeleteAndFilter (getVssCertData -> vcd@VssCertData{..}) =
      let certificatesHolders = Ssc.keys vcd
          holdersLength       = length certificatesHolders
          halfOfHolders       = take (holdersLength `div` 2) certificatesHolders
          setFromHalf         = HS.fromList halfOfHolders
          resultVcd           = Ssc.filter (`HS.member` setFromHalf) vcd
          resultCorrectVcd    = CorrectVssCertData resultVcd
      in isConsistent resultCorrectVcd
  
  data RollbackData = Rollback SscGlobalState EpochOrSlot [VssCertificate]
      deriving (Show, Eq)
  
  instance Arbitrary RollbackData where
      arbitrary = do
          goodVssCertData@(VssCertData {..}) <- getVssCertData <$> arbitrary
          certsToRollbackN <- choose (0, 100) >>= choose . (0,)
          slotsToRollback <- choose (1, dummySlotSecurityParam)
          let lastKEoSWord = flattenEpochOrSlot dummyEpochSlots lastKnownEoS
              rollbackFrom = fromIntegral slotsToRollback + lastKEoSWord
              rollbackGen = do
                  sk <- arbitrary
                  binVssPK <- arbitrary
                  thisEpoch <-
                      siEpoch . unflattenSlotId dummyEpochSlots <$>
                          choose (succ lastKEoSWord, rollbackFrom)
                  pm <- arbitrary
                  return $ mkVssCertificate pm sk binVssPK thisEpoch
          certsToRollback <- nubOrdOn vcVssKey <$>
              vectorOf @VssCertificate certsToRollbackN rollbackGen
          return $ Rollback (SscGlobalState mempty mempty mempty goodVssCertData)
                            lastKnownEoS
                            certsToRollback
  
  verifyRollback :: RollbackData -> Gen Property
  verifyRollback (Rollback oldSscGlobalState rollbackEoS vssCerts) = do
      let certAdder vcd = foldl' (flip Ssc.insert) vcd vssCerts
          newSscGlobalState@(SscGlobalState _ _ _ newVssCertData) =
              oldSscGlobalState & sgsVssCertificates %~ certAdder
      (_, SscGlobalState _ _ _ rolledVssCertData, _) <-
          runPureToss newSscGlobalState $
          rollbackSsc dummyEpochSlots rollbackEoS (NewestFirst [])
      pure $ conjoin $ vssCerts <&> \cert ->
          let id = getCertId cert in
          counterexample ("haven't found cert with id " <>
                          show id <> " in newVssCertData")
              (qcIsJust (Ssc.lookup id newVssCertData))
          .&&.
          counterexample ("expected a " <> show (Just cert) <>
                          ", got " <> show (Ssc.lookup id rolledVssCertData) <>
                          " in rolledVssCertData")
              ((/= Just cert) (Ssc.lookup id rolledVssCertData))
  