module Main (main) where

import           Control.Concurrent (threadDelay)
import           Control.Exception (SomeException, try)
import           Control.Monad (unless)
import           Data.Foldable (traverse_)
import           Nuthatch.Config (Config (..), loadConfig)
import           Nuthatch.Redis
import           Nuthatch.Types
import           System.Environment
  ( getArgs
  , lookupEnv
  , setEnv
  , unsetEnv
  )

main :: IO ()
main = do
  mode <- getArgs
  case mode of
    ["config"] -> verifyConfiguration
    ["available"] -> withConfiguration $ \config ->
      withRedis config (verifyAvailable config)
    ["unavailable"] -> withConfiguration $ \config ->
      withRedis config (verifyUnavailable config)
    _ -> fail "expected config, available, or unavailable mode"

withConfiguration :: (Config -> IO ()) -> IO ()
withConfiguration action = loadConfig >>= action

verifyConfiguration :: IO ()
verifyConfiguration = do
  baseValues <- traverse
    (\name -> (name,) <$> lookupEnv name)
    [ "NUTHATCH_JWT_SECRET"
    , "NUTHATCH_OIDC_CLIENT_SECRET"
    , "NUTHATCH_PG_CONN"
    , "NUTHATCH_S3_ACCESS_KEY"
    , "NUTHATCH_S3_SECRET_KEY"
    , "NUTHATCH_S3_ENDPOINT"
    , "NUTHATCH_BROWSE_PAGE_SIZE"
    , "NUTHATCH_PUBLIC_BASE_URL"
    , "NUTHATCH_REDIS_URL"
    ]
  let load changes = do
        traverse_ (uncurry setVariable) baseValues
        traverse_ (uncurry setVariable) changes
        loadConfig
  expectAccepted (load []) "valid configuration"
  expectRejected
    (load [("NUTHATCH_PG_CONN", Nothing)])
    "missing required configuration"
  expectRejected
    (load [("NUTHATCH_S3_ENDPOINT", Just "not a URI")])
    "malformed URI configuration"
  expectRejected
    (load [("NUTHATCH_S3_ENDPOINT", Just "https://store.invalid/path")])
    "non-origin S3 configuration"
  expectRejected
    (load
      [("NUTHATCH_BROWSE_PAGE_SIZE", Just "18446744073709551617")])
    "out-of-range configuration"
  expectRejected
    (load
      [ ( "NUTHATCH_PUBLIC_BASE_URL"
        , Just "https://user:password@wp12.invalid"
        )
      ])
    "credential-bearing URI configuration"
  expectAccepted
    (load [("NUTHATCH_REDIS_URL", Just "redis://[::1]:6379/0")])
    "IPv6 URI configuration"
  putStrLn "runtime configuration cases passed"

expectAccepted :: IO Config -> String -> IO ()
expectAccepted load label = do
  result <- try load :: IO (Either SomeException Config)
  case result of
    Left _ -> fail (label <> " was rejected")
    Right _ -> pure ()

expectRejected :: IO Config -> String -> IO ()
expectRejected load label = do
  result <- try load :: IO (Either SomeException Config)
  case result of
    Left _ -> pure ()
    Right _ -> fail (label <> " was accepted")

setVariable :: String -> Maybe String -> IO ()
setVariable name = maybe (unsetEnv name) (setEnv name)

verifyAvailable :: Config -> Redis -> IO ()
verifyAvailable config redis = do
  cacheSet redis "nuthatch:wp12:ttl" (cfgListCacheTtlSec config) "cached"
  cacheGet redis "nuthatch:wp12:ttl" >>= requireEqual (Just "cached")
  threadDelay (fromInteger ((cfgListCacheTtlSec config + 1) * 1000000))
  cacheGet redis "nuthatch:wp12:ttl" >>= requireEqual Nothing
  let userA = UserId "runtime-user-a"
      userB = UserId "runtime-user-b"
  sharedBeforeA <- cacheGeneration redis userA Shared
  sharedBeforeB <- cacheGeneration redis userB Shared
  requireEqual sharedBeforeA sharedBeforeB
  cacheInvalidatePrefixes redis userA Shared [""]
  sharedAfterB <- cacheGeneration redis userB Shared
  unless (sharedAfterB /= sharedBeforeB) $
    fail "shared cache generation did not change across users"
  personalBeforeB <- cacheGeneration redis userB Personal
  cacheInvalidatePrefixes redis userA Personal [""]
  personalAfterB <- cacheGeneration redis userB Personal
  requireEqual personalBeforeB personalAfterB
  putStrLn "runtime cache coherence passed"

verifyUnavailable :: Config -> Redis -> IO ()
verifyUnavailable config redis = do
  cacheGet redis "nuthatch:wp12:missing" >>= requireEqual Nothing
  cacheSet redis "nuthatch:wp12:missing" 1 "ignored"
  cacheInvalidatePrefixes redis (UserId "runtime-user") Shared [""]
  throttled <- throttleCheck redis config (UserId "runtime-user") 1
  case throttled of
    Left _ -> pure ()
    Right _ -> fail "transfer throttle did not fail closed"
  putStrLn "runtime Redis degradation passed"

requireEqual :: (Eq value, Show value) => value -> value -> IO ()
requireEqual expected actual =
  unless (actual == expected) $
    fail ("expected " <> show expected <> ", got " <> show actual)