Split kind tests into component-owned probes

test/RuntimeAuditProbe.hs

@@ -0,0 +1,108 @@
+module Main (main) where
+
+import           Data.Aeson (Value (..), eitherDecodeStrict')
+import qualified Data.Aeson.Key as Key
+import qualified Data.Aeson.KeyMap as KeyMap
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
+import           Data.List (nub)
+import           Data.Maybe (mapMaybe)
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import           Nuthatch.Probe.Assert
+import           System.Environment (lookupEnv)
+
+main :: IO ()
+main = do
+  logBytes <- BS.readFile "/run/nuthatch-runtime/app.log"
+  let auditLines =
+        filter (BS.isPrefixOf "{") (B8.lines logBytes)
+  records <- traverse decodeRecord auditLines
+  assert "runtime audit log is empty" (not (null records))
+  mapM_ verifyRequiredFields records
+  mapM_ (requireAction records)
+    ["authentication", "login", "logout", "authorization", "put", "delete"]
+  verifyMutationFields records
+  verifyNoProhibitedData logBytes
+  putStrLn "Runtime audit structure and redaction passed"
+
+decodeRecord :: BS.ByteString -> IO (KeyMap.KeyMap Value)
+decodeRecord bytes =
+  case eitherDecodeStrict' bytes of
+    Right (Object object) -> pure object
+    Right _ -> fail "runtime audit record is not an object"
+    Left reason -> fail ("invalid runtime audit JSON: " <> reason)
+
+verifyRequiredFields :: KeyMap.KeyMap Value -> IO ()
+verifyRequiredFields record =
+  mapM_
+    (\name ->
+      assert ("runtime audit record omitted " <> name) $
+        KeyMap.member (Key.fromString name) record)
+    ["ts", "action", "result"]
+
+requireAction :: [KeyMap.KeyMap Value] -> String -> IO ()
+requireAction records expected =
+  assert ("runtime audit omitted action " <> expected) $
+    any ((== Just expected) . textField "action") records
+
+verifyMutationFields :: [KeyMap.KeyMap Value] -> IO ()
+verifyMutationFields records = do
+  let puts = filter ((== Just "put") . textField "action") records
+      mutations =
+        filter
+          (\record ->
+            textField "action" record `elem` [Just "put", Just "delete"])
+          records
+      failed =
+        filter ((/= Just "ok") . textField "result") mutations
+  assert "runtime audit omitted put records" (not (null puts))
+  mapM_
+    (\record ->
+      mapM_
+        (\name ->
+          assert ("put audit omitted " <> name) $
+            KeyMap.member (Key.fromString name) record)
+        ["user_id", "root", "bytes"])
+    puts
+  assert "runtime audit omitted failed mutations" (not (null failed))
+  mapM_
+    (\record ->
+      assert "failed mutation audit omitted reason" $
+        KeyMap.member "reason" record)
+    failed
+
+verifyNoProhibitedData :: BS.ByteString -> IO ()
+verifyNoProhibitedData logBytes = do
+  let folded = Text.toCaseFold (Text.decodeUtf8 logBytes)
+  mapM_
+    (\value ->
+      assert ("runtime log exposed prohibited value " <> value) $
+        Text.toCaseFold (Text.pack value) `Text.isInfixOf` folded == False)
+    [ "Bearer "
+    , "\"authorization\":"
+    , "client_secret"
+    , "NUTHATCH_"
+    , "private-a"
+    , "runtime-coherence"
+    , "first-personal"
+    , "second-personal"
+    ]
+  configured <- mapMaybe id <$> traverse lookupEnv
+    [ "NUTHATCH_JWT_SECRET"
+    , "NUTHATCH_PG_CONN"
+    , "NUTHATCH_S3_ACCESS_KEY"
+    , "NUTHATCH_S3_SECRET_KEY"
+    , "NUTHATCH_OIDC_CLIENT_SECRET"
+    ]
+  mapM_
+    (\value ->
+      assert "runtime log exposed a configured secret" $
+        not (B8.pack value `BS.isInfixOf` logBytes))
+    (filter (not . null) (nub configured))
+
+textField :: String -> KeyMap.KeyMap Value -> Maybe String
+textField name record =
+  case KeyMap.lookup (Key.fromString name) record of
+    Just (String value) -> Just (Text.unpack value)
+    _ -> Nothing