module Spec.PersistentDataStore (allTests) where

import Data.ByteString ()
import Data.Either (isLeft)
import Data.Function ((&))
import Data.IORef (atomicModifyIORef', newIORef, readIORef, writeIORef)
import System.Clock (TimeSpec (..))
import Test.HUnit

import Util.Features (makeTestFlag)

import LaunchDarkly.AesonCompat (emptyObject, insertKey, singleton)
import LaunchDarkly.Server.Store.Internal

makeTestStore :: Maybe PersistentDataStore -> IO (StoreHandle IO)
makeTestStore backend = makeStoreIO backend $ TimeSpec 10 0

makeStoreInterface :: PersistentDataStore
makeStoreInterface =
    PersistentDataStore
        { persistentDataStoreAllFeatures = const $ assertFailure "allFeatures should not be called"
        , persistentDataStoreGetFeature = const $ const $ assertFailure "getFeatures should not be called"
        , persistentDataStoreUpsertFeature = const $ const $ const $ assertFailure "upsertFeature should not be called"
        , persistentDataStoreIsInitialized = assertFailure "isInitialized should not be called"
        , persistentDataStoreInitialize = const $ assertFailure "initialize should not be called"
        }

testFailInit :: Test
testFailInit = TestCase $ do
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreInitialize = \_ -> pure $ Left "err"
                    }
    initializeStore store emptyObject emptyObject >>= (Left "err" @?=)

testFailGet :: Test
testFailGet = TestCase $ do
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreGetFeature = \_ _ -> pure $ Left "err"
                    }
    getFlagC store "abc" >>= (Left "err" @?=)

testFailAll :: Test
testFailAll = TestCase $ do
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreAllFeatures = \_ -> pure $ Left "err"
                    }
    getAllFlagsC store >>= (Left "err" @?=)

testFailIsInitialized :: Test
testFailIsInitialized = TestCase $ do
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreIsInitialized = pure $ Left "err"
                    }
    getInitializedC store >>= (Left "err" @?=)

testFailUpsert :: Test
testFailUpsert = TestCase $ do
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreUpsertFeature = \_ _ _ -> pure $ Left "err"
                    }
    insertFlag store (makeTestFlag "test" 123) >>= (Left "err" @?=)

testFailGetInvalidJSON :: Test
testFailGetInvalidJSON = TestCase $ do
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreGetFeature = \_ _ -> pure $ Right $ Just $ SerializedItemDescriptor (pure "invalid json") 0 False
                    }
    getFlagC store "abc" >>= (\v -> True @?= isLeft v)

testGetAllInvalidJSON :: Test
testGetAllInvalidJSON = TestCase $ do
    let flag = makeTestFlag "abc" 52
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreAllFeatures = \_ ->
                        pure $
                            Right $
                                emptyObject
                                    & insertKey "abc" (createSerializedItemDescriptor $ ItemDescriptor (pure flag) 52)
                                    & insertKey "xyz" (SerializedItemDescriptor (pure "invalid json") 64 False)
                    }
    getAllFlagsC store >>= (Right (singleton "abc" flag) @?=)

testInitializedCache :: Test
testInitializedCache = TestCase $ do
    counter <- newIORef 0
    value <- newIORef False
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreIsInitialized = do
                        atomicModifyIORef' counter (\c -> (c + 1, ()))
                        Right <$> readIORef value
                    }
    getInitializedC store >>= (Right False @=?)
    readIORef counter >>= (1 @=?)
    getInitializedC store >>= (Right False @=?)
    readIORef counter >>= (1 @=?)
    storeHandleExpireAll store >>= (Right () @=?)
    getInitializedC store >>= (Right False @=?)
    readIORef counter >>= (2 @=?)
    writeIORef value True
    storeHandleExpireAll store >>= (Right () @=?)
    getInitializedC store >>= (Right True @=?)
    readIORef counter >>= (3 @=?)
    getInitializedC store >>= (Right True @=?)
    readIORef counter >>= (3 @=?)

testGetCache :: Test
testGetCache = TestCase $ do
    counter <- newIORef 0
    value <- newIORef $ Just $ SerializedItemDescriptor Nothing 0 False
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreGetFeature = \_ _ -> do
                        atomicModifyIORef' counter (\c -> (c + 1, ()))
                        Right <$> readIORef value
                    }
    getFlagC store "abc" >>= (Right Nothing @?=)
    readIORef counter >>= (1 @=?)
    getFlagC store "abc" >>= (Right Nothing @?=)
    readIORef counter >>= (1 @=?)
    storeHandleExpireAll store >>= (Right () @=?)
    let flag = pure $ makeTestFlag "abc" 12
    writeIORef value $ Just $ createSerializedItemDescriptor $ ItemDescriptor flag 12
    getFlagC store "abc" >>= (Right flag @=?)
    readIORef counter >>= (2 @=?)
    getFlagC store "abc" >>= (Right flag @=?)
    readIORef counter >>= (2 @=?)

testUpsertInvalidatesAllFlags :: Test
testUpsertInvalidatesAllFlags = TestCase $ do
    allCounter <- newIORef 0
    upsertCounter <- newIORef 0
    upsertResult <- newIORef $ Right True
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreUpsertFeature = \_ _ _ -> do
                        atomicModifyIORef' upsertCounter (\c -> (c + 1, ()))
                        readIORef upsertResult
                    , persistentDataStoreAllFeatures = \_ -> do
                        atomicModifyIORef' allCounter (\c -> (c + 1, ()))
                        pure $ Right emptyObject
                    }
    getAllFlagsC store >>= (Right emptyObject @=?)
    readIORef allCounter >>= (1 @=?)
    deleteFlag store "abc" 52 >>= (Right () @=?)
    readIORef upsertCounter >>= (1 @=?)
    getAllFlagsC store >>= (Right emptyObject @=?)
    readIORef allCounter >>= (2 @=?)
    writeIORef upsertResult $ Right False
    deleteFlag store "abc" 53 >>= (Right () @=?)
    readIORef upsertCounter >>= (2 @=?)
    getAllFlagsC store >>= (Right emptyObject @=?)
    readIORef allCounter >>= (2 @=?)

testAllFlagsCache :: Test
testAllFlagsCache = TestCase $ do
    counter <- newIORef 0
    value <- newIORef emptyObject
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreAllFeatures = \_ -> do
                        atomicModifyIORef' counter (\c -> (c + 1, ()))
                        pure $ Right emptyObject
                    }
    getAllFlagsC store >>= (Right emptyObject @=?)
    readIORef counter >>= (1 @=?)
    getAllFlagsC store >>= (Right emptyObject @=?)
    readIORef counter >>= (1 @=?)
    storeHandleExpireAll store >>= (Right () @=?)
    getAllFlagsC store >>= (Right emptyObject @=?)
    readIORef counter >>= (2 @=?)

testAllFlagsUpdatesRegularCache :: Test
testAllFlagsUpdatesRegularCache = TestCase $ do
    let flag = makeTestFlag "abc" 12
    store <-
        makeTestStore $
            pure $
                makeStoreInterface
                    { persistentDataStoreAllFeatures = \_ ->
                        pure $
                            Right $
                                singleton "abc" (createSerializedItemDescriptor $ ItemDescriptor (pure flag) 12)
                    }
    getAllFlagsC store >>= (Right (singleton "abc" flag) @=?)
    getFlagC store "abc" >>= (Right (pure flag) @=?)

allTests :: Test
allTests =
    TestList
        [ testFailInit
        , testFailGet
        , testFailAll
        , testFailIsInitialized
        , testFailUpsert
        , testFailGetInvalidJSON
        , testGetAllInvalidJSON
        , testInitializedCache
        , testGetCache
        , testUpsertInvalidatesAllFlags
        , testAllFlagsCache
        , testAllFlagsUpdatesRegularCache
        ]