{-# LANGUAGE AllowAmbiguousTypes       #-}
{-# LANGUAGE DataKinds                 #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE ImpredicativeTypes        #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# LANGUAGE TypeApplications          #-}
module Feature.Auth.JwtCacheSpec

where

import Network.Wai (Application)

import Network.HTTP.Types
import Test.Hspec         (Expectation, SpecWith, describe, it,
                           shouldBe)
import Test.Hspec.Wai

import Data.String                     (String)
import PostgREST.Metrics               (MetricsState (..))
import Prometheus                      (getCounter)
import Protolude
import SpecHelper
import Test.Hspec.Expectations.Contrib (annotate)
import Test.Hspec.Wai.JSON             (json)

spec :: SpecWith (MetricsState, Application)
spec = describe "Server started with JWT and metrics enabled" $ do
  it "Should not have JWT in cache" $ do
    let auth = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe1"}|]

    expectCounters
      [
        requests (+ 1)
      , hits     (+ 0)
      ] $

         request methodGet "/authors_only" [auth] ""

  it "Should have JWT in cache" $ do
    let auth = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe2"}|]

    expectCounters
      [
        requests (+ 2)
      , hits     (+ 1)
      ] $

         request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200
      *> request methodGet "/authors_only" [auth] "" `shouldRespondWith` 200

  it "Should not cache invalid JWTs" $ do
    let auth = authHeaderJWT "some random bytes"

    expectCounters
      [
        requests (+ 2)
      , hits     (+ 0)
      ] $

         request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401
      *> request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401

  it "Should cache expired JWTs" $ do
    let auth = genToken [json|{"exp": 1, "role": "postgrest_test_author", "id": "jdoe2"}|]

    expectCounters
      [
        requests (+ 2)
      , hits     (+ 1)
      ] $

         request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401
      *> request methodGet "/authors_only" [auth] "" `shouldRespondWith` 401

  it "Should evict entries from the JWT cache (jwt cache max is 2)" $ do
    let jwt1 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe3"}|]
        jwt2 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe4"}|]
        jwt3 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe5"}|]

    expectCounters
      [
        requests  (+ 6)
      , hits      (+ 0)
      , evictions (+ 4)
      ] $

         request methodGet "/authors_only" [jwt1] ""
      *> request methodGet "/authors_only" [jwt2] ""
      *> request methodGet "/authors_only" [jwt3] ""
      *> request methodGet "/authors_only" [jwt1] ""
      *> request methodGet "/authors_only" [jwt2] ""
      *> request methodGet "/authors_only" [jwt3] ""

  it "Should not evict entries from the JWT cache in FIFO order" $ do
    let jwt1 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe6"}|]
        jwt2 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe7"}|]
        jwt3 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe8"}|]

    expectCounters
      [
        requests  (+ 6)
      , hits      (+ 3)
      , evictions (+ 1)
      ] $

         request methodGet "/authors_only" [jwt1] ""
      *> request methodGet "/authors_only" [jwt2] ""
      -- this one should hit the cache
      *> request methodGet "/authors_only" [jwt1] ""
      -- this one should trigger eviction of jwt2 (not FIFO)
      *> request methodGet "/authors_only" [jwt3] ""
      -- these two should hit the cache
      *> request methodGet "/authors_only" [jwt1] ""
      *> request methodGet "/authors_only" [jwt3] ""

  -- This one makes sure we test the scenario when finger
  -- has to move through the whole list first and pass the head
  -- The test case was added based on coverage report
  -- showing this scenario was not covered by previous tests
  it "Should evict entries even though all were hit" $ do
    let jwt1 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe9"}|]
        jwt2 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe10"}|]
        jwt3 = genToken [json|{"exp": 9999999999, "role": "postgrest_test_author", "id": "jdoe11"}|]

    expectCounters
      [
        requests  (+ 7)
      , hits      (+ 4)
      , evictions (+ 1)
      ] $

         request methodGet "/authors_only" [jwt1] ""
      *> request methodGet "/authors_only" [jwt2] ""
      -- these two should hit the cache
      *> request methodGet "/authors_only" [jwt1] ""
      *> request methodGet "/authors_only" [jwt2] ""
      -- this one should trigger eviction of jwt1
      *> request methodGet "/authors_only" [jwt3] ""
      -- these two should hit the cache
      *> request methodGet "/authors_only" [jwt2] ""
      *> request methodGet "/authors_only" [jwt3] ""

  where
      counterToInt = second (fmap (round @Double @Int) . getCounter)
      expectCounters = stateCheck . fmap (\(g, h) -> StateCheck (counterToInt . g) (flip shouldBe . h))
      genToken = authHeaderJWT . generateJWT
      requests = (,) (getF @"jwtCacheRequests")
      hits = (,) (getF @"jwtCacheHits")
      evictions = (,) (getF @"jwtCacheEvictions")


-- should be moved to helpers???
getF :: forall s r a. (KnownSymbol s, HasField s r a) => r -> (String, a)
getF r = (symbolVal (Proxy @s), getField @s r)

data StateCheck st = forall a. (Show a, Eq a) => StateCheck (st -> (String, WaiSession st a)) (a -> a -> Expectation)

stateCheck :: (Traversable t) => t (StateCheck st) -> WaiSession st a -> WaiSession st ()
stateCheck checks act = do
  metrics <- getState
  expectations <- traverse (\(StateCheck g expect) -> let (msg, m) = g metrics in m >>= createExpectation msg m . expect) checks
  void act
  sequenceA_ expectations
  where
    createExpectation msg metrics expect = pure $ metrics >>= liftIO . annotate msg . expect