content: module Test.Spec.Models (
      spec
    ) where
  
  import           Universum
  
  import qualified Data.Set as Set
  
  import           Test.Infrastructure.Generator
  import           Util.Buildable.Hspec
  import           Util.Buildable.QuickCheck
  
  import           UTxO.Bootstrap
  import           UTxO.Context
  import           UTxO.DSL
  import           UTxO.Translate
  
  import           Wallet.Abstract
  import           Wallet.Inductive
  import           Wallet.Inductive.Invariants
  import           Wallet.Inductive.Validation
  
  import qualified Wallet.Basic as Base
  import qualified Wallet.Incremental as Incr
  import qualified Wallet.Prefiltered as Pref
  import qualified Wallet.Rollback.Basic as Roll
  import qualified Wallet.Rollback.Full as Full
  
  import           Pos.Core (Coeff (..), TxSizeLinear (..))
  import           Pos.Crypto (ProtocolMagic (..), RequiresNetworkMagic (..))
  
  {-------------------------------------------------------------------------------
    Pure wallet tests
  -------------------------------------------------------------------------------}
  
  -- | Test the pure wallet models
  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 "Test pure wallets" $ do
        it "Using simple model" $
          forAll (genInductiveUsingModel simpleModel) $ testPureWalletWith
        it "Using Cardano model" $
          forAll (genInductiveUsingModel (cardanoModel linearFeePolicy ourActorIx allAddrs boot)) $
              testPureWalletWith
    where
      ourActorIx   = 0
      allAddrs     = transCtxtAddrs transCtxt
  
      transCtxt = runTranslateNoErrors pm ask
      boot      = bootstrapTransaction transCtxt
      linearFeePolicy = TxSizeLinear (Coeff 155381) (Coeff 43.946)
  
  testPureWalletWith :: forall h a. (Hash h a, Ord a, Buildable a)
                     => Inductive h a -> Property
  testPureWalletWith indWithRoll = conjoin [
        -- sanity check on the test
        shouldBeValidated (void (inductiveIsValid indWithRoll))
  
        -- check that the invariants hold in each model
      , checkInvariants NoRollback    "base" indDontRoll baseEmpty
      , checkInvariants NoRollback    "incr" indDontRoll incrEmpty
      , checkInvariants NoRollback    "pref" indDontRoll prefEmpty
      , checkInvariants BasicRollback "roll" indWithRoll rollEmpty
      , checkInvariants FullRollback  "full" indWithRoll fullEmpty
  
        -- check equivalence between the models (no rollbacks)
      , checkEquivalent "base/incr" indDontRoll baseEmpty incrEmpty
      , checkEquivalent "base/pref" indDontRoll baseEmpty prefEmpty
      , checkEquivalent "base/roll" indDontRoll baseEmpty rollEmpty
      , checkEquivalent "base/full" indDontRoll baseEmpty fullEmpty
  
        -- check equivalence between models (with rollbacks)
      , checkEquivalent "roll/full" indWithRoll rollEmpty fullEmpty
      ]
    where
      -- Prefix of the 'Inductive' without any rollbacks
      indDontRoll :: Inductive h a
      indDontRoll = uptoFirstRollback indWithRoll
  
      checkInvariants :: ApplicableInvariants
                      -> Text
                      -> Inductive h a
                      -> (Set a -> Transaction h a -> Wallet h a)
                      -> Expectation
      checkInvariants applicableInvariants label ind@Inductive{..} w =
          shouldBeValidated $
            walletInvariants applicableInvariants label (w inductiveOurs) ind
  
      checkEquivalent :: Text
                      -> Inductive h a
                      -> (Set a -> Transaction h a -> Wallet h a)
                      -> (Set a -> Transaction h a -> Wallet h a)
                      -> Expectation
      checkEquivalent label ind@Inductive{..} w w' =
          shouldBeValidated $
            walletEquivalent label (w inductiveOurs) (w' inductiveOurs) ind
  
      oursFromSet :: Set a -> Ours a
      oursFromSet = flip Set.member
  
      baseEmpty :: Set a -> Transaction h a -> Wallet h a
      incrEmpty :: Set a -> Transaction h a -> Wallet h a
      prefEmpty :: Set a -> Transaction h a -> Wallet h a
      rollEmpty :: Set a -> Transaction h a -> Wallet h a
      fullEmpty :: Set a -> Transaction h a -> Wallet h a
  
      baseEmpty = walletBoot Base.walletEmpty . oursFromSet
      incrEmpty = walletBoot Incr.walletEmpty . oursFromSet
      prefEmpty = walletBoot Pref.walletEmpty . oursFromSet
      rollEmpty = walletBoot Roll.walletEmpty . oursFromSet
      fullEmpty = walletBoot Full.walletEmpty . oursFromSet
  