Store.hs

module Spec.Store (allTests, testWithStore) where

import           Test.HUnit
import           Data.Text                          (Text)
import           Data.HashMap.Strict                (HashMap)
import qualified Data.HashMap.Strict as             HM
import           Control.Monad                      (void)
import           GHC.Natural                        (Natural)
import           GHC.Int                            (Int64)
import           System.Clock                       (TimeSpec(..))

import           Util.Features                      (makeTestFlag, makeTestSegment)

import           LaunchDarkly.Server.Features       (Flag(..), VariationOrRollout(..))
import           LaunchDarkly.Server.Store.Internal
import           LaunchDarkly.Server.Store.Redis

testInitializationEmpty ::  IO (StoreHandle IO) -> Test
testInitializationEmpty makeStore = TestCase $ do
    store <- makeStore
    getInitializedC store                         >>= (pure False @=?)
    storeHandleInitialize store HM.empty HM.empty >>= (pure () @=?)
    getInitializedC store                         >>= (pure True @=?)

testInitializationWithFeatures :: IO (StoreHandle IO) -> Test
testInitializationWithFeatures makeStore = TestCase $ do
    store <- makeStore
    getInitializedC store                        >>= (pure False @=?)
    storeHandleInitialize store flagsV segmentsV >>= (pure () @=?)
    getInitializedC store                        >>= (pure True @=?)
    storeHandleGetFlag store "a"                 >>= (pure (pure flagA) @=?)
    storeHandleAllFlags store                    >>= (pure flagsR @=?)
    storeHandleGetSegment store "a"              >>= (pure (pure segmentA) @=?)
    where
        segmentA  = makeTestSegment "a" 50
        flagA     = makeTestFlag "a" 52
        flagsR    = HM.singleton "a" flagA
        flagsV    = HM.singleton "a" (Versioned flagA 52)
        segmentsV = HM.singleton "a" (Versioned segmentA 50)

testGetAndUpsertAndGetAndGetAllFlags :: IO (StoreHandle IO) -> Test
testGetAndUpsertAndGetAndGetAllFlags makeStore = TestCase $ do
    store <- makeStore
    getFlagC store "a"                               >>= (pure Nothing @=?)
    upsertFlagC store "a" (Versioned (pure flag) 52) >>= (pure () @=?)
    getFlagC store "a"                               >>= (pure (pure flag) @=?)
    getAllFlagsC store                               >>= (pure (HM.singleton "a" flag) @=?)
    where
        flag = makeTestFlag "a" 52

testGetAndUpsertAndGetSegment :: IO (StoreHandle IO) -> Test
testGetAndUpsertAndGetSegment makeStore = TestCase $ do
    store <- makeStore
    getSegmentC store "a"                                  >>= (pure Nothing        @=?)
    upsertSegmentC store "a" (Versioned (pure segment) 52) >>= (pure ()             @=?)
    getSegmentC store "a"                                  >>= (pure (pure segment) @=?)
    where
        segment = makeTestSegment "a" 52

testUpsertRespectsVersion :: IO (StoreHandle IO) -> Test
testUpsertRespectsVersion makeStore = TestCase $ do
    store <- makeStore
    upsertFlagC store "a" (Versioned (pure $ makeTestFlag "a" 1) 1) >>= (pure () @=?)
    upsertFlagC store "a" (Versioned (pure $ makeTestFlag "a" 2) 2) >>= (pure () @=?)
    getFlagC store "a"                                              >>= (pure (pure $ makeTestFlag "a" 2) @=?)
    getAllFlagsC store                                              >>= (pure (HM.singleton "a" $ makeTestFlag "a" 2) @=?)
    upsertFlagC store "a" (Versioned (pure $ makeTestFlag "a" 1) 1) >>= (pure () @=?)
    getFlagC store "a"                                              >>= (pure (pure $ makeTestFlag "a" 2) @=?)
    getAllFlagsC store                                              >>= (pure (HM.singleton "a" $ makeTestFlag "a" 2) @=?)
    upsertFlagC store "a" (Versioned Nothing 3)                     >>= (pure () @=?)
    getFlagC store "a"                                              >>= (pure Nothing @=?)
    getAllFlagsC store                                              >>= (pure mempty @=?)

testWithStore :: IO (StoreHandle IO) -> Test
testWithStore makeStore = TestList $ map (\f -> f makeStore)
    [ testInitializationEmpty
    , testInitializationWithFeatures
    , testGetAndUpsertAndGetAndGetAllFlags
    , testUpsertRespectsVersion
    , testGetAndUpsertAndGetSegment
    ]

allTests :: Test
allTests = TestList
    [ testWithStore $ makeStoreIO Nothing 0
    ]