mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 01:07:18 +03:00
d2e2c21684
New year, new copyright, new expected unknown issues with various files that won't be covered by the script and/or will be but shouldn't change. I'll do the details on Jan 1, but would appreciate this being preapproved so I can actually get it merged by then. CHANGELOG_BEGIN CHANGELOG_END
69 lines
2.4 KiB
Haskell
69 lines
2.4 KiB
Haskell
-- Copyright (c) 2022 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
|
|
-- SPDX-License-Identifier: Apache-2.0
|
|
|
|
module Telemetry(main) where
|
|
|
|
import Control.Monad.Extra
|
|
import DA.Service.Logger.Impl.GCP
|
|
import DA.Service.Logger.Impl.Pure
|
|
import DA.Test.Util
|
|
import Data.Aeson (encode)
|
|
import Data.Maybe
|
|
import qualified Data.Text as T
|
|
import System.Directory
|
|
import System.Environment.Blank
|
|
import System.IO.Extra
|
|
import Test.Tasty
|
|
import Test.Tasty.HUnit
|
|
|
|
main :: IO ()
|
|
main =
|
|
withTempDir $ \tmpDir0 -> do
|
|
withTempDir $ \tmpDir1 -> do
|
|
setPermissions tmpDir1 emptyPermissions
|
|
withEnv [("TASTY_NUM_THREADS", Just "1")] $
|
|
defaultMain $ do
|
|
testGroup "Telemetry" [dataLimiterTests tmpDir0, cacheDirTests tmpDir1]
|
|
|
|
dataLimiterTests :: FilePath -> TestTree
|
|
dataLimiterTests cacheDir =
|
|
testGroup
|
|
"data limiter"
|
|
[ withResource homeDir snd $ \_ ->
|
|
withResource
|
|
(initialiseGcpState (GCPConfig "test" (Just cacheDir) Nothing) makeNopHandle)
|
|
(\gcpM -> whenJust gcpM $ \gcp -> removeFile (sentDataFile gcp)) $ \getGcp ->
|
|
testCase "Check that limit is triggered" $ do
|
|
gcpM <- getGcp
|
|
case gcpM of
|
|
Nothing -> fail "cache directory is not writable"
|
|
Just gcp -> do
|
|
let d = replicate 100 $ encode $ T.pack $ replicate 100000 'X'
|
|
res <- mapM (sendData gcp fakeSend) d
|
|
let l = length $ takeWhile isSuccess res
|
|
83 @=? l
|
|
]
|
|
|
|
cacheDirTests :: FilePath -> TestTree
|
|
cacheDirTests badCacheDir =
|
|
testGroup
|
|
"cache directory"
|
|
[ withResource
|
|
(initialiseGcpState (GCPConfig "test" (Just badCacheDir) Nothing) makeNopHandle)
|
|
(\gcpM -> whenJust gcpM $ \gcp -> removeFile (sentDataFile gcp)) $ \getGcp ->
|
|
testCase
|
|
"Check that a read-only cache dir is handled gracefully." $ do
|
|
gcpM <- getGcp
|
|
isNothing gcpM @=? True
|
|
]
|
|
|
|
fakeSend :: a -> IO ()
|
|
fakeSend _ = pure ()
|
|
|
|
-- | The CI env doesn't have a home directory so set and unset it if it doesn't exist
|
|
homeDir :: IO ((), IO ())
|
|
homeDir = do
|
|
(tmpDir, rmTmpDir) <- newTempDir
|
|
setEnv "HOME" tmpDir True
|
|
pure ((), unsetEnv "HOME" >> rmTmpDir)
|