<commit_before>{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-missing-fields #-}

import Control.Exception.Safe (bracket)
import Control.Lens hiding (elements)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader (ask)
import Data.Foldable (traverse_)
import Data.List (partition)
import Data.Monoid
import Data.Text (Text)
import Database.Persist
import Database.Persist.Postgresql
import RunPersist
import System.Directory
import System.Environment
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Test.QuickCheck.Monadic
import Web.Stripe.Customer
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Types as PG

import Crowdmatch
import Crowdmatch.Model (PledgeAction(..))
import qualified Crowdmatch.Model as Model

-- | Execute a transaction-free statement in Postgres
pgExecute_ q = bracket open' PG.close (void . (`PG.execute_` q))
  where
    open' = PG.connectPostgreSQL ""

instance Arbitrary Text where
    arbitrary = T.pack <$> listOf (elements ['a'..'z'])

instance Arbitrary PaymentToken where
    arbitrary = fmap (PaymentToken . CustomerId) arbitrary

instance Arbitrary TokenId where
    arbitrary = TokenId <$> arbitrary

-- | Use this instead of actually talking to Stripe during tests
dummyStripe :: MonadIO m => StripeI a -> m (Either b a)
dummyStripe = \case
    CreateCustomerI _tok ->
        pure (Right Customer { customerId = CustomerId "dummy" })
    UpdateCustomerI _tok cust ->
        pure (Right Customer { customerId = cust })
    DeleteCustomerI _ ->
        pure (Right ())

type Runner = forall a. SqlPersistT IO a -> IO a

-- | A QuickCheck property that uses database actions
dbProp
    :: SqlPersistT IO () -> Runner -> (Runner -> PropertyM IO ()) -> Property
dbProp truncation runner prop' =
    monadicIO (run (runner truncation) >> prop' runner)

-- | Generate Arbitrary crowdmatch history
genHistory :: Runner -> PropertyM IO ()
genHistory runner = do
    targets <- pick (map HarnessUser <$> listOf (choose (1,1000)))
    let bucket = length targets `div` 5
        b0 = show (bucket * 5)
        b1 = show ((bucket + 1) * 5)
    monitor (label (concat ["N ∈ [", b0,", ",b1 , "]"]))
    -- Running this concurrently causes "impossible" conflicts during
    -- upsert! This needs to be fixed! But on the threat matrix, it is both
    -- unlikely to happen and has minimal side effects (since the DB stays
    -- consistent, after all.) So I'm punting for now.
    traverse_ oneAct targets
  where
    oneAct x =
        -- When new API methods are added, they need to be added here. This is
        -- a problem I don't have a solution to right now.
        (run . getBlind <=< pick) (Blind <$> frequency
            [ (10, storeToken' x)
            , (1, delToken' x)<commit_msg>Define the 'Runner' shorthand in terms of the more general SqlRunner<commit_after>{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans -fno-warn-missing-fields #-}

import Control.Exception.Safe (bracket)
import Control.Lens hiding (elements)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader (ask)
import Data.Foldable (traverse_)
import Data.List (partition)
import Data.Monoid
import Data.Text (Text)
import Database.Persist
import Database.Persist.Postgresql
import RunPersist
import System.Directory
import System.Environment
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Test.QuickCheck.Monadic
import Web.Stripe.Customer
import qualified Data.ByteString.Char8 as B
import qualified Data.Text as T
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Types as PG

import Crowdmatch
import Crowdmatch.Model (PledgeAction(..))
import qualified Crowdmatch.Model as Model

-- | Execute a transaction-free statement in Postgres
pgExecute_ q = bracket open' PG.close (void . (`PG.execute_` q))
  where
    open' = PG.connectPostgreSQL ""

instance Arbitrary Text where
    arbitrary = T.pack <$> listOf (elements ['a'..'z'])

instance Arbitrary PaymentToken where
    arbitrary = fmap (PaymentToken . CustomerId) arbitrary

instance Arbitrary TokenId where
    arbitrary = TokenId <$> arbitrary

-- | Use this instead of actually talking to Stripe during tests
dummyStripe :: MonadIO m => StripeI a -> m (Either b a)
dummyStripe = \case
    CreateCustomerI _tok ->
        pure (Right Customer { customerId = CustomerId "dummy" })
    UpdateCustomerI _tok cust ->
        pure (Right Customer { customerId = cust })
    DeleteCustomerI _ ->
        pure (Right ())

type Runner = SqlRunner IO IO

-- | A QuickCheck property that uses database actions
dbProp
    :: SqlPersistT IO () -> Runner -> (Runner -> PropertyM IO ()) -> Property
dbProp truncation runner prop' =
    monadicIO (run (runner truncation) >> prop' runner)

-- | Generate Arbitrary crowdmatch history
genHistory :: Runner -> PropertyM IO ()
genHistory runner = do
    targets <- pick (map HarnessUser <$> listOf (choose (1,1000)))
    let bucket = length targets `div` 5
        b0 = show (bucket * 5)
        b1 = show ((bucket + 1) * 5)
    monitor (label (concat ["N ∈ [", b0,", ",b1 , "]"]))
    -- Running this concurrently causes "impossible" conflicts during
    -- upsert! This needs to be fixed! But on the threat matrix, it is both
    -- unlikely to happen and has minimal side effects (since the DB stays
    -- consistent, after all.) So I'm punting for now.
    traverse_ oneAct targets
  where
    oneAct x =
        -- When new API methods are added, they need to be added here. This is
        -- a problem I don't have a solution to right now.
        (run . getBlind <=< pick) (Blind <$> frequency
            [ (10, storeToken' x)
            , (1, delToken' x)
{'fraction_non_alphanumeric': 0.10342071611253197, 'fraction_numerical': 0.005434782608695652, 'mean_word_length': 3.4756795422031472, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 36, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3064277', 'n_tokens_mistral': 1920, 'n_tokens_neox': 1860, 'n_words': 665}