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:password@example.test/0")
          :: IO (Either SomeException (String, Int, Integer))
      assertBool "credential-bearing Redis URI rejected" (isLeft redisCredential)
      endpointCredential <- try
        (validateAbsoluteUri
          "endpoint"
          ["https"]
          "https://user:password@example.test")
          :: 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")]
  ]