Split host tests by component ownership

test/Nuthatch/Test/Runtime.hs

@@ -0,0 +1,73 @@
+module Nuthatch.Test.Runtime
+  ( tests
+  ) where
+
+import           Control.Exception (SomeException, try)
+import qualified Data.Aeson as A
+import qualified Data.Aeson.KeyMap as KM
+import           Data.Either (isLeft)
+import           Data.IORef (modifyIORef', newIORef, readIORef)
+import           Data.Text (Text)
+import           Data.Time.Clock (getCurrentTime)
+import           Nuthatch.Audit (auditValue, objectKeyFields)
+import           Nuthatch.Config (parseRedisUri, validateAbsoluteUri)
+import           Nuthatch.Runtime (retryStartup)
+import           Test.Tasty (TestTree, testGroup)
+import           Test.Tasty.HUnit ((@?=), assertBool, assertFailure, testCase)
+
+tests :: TestTree
+tests = testGroup "runtime"
+  [ testCase "URI parsing accepts IPv6 and rejects credentials" $ do
+      parseRedisUri "redis://[2001:db8::1]:6380/4"
+        >>= (@?= ("2001:db8::1", 6380, 4))
+      redisCredential <- try
+        (parseRedisUri "redis://user:[email protected]/0")
+          :: IO (Either SomeException (String, Int, Integer))
+      assertBool "credential-bearing Redis URI rejected" (isLeft redisCredential)
+      endpointCredential <- try
+        (validateAbsoluteUri
+          "endpoint"
+          ["https"]
+          "https://user:[email protected]")
+          :: IO (Either SomeException Text)
+      assertBool "credential-bearing endpoint rejected"
+        (isLeft endpointCredential)
+  , testCase "startup retry is bounded and succeeds within its budget" $ do
+      calls <- newIORef (0 :: Int)
+      result <- retryStartup 3 1 "synthetic" $ do
+        modifyIORef' calls (+ 1)
+        count <- readIORef calls
+        if count < 3 then fail "not ready" else pure count
+      result @?= 3
+      readIORef calls >>= (@?= 3)
+  , testCase "startup retry exhausts its configured budget" $ do
+      calls <- newIORef (0 :: Int)
+      result <- try $
+        retryStartup 2 1 "synthetic" $ do
+          modifyIORef' calls (+ 1)
+          fail "not ready"
+        :: IO (Either SomeException ())
+      assertBool "retry exhaustion fails startup" (isLeft result)
+      readIORef calls >>= (@?= 2)
+  , testCase "audit records retain required fields and drop prohibited fields" $ do
+      now <- getCurrentTime
+      let record = auditValue now "put" "rejected" (Just "user")
+            [ ("root", A.String "shared")
+            , ("authorization", A.String "Bearer prohibited")
+            , ("token", A.String "prohibited")
+            ]
+      case record of
+        A.Object fields -> do
+          assertBool "required timestamp present" (KM.member "ts" fields)
+          KM.lookup "action" fields @?= Just (A.String "put")
+          KM.lookup "result" fields @?= Just (A.String "rejected")
+          KM.lookup "user_id" fields @?= Just (A.String "user")
+          KM.lookup "root" fields @?= Just (A.String "shared")
+          assertBool "authorization omitted" (not (KM.member "authorization" fields))
+          assertBool "token omitted" (not (KM.member "token" fields))
+        _ -> assertFailure "audit record was not an object"
+  , testCase "audit object keys follow the configured privacy policy" $ do
+      objectKeyFields False "private/name" @?= []
+      objectKeyFields True "private/name"
+        @?= [("object_key", A.String "private/name")]
+  ]