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