{-# LANGUAGE TypeApplications #-}
module Test.Spec.NewPayment (
      spec

    -- Public to be used by other testing modules.
    , Fixture (..)
    , withFixture
    , withPayment
  ) where

import           Universum

import           Control.Lens (to)

import           Test.Hspec (Spec, describe, shouldBe, shouldSatisfy)
import           Test.Hspec.QuickCheck (prop)
import           Test.QuickCheck (arbitrary, choose, withMaxSuccess)
import           Test.QuickCheck.Monadic (PropertyM, monadicIO, pick)

import qualified Data.ByteString as B
import qualified Data.Map.Strict as M

import           Data.Acid (update)
import           Formatting (build, formatToString, sformat)

import           Pos.Chain.Txp (TxOut (..), TxOutAux (..))
import           Pos.Core (Address, Coin (..), IsBootstrapEraAddr (..),
                     deriveLvl2KeyPair, mkCoin)
import           Pos.Core.NetworkMagic (NetworkMagic (..), makeNetworkMagic)
import           Pos.Crypto (EncryptedSecretKey, ProtocolMagic,
                     ShouldCheckPassphrase (..), emptyPassphrase,
                     safeDeterministicKeyGen)

import           Test.Spec.CoinSelection.Generators (InitialBalance (..),
                     Pay (..), genPayeeWithNM, genUtxoWithAtLeast)

import qualified Cardano.Wallet.API.V1.Types as V1
import qualified Cardano.Wallet.Kernel as Kernel

import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
                     (CoinSelectionOptions (..), ExpenseRegulation (..),
                     InputGrouping (..), newOptions)
import           Cardano.Wallet.Kernel.DB.AcidState
import           Cardano.Wallet.Kernel.DB.HdWallet (AssuranceLevel (..),
                     HasSpendingPassword (..), HdAccountId (..),
                     HdAccountIx (..), HdAddressIx (..), HdRootId (..),
                     WalletName (..), eskToHdRootId, hdAccountIdIx)
import           Cardano.Wallet.Kernel.DB.HdWallet.Create (initHdRoot)
import           Cardano.Wallet.Kernel.DB.HdWallet.Derivation
                     (HardeningMode (..), deriveIndex)
import           Cardano.Wallet.Kernel.DB.InDb (InDb (..))
import           Cardano.Wallet.Kernel.Internal (ActiveWallet, PassiveWallet,
                     wallets)
import qualified Cardano.Wallet.Kernel.Keystore as Keystore
import qualified Cardano.Wallet.Kernel.NodeStateAdaptor as Node
import qualified Cardano.Wallet.Kernel.PrefilterTx as Kernel
import qualified Cardano.Wallet.Kernel.Transactions as Kernel
import           Cardano.Wallet.Kernel.Types (AccountId (..), WalletId (..))
import qualified Cardano.Wallet.Kernel.Wallets as Kernel
import           Cardano.Wallet.WalletLayer (ActiveWalletLayer)
import qualified Cardano.Wallet.WalletLayer as WalletLayer
import qualified Cardano.Wallet.WalletLayer.Kernel.Conv as Kernel.Conv

import qualified Test.Spec.Fixture as Fixture
import           Util.Buildable (ShowThroughBuild (..))

import qualified Cardano.Wallet.API.V1.Handlers.Transactions as Handlers
import           Control.Monad.Except (runExceptT)
import           Servant.Server


{-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}

data Fixture = Fixture {
      fixtureHdRootId  :: HdRootId
    , fixtureESK       :: EncryptedSecretKey
    , fixtureAccountId :: AccountId
    , fixturePw        :: PassiveWallet
    , fixturePayees    :: NonEmpty (Address, Coin)
    }

-- | Prepare some fixtures using the 'PropertyM' context to prepare the data,
-- and execute the 'acid-state' update once the 'PassiveWallet' gets into
-- scope (after the bracket initialisation).
prepareFixtures :: NetworkMagic
                -> InitialBalance
                -> Pay
                -> Fixture.GenActiveWalletFixture Fixture
prepareFixtures nm initialBalance toPay = do
    let (_, esk) = safeDeterministicKeyGen (B.pack $ replicate 32 0x42) mempty
    let newRootId = eskToHdRootId nm esk
    newRoot <- initHdRoot <$> pure newRootId
                          <*> pure (WalletName "A wallet")
                          <*> pure NoSpendingPassword
                          <*> pure AssuranceLevelNormal
                          <*> (InDb <$> pick arbitrary)
    newAccountId <- HdAccountId newRootId <$> deriveIndex (pick . choose) HdAccountIx HardDerivation
    utxo   <- pick (genUtxoWithAtLeast initialBalance)
    -- Override all the addresses of the random Utxo with something meaningful,
    -- i.e. with 'Address'(es) generated in a principled way, and not random.
    utxo' <- foldlM (\acc (txIn, (TxOutAux (TxOut _ coin))) -> do
                        newIndex <- deriveIndex (pick . choose) HdAddressIx HardDerivation

                        let Just (addr, _) = deriveLvl2KeyPair nm
                                                               (IsBootstrapEraAddr True)
                                                               (ShouldCheckPassphrase True)
                                                               mempty
                                                               esk
                                                               (newAccountId ^. hdAccountIdIx . to getHdAccountIx)
                                                               (getHdAddressIx newIndex)
                        return $ M.insert txIn (TxOutAux (TxOut addr coin)) acc
                    ) M.empty (M.toList utxo)
    payees <- fmap (\(TxOut addr coin) -> (addr, coin)) <$> pick (genPayeeWithNM nm utxo toPay)

    return $ \keystore aw -> do
        liftIO $ Keystore.insert (WalletIdHdRnd newRootId) esk keystore
        let pw = Kernel.walletPassive aw

        let accounts    = Kernel.prefilterUtxo nm newRootId esk utxo'
            hdAccountId = Kernel.defaultHdAccountId newRootId
            hdAddress   = Kernel.defaultHdAddress nm esk emptyPassphrase newRootId

        void $ liftIO $ update (pw ^. wallets) (CreateHdWallet newRoot hdAccountId hdAddress accounts)
        return $ Fixture {
                           fixtureHdRootId = newRootId
                         , fixtureAccountId = AccountIdHdRnd newAccountId
                         , fixtureESK = esk
                         , fixturePw  = pw
                         , fixturePayees = payees
                         }

withFixture :: MonadIO m
            => ProtocolMagic
            -> InitialBalance
            -> Pay
            -> (  Keystore.Keystore
               -> ActiveWalletLayer m
               -> ActiveWallet
               -> Fixture
               -> IO a
               )
            -> PropertyM IO a
withFixture pm initialBalance toPay cc =
    Fixture.withActiveWalletFixture pm (prepareFixtures nm initialBalance toPay) cc
  where
    nm = makeNetworkMagic pm

-- | A constant fee calculation.
constantFee :: Int -> NonEmpty Coin -> Coin
constantFee _ _ = mkCoin 10

-- | Helper function to facilitate payments via the Layer or Servant.
withPayment :: MonadIO n
            => ProtocolMagic
            -> InitialBalance
            -- ^ How big the wallet Utxo must be
            -> Pay
            -- ^ How big the payment must be
            -> (ActiveWalletLayer n -> V1.Payment -> IO ())
            -- ^ The action to run.
            -> PropertyM IO ()
withPayment pm initialBalance toPay action = do
    withFixture pm initialBalance toPay $ \keystore activeLayer _ Fixture{..} -> do
        liftIO $ Keystore.insert (WalletIdHdRnd fixtureHdRootId) fixtureESK keystore
        let (AccountIdHdRnd hdAccountId)  = fixtureAccountId
        let (HdRootId (InDb rootAddress)) = fixtureHdRootId
        let sourceWallet = V1.WalletId (sformat build rootAddress)
        let accountIndex = Kernel.Conv.toAccountId hdAccountId
        let destinations =
                fmap (\(addr, coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin)
                     ) fixturePayees
        let newPayment = V1.Payment {
                         pmtSource           = V1.PaymentSource sourceWallet accountIndex
                       , pmtDestinations     = destinations
                       , pmtGroupingPolicy   = Nothing
                       , pmtSpendingPassword = Nothing
                       }
        action activeLayer newPayment

spec :: Spec
spec = describe "NewPayment" $ do

    describe "Generating a new payment (wallet layer)" $ do

        prop "pay works (realSigner, SenderPaysFee)" $ withMaxSuccess 5 $ do
            monadicIO $ do
                pm <- pick arbitrary
                withPayment pm (InitialADA 10000) (PayLovelace 10) $ \activeLayer newPayment -> do
                    res <- liftIO ((WalletLayer.pay activeLayer) mempty
                                                                 IgnoreGrouping
                                                                 SenderPaysFee
                                                                 newPayment
                                  )
                    liftIO ((bimap STB STB res) `shouldSatisfy` isRight)

    describe "Generating a new payment (kernel)" $ do
        prop "newTransaction works (real signer, SenderPaysFee)" $ withMaxSuccess 5 $ do
            monadicIO $ do
                pm <- pick arbitrary
                withFixture @IO pm (InitialADA 10000) (PayLovelace 10) $ \_ _ aw Fixture{..} -> do
                    policy <- Node.getFeePolicy (Kernel.walletPassive aw ^. Kernel.walletNode)
                    let opts = (newOptions (Kernel.cardanoFee policy)) {
                               csoExpenseRegulation = SenderPaysFee
                             , csoInputGrouping     = IgnoreGrouping
                             }
                    let (AccountIdHdRnd hdAccountId) = fixtureAccountId
                    res <- liftIO (Kernel.newTransaction aw
                                                         mempty
                                                         opts
                                                         hdAccountId
                                                         fixturePayees
                                  )
                    liftIO ((bimap STB (const $ STB ()) res) `shouldSatisfy` isRight)

        prop "newTransaction works (ReceiverPaysFee)" $ withMaxSuccess 5 $ do
            monadicIO $ do
                pm <- pick arbitrary
                withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
                    policy <- Node.getFeePolicy (Kernel.walletPassive aw ^. Kernel.walletNode)
                    let opts = (newOptions (Kernel.cardanoFee policy)) {
                               csoExpenseRegulation = ReceiverPaysFee
                             , csoInputGrouping     = IgnoreGrouping
                             }
                    let (AccountIdHdRnd hdAccountId) = fixtureAccountId
                    res <- liftIO (Kernel.newTransaction aw
                                                         mempty
                                                         opts
                                                         hdAccountId
                                                         fixturePayees
                                  )
                    liftIO ((bimap STB (const $ STB ()) res) `shouldSatisfy` isRight)

    describe "Generating a new payment (Servant)" $ do

        prop "works as expected in the happy path scenario" $ withMaxSuccess 5 $
            monadicIO $ do
                pm <- pick arbitrary
                withPayment pm (InitialADA 1000) (PayADA 1) $ \activeLayer newPayment -> do
                    res <- liftIO (runExceptT . runHandler' $ Handlers.newTransaction activeLayer newPayment)
                    liftIO ((bimap identity STB res) `shouldSatisfy` isRight)

    describe "EstimateFees" $ do

        describe "Estimating fees (wallet layer)" $ do

            prop "estimating fees works (SenderPaysFee)" $ withMaxSuccess 5 $ do
                monadicIO $ do
                    pm <- pick arbitrary
                    withPayment pm (InitialADA 10000) (PayLovelace 10) $ \activeLayer newPayment -> do
                        res <- liftIO ((WalletLayer.estimateFees activeLayer) IgnoreGrouping
                                                                              SenderPaysFee
                                                                              newPayment
                                      )
                        case res of
                             Left e  -> fail (formatToString build e)
                             Right fee ->
                                 fee `shouldSatisfy` (> (Coin 0))

        describe "Estimating fees (kernel)" $ do
            prop "estimating fees works (SenderPaysFee)" $ withMaxSuccess 5 $
                monadicIO $ do
                    pm <- pick arbitrary
                    withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
                        let opts = (newOptions constantFee) {
                                   csoExpenseRegulation = SenderPaysFee
                                 , csoInputGrouping     = IgnoreGrouping
                                 }
                        let (AccountIdHdRnd hdAccountId) = fixtureAccountId

                        res <- liftIO (Kernel.estimateFees aw
                                                           opts
                                                           hdAccountId
                                                           fixturePayees
                                      )

                        case res of
                             Left e  -> fail (formatToString build e)
                             Right x -> x `shouldBe` Coin 10

            prop "estimating fees works (kernel, ReceiverPaysFee)" $ withMaxSuccess 5 $
                monadicIO $ do
                    pm <- pick arbitrary
                    withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
                        let opts = (newOptions constantFee) {
                                   csoExpenseRegulation = SenderPaysFee
                                 , csoInputGrouping     = IgnoreGrouping
                                 }
                        let (AccountIdHdRnd hdAccountId) = fixtureAccountId

                        res <- liftIO (Kernel.estimateFees aw
                                                           opts
                                                           hdAccountId
                                                           fixturePayees
                                      )

                        case res of
                             Left e  -> fail (formatToString build e)
                             Right x -> x `shouldBe` Coin 10

            prop "estimating fees works (kernel, SenderPaysFee, cardanoFee)" $ withMaxSuccess 5 $
                monadicIO $ do
                    pm <- pick arbitrary
                    withFixture @IO pm (InitialADA 10000) (PayADA 1) $ \_ _ aw Fixture{..} -> do
                        policy <- Node.getFeePolicy (Kernel.walletPassive aw ^. Kernel.walletNode)
                        let opts = (newOptions (Kernel.cardanoFee policy)) {
                                   csoExpenseRegulation = SenderPaysFee
                                 , csoInputGrouping     = IgnoreGrouping
                                 }
                        let (AccountIdHdRnd hdAccountId) = fixtureAccountId

                        res <- liftIO (Kernel.estimateFees aw
                                                           opts
                                                           hdAccountId
                                                           fixturePayees
                                      )

                        case res of
                             Left e  -> fail (formatToString build e)
                             Right x -> x `shouldSatisfy` (> (Coin 0))

        describe "Estimating fees (Servant)" $ do
            prop "works as expected in the happy path scenario" $ withMaxSuccess 5 $
                monadicIO $ do
                    pm <- pick arbitrary
                    withPayment pm (InitialADA 1000) (PayADA 1) $ \activeLayer newPayment -> do
                        res <- liftIO (runExceptT . runHandler' $ Handlers.estimateFees activeLayer newPayment)
                        liftIO ((bimap identity STB res) `shouldSatisfy` isRight)

            -- The 'estimateFee' endpoint doesn't require a spendingPassword, but
            -- the 'Payment' type does come with an optional 'spendingPassword' field.
            -- Here we want to check this is completely ignored.
            prop "ignores completely the spending password in Payment" $ withMaxSuccess 5 $
                monadicIO $ do
                    randomPass <- pick arbitrary
                    pm         <- pick arbitrary
                    withPayment pm (InitialADA 1000) (PayADA 1) $ \activeLayer newPayment -> do
                        -- mangle the spending password to be something arbitrary, check
                        -- that this doesn't hinder our ability to estimate fees.
                        let pmt = newPayment { V1.pmtSpendingPassword = randomPass }
                        res <- liftIO (runExceptT . runHandler' $ Handlers.estimateFees activeLayer pmt)
                        liftIO ((bimap identity STB res) `shouldSatisfy` isRight)
