cardano-tracer tests: rotator.

cardano-tracer/test/Cardano/Tracer/Test/Logs/File.hs

@@ -13,6 +13,7 @@ import           Data.Word (Word16)
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
 import           System.Directory
+import           System.FilePath
 
 import           Cardano.Tracer.Configuration
 import           Cardano.Tracer.Handlers.Logs.Log (isItLog, isItSymLink)
@@ -22,10 +23,8 @@ import           Cardano.Tracer.Test.Forwarder (launchForwardersSimple)
 
 tests :: TestTree
 tests = localOption (QuickCheckTests 1) $ testGroup "Test.Logs.File"
-  [ testProperty ".log" $
-      propFile AsText "/tmp/test-logs-text" "127.0.0.1" 3000
-  , testProperty ".json" $
-      propFile AsJSON "/tmp/test-logs-json" "127.0.0.1" 3010
+  [ testProperty ".log"  $ propFile AsText "text" "127.0.0.1" 3000
+  , testProperty ".json" $ propFile AsJSON "json" "127.0.0.1" 3010
   ]
 
 propFile
@@ -34,14 +33,16 @@ propFile
   -> String
   -> Word16
   -> Property
-propFile format rootDir host port = ioProperty $ do
+propFile format suffix host port = ioProperty $ do
+  tmpDir <- getTemporaryDirectory
+  let rootDir = tmpDir </> ("test-logs-" <> suffix)
   -- Remove rootDir if needed.
   removePathForcibly rootDir
   -- Run cardano-tracer and demo-forwarder-mux.
-  tracerThr <- forkIO $ runCardanoTracerWithConfig config
+  tracerThr <- forkIO $ runCardanoTracerWithConfig (config rootDir)
   threadDelay 500000
   forwarderThr <- forkIO $ launchForwardersSimple (host, port)
-  -- Wait for some 'LogObject's...
+  -- Wait for some 'TraceObject's...
   threadDelay 5000000
   -- Stop both sides.
   killThread forwarderThr
@@ -77,13 +78,13 @@ propFile format rootDir host port = ioProperty $ do
         _ -> false "root dir contains more than one subdir"
     False -> false "root dir doesn't exist"
  where
-  config = TracerConfig
+  config rootDir' = TracerConfig
     { acceptAt       = RemoteSocket host (fromIntegral port)
     , loRequestNum   = 1
     , ekgRequestFreq = 1.0
     , hasEKG         = Nothing
     , hasPrometheus  = Nothing
-    , logging        = [LoggingParams rootDir FileMode format]
+    , logging        = [LoggingParams rootDir' FileMode format]
     , rotation       = Nothing
     }
 

cardano-tracer/test/Cardano/Tracer/Test/Logs/Rotator.hs

@@ -1,17 +1,86 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 module Cardano.Tracer.Test.Logs.Rotator
   ( tests
   ) where
 
+import           Control.Concurrent (forkIO, killThread, threadDelay)
+import           Data.Word (Word16)
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
+import           System.Directory
+import           System.FilePath
+
+import           Cardano.Tracer.Configuration
+import           Cardano.Tracer.Handlers.Logs.Log (isItLog)
+import           Cardano.Tracer.Run (runCardanoTracerWithConfig)
+
+import           Cardano.Tracer.Test.Forwarder (launchForwardersSimple)
 
 tests :: TestTree
 tests = localOption (QuickCheckTests 1) $ testGroup "Test.Logs.Rotator"
-  [
+  [ testProperty "basic" $ propRotator "127.0.0.1" 3020
   ]
+
+propRotator
+  :: String
+  -> Word16
+  -> Property
+propRotator host port = ioProperty $ do
+  tmpDir <- getTemporaryDirectory
+  let rootDir = tmpDir </> "test-logs-rotator"
+  -- Remove rootDir if needed.
+  removePathForcibly rootDir
+  -- Run cardano-tracer and demo-forwarder-mux.
+  tracerThr <- forkIO $ runCardanoTracerWithConfig (config rootDir)
+  threadDelay 500000
+  forwarderThr <- forkIO $ launchForwardersSimple (host, port)
+  -- Wait while rotation will occure...
+  threadDelay 25000000
+  -- Stop both sides.
+  killThread forwarderThr
+  killThread tracerThr
+  threadDelay 100000
+  -- Check that rootDir exists...
+  doesDirectoryExist rootDir >>= \case
+    True ->
+      -- ... and contains one node's subdir...
+      listDirectory rootDir >>= \case
+        []  -> false "root dir is empty"
+        [subDir] ->
+          withCurrentDirectory rootDir $
+            -- ... with *.log-files inside...
+            listDirectory subDir >>= \case
+              [] -> false "subdir is empty"
+              logsAndSymLink ->
+                withCurrentDirectory subDir $
+                  case filter (isItLog format) logsAndSymLink of
+                    [] -> false "subdir doesn't contain expected logs"
+                    logsWeNeed -> do
+                      let thereAreMoreThanOneLog = length logsWeNeed > 1
+                      return $ thereAreMoreThanOneLog === True
+        _ -> false "root dir contains more than one subdir"
+    False -> false "root dir doesn't exist"
+ where
+  config rootDir' = TracerConfig
+    { acceptAt       = RemoteSocket host (fromIntegral port)
+    , loRequestNum   = 1
+    , ekgRequestFreq = 1.0
+    , hasEKG         = Nothing
+    , hasPrometheus  = Nothing
+    , logging        = [LoggingParams rootDir' FileMode format]
+    , rotation       = Just $
+        RotationParams
+          { rpLogLimitBytes = 100
+          , rpMaxAgeHours   = 1
+          , rpKeepFilesNum  = 10
+          }
+    }
+
+  format = AsText
+
+  false :: String -> IO Property
+  false msg = return . counterexample msg $ property False