108 lines
3.6 KiB
Haskell
108 lines
3.6 KiB
Haskell
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
|