{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Control.Flipper.PostgresSpec (main, spec) where
import Control.Monad (void)
import Control.Monad.Reader
import Control.Monad.State
import qualified Data.ByteString.Char8 as C8
import Data.Map.Strict as Map
import qualified Data.Set as Set
import Test.Hspec
import Control.Flipper.Adapters.Postgres as FP
import Control.Flipper.Adapters.Postgres.Models (ConnectionPool)
import Control.Flipper.Adapters.Postgres.Query as Q
import qualified Helpers.Config as Cfg
main :: IO ()
main = hspec spec
newtype MyContext m a = MyContext { unContext :: StateT MyState (FlipperT m) a }
deriving ( Functor
, Applicative
, Monad
, MonadIO
, MonadState MyState
, MonadReader Config
, HasFeatureFlags
, ModifiesFeatureFlags
)
newtype MyState = MyState Int
deriving (Show, Eq)
runMyContext :: (MonadIO m)
=> ConnectionPool -> MyState -> MyContext m a -> m (a, MyState)
runMyContext pool initialState f =
let flipperT = runStateT (unContext f) initialState
in runFlipperT pool flipperT
spec :: Spec
spec = around Cfg.withConfig $ do
describe "control flow with feature flags" $ do
describe "a non-existant feature" $ do
it "is disabled by default" $ \(Config pool _) -> do
(_, st) <- runMyContext pool (MyState 0) $ do
whenEnabled "non-existant feature" (void $ put (MyState 1))
st `shouldBe` MyState 0
describe "a persisted feature" $ do
it "runs a feature when it is enabled" $ \(Config pool dbAccess) -> do
let f = (FP.mkFeature "enabled-feature") { isEnabled = True }
void $ Q.addFeature f dbAccess
(_, st) <- runMyContext pool (MyState 0) $ do
whenEnabled "enabled-feature" (void $ put (MyState 1))
st `shouldBe` MyState 1
it "does not run disabled features" $ \(Config pool dbAccess) -> do
let f = (FP.mkFeature "disabled-feature") { isEnabled = False }
void $ Q.addFeature f dbAccess
(_, st) <- runMyContext pool (MyState 0) $ do
whenEnabled "disabled-feature" (void $ put (MyState 1))
st `shouldBe` MyState 0
describe "modifying feature flags" $ do
describe "adding new feature flags" $ do
it "creates new records" $ \(Config pool dbAccess) -> do
featureCount dbAccess `shouldReturn` 0
(_, _) <- runMyContext pool (MyState 0) $ do
let feature1 = (FP.mkFeature "my-new-feature") { isEnabled = True }
let feature2 = (FP.mkFeature "some-other-feature") { isEnabled = True }
let fs = Features $ Map.fromList [ (featureName feature1, feature1), (featureName feature2, feature2) ]
updateFeatures fs
featureCount dbAccess `shouldReturn` 2
it "updating existing feature records" $ \(Config pool dbAccess) -> do
featureCount dbAccess `shouldReturn` 0
void $ runMyContext pool (MyState 0) $ do
let feature1 = (FP.mkFeature "my-new-feature") { isEnabled = True }
let feature2 = (FP.mkFeature "some-other-feature") { isEnabled = True }
let featureList = [ (featureName feature1, feature1), (featureName feature2, feature2) ]
let fs = Features $ Map.fromList featureList
updateFeatures fs
liftIO $ featureCount dbAccess `shouldReturn` 2
let feature1' = (FP.mkFeature "my-new-feature") { isEnabled = False }
let feature2' = (FP.mkFeature "some-other-feature") { isEnabled = False }
let feature3' = (FP.mkFeature "hi-there") { isEnabled = False }
let featureList' = [ (featureName feature1', feature1'), (featureName feature2', feature2'), (featureName feature3', feature3') ]
let fs' = Features $ Map.fromList featureList'
updateFeatures fs'
liftIO $ featureCount dbAccess `shouldReturn` 3
fs'' <- FP.getFeatures
liftIO $ all (\f -> isEnabled f == False) (Map.elems (unFeatures fs'')) `shouldBe` True
describe "enabling a feature for a specific actor" $ do
it "runs a feature for enabled users" $ \(Config pool _) -> do
let actor1 = User 1
let actor2 = User 2
-- setup the features
runFlipperT pool $ do
-- here, we only enable the feature for actor1
let feature = (FP.mkFeature "vrry-special-feature") { isEnabled = False, enabledActors = Set.singleton (actorId actor1) }
let fs = Features $ Map.singleton (featureName feature) feature
updateFeatures fs
-- run some computation with feature flippers
(_, st) <- runMyContext pool (MyState 0) $ do
whenEnabledFor "vrry-special-feature" actor1 $
(void $ put (MyState 1))
whenEnabledFor "vrry-special-feature" actor2 $
(void $ put (MyState 2))
st `shouldBe` MyState 1
data User = User { userId :: Int }
deriving (Show, Eq)
instance HasActorId User where
actorId = ActorId . C8.pack . show . userId