{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Minilang.ServerSpec where

import Control.Monad (void)
import Data.Aeson (FromJSON, eitherDecode, encode)
import Data.Bifunctor (first)
import Data.ByteString (isInfixOf, toStrict)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16.Lazy as Hex
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Data (Proxy (..))
import Data.String (fromString)
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Encoding (decodeUtf8)
import Minilang.API (Challenge (..), Score (..), User (..), defaultChallenges, newToken)
import Minilang.App (makeEnv)
import Minilang.Server (serveAPI)
import Network.Wai (Application)
import Network.Wai.Test (SResponse)
import System.Random (StdGen, mkStdGen64)
import Test.Hspec (Spec, it)
import Test.Hspec.Wai (WaiSession, get, matchBody, request, shouldRespondWith, with)
import Test.Hspec.Wai.Matcher (MatchBody (..))

spec :: Spec
spec = with (app testSeed) $ do
  let (token, gen) = first Hex.encode (newToken testSeed)
      alice = encode $ User "alice"

  it "GET / returns 'index.html'" $ do
    get "/"
      `shouldRespondWith` 200
        { matchBody = MatchBody $ \_ actual ->
            if "<html>" `isInfixOf` toStrict actual
              then Nothing
              else Just ("Expected HTML content, got: " <> LT.unpack (decodeUtf8 actual))
        }

  it "GET /api.json returns OpenApi 2 descriptor" $ do
    get "/api.json"
      `shouldRespondWith` 200
        { matchBody = MatchBody $ \_ actual ->
            if "\"swagger\":\"2.0\"" `isInfixOf` toStrict actual
              then Nothing
              else Just ("Expected JSON OpenApi descriptor, got: " <> LT.unpack (decodeUtf8 actual))
        }

  it "GET /api/leaderboard returns empty list of scores at start" $ do
    get "/api/leaderboard"
      `shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 0}

  it "POST /api/register returns registration token given user is not registered" $ do
    postJSON "/api/register" alice
      `shouldRespondWith` 201
        { matchBody = MatchBody $ \_ t ->
            if t == encode (decodeUtf8 token)
              then
                Nothing
              else Just ("Expected token " ++ show token ++ ", but got " ++ show t)
        }

  it "GET /api/leaderboard returns list of one element after user registers" $ do
    void $ postJSON "/api/register" alice
    get "/api/leaderboard"
      `shouldRespondWith` 200 {matchBody = arrayOfLengthOf (Proxy @Score) 1}

  it "POST /api/register returns 400 given user is already registered" $ do
    void $ postJSON "/api/register" alice

    postJSON "/api/register" alice
      `shouldRespondWith` 400

  it "DELETE /api/register returns 200 and deletes user score given user is registered" $ do
    void $ postJSON "/api/register" alice

    request "DELETE" ("/api/register?token=" <> LBS.toStrict token) [] ""
      `shouldRespondWith` 200

    get ("/api/score?token=" <> LBS.toStrict token)
      `shouldRespondWith` 404

  it "GET /api/challenge returns next challenge given user is registered" $ do
    let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge {level = 0, expr = "x"}
    postJSON "/api/register" alice
      `shouldRespondWith` 201

    get ("/api/challenge?token=" <> LBS.toStrict token)
      `shouldRespondWith` fromString expected

  it "GET /api/challenge returns 400 given user is not registered" $
    get ("/api/challenge?token=" <> LBS.toStrict token)
      `shouldRespondWith` 400

  it "POST /api/challenge returns 200 given challenge response is correct" $ do
    let response = "\"x\""
    void $ postJSON "/api/register" alice

    postJSON ("/api/challenge?token=" <> LBS.toStrict token) response
      `shouldRespondWith` 200

  it "POST /api/challenge returns 400 given challenge response is incorrect" $ do
    let response = "\"y\""
    void $ postJSON "/api/register" alice

    postJSON ("/api/challenge?token=" <> LBS.toStrict token) response
      `shouldRespondWith` 400

  it "POST /api/challenge returns 400 given user is not registered" $ do
    let response = "\"x\""

    postJSON ("/api/challenge?token=" <> LBS.toStrict token) response
      `shouldRespondWith` 400

  it "POST /api/challenge returns 400 given wrong token" $ do
    let response = "\"x\""
        otherToken = Hex.encode $ fst $ newToken gen

    postJSON ("/api/challenge?token=" <> LBS.toStrict otherToken) response
      `shouldRespondWith` 400

  it "GET /api/challenge returns next level challenge after successful POST" $ do
    let expected = LT.unpack $ decodeUtf8 $ encode $ Challenge {level = 1, expr = "y"}

    void $ postJSON "/api/register" alice
    void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"x\""

    get ("/api/challenge?token=" <> LBS.toStrict token)
      `shouldRespondWith` fromString expected

  it "GET /api/challenge returns same challenge after failed POST" $ do
    let expected = LT.unpack $ decodeUtf8 $ encode $ head defaultChallenges

    void $ postJSON "/api/register" alice
    void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"y\""

    get ("/api/challenge?token=" <> LBS.toStrict token)
      `shouldRespondWith` fromString expected

  it "GET /api/score returns user current score" $ do
    void $ postJSON "/api/register" alice
    get ("/api/score?token=" <> LBS.toStrict token)
      `shouldRespondWith` 200
        { matchBody = MatchBody $ \_ actual ->
            case eitherDecode actual of
              Right (score :: Score) ->
                if score == Score {user = User "alice", grade = 0, lastTest = Nothing, lastResult = Nothing}
                  then Nothing
                  else Just $ "Expected score with grade 0, but got " ++ show score
              Left err -> Just $ "Failed to decode JSON: " ++ err
        }

  it "GET /api/score returns 404 given token is not registered" $ do
    get ("/api/score?token=" <> LBS.toStrict token)
      `shouldRespondWith` 404

  it "GET /api/score returns score with success given last challenge succeeded" $ do
    void $ postJSON "/api/register" alice
    void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"x\""

    get ("/api/score?token=" <> LBS.toStrict token)
      `shouldRespondWith` 200
        { matchBody = MatchBody $ \_ actual ->
            case eitherDecode actual of
              Right (score :: Score) ->
                if lastResult score == Just True
                  then Nothing
                  else Just $ "Expected score with success, but got " ++ show score
              Left err -> Just $ "Failed to decode JSON: " ++ err
        }

  it "GET /api/score returns score with failure given last challenge failed" $ do
    void $ postJSON "/api/register" alice
    void $ postJSON ("/api/challenge?token=" <> LBS.toStrict token) "\"y\""

    get ("/api/score?token=" <> LBS.toStrict token)
      `shouldRespondWith` 200
        { matchBody = MatchBody $ \_ actual ->
            case eitherDecode actual of
              Right (score :: Score) ->
                if lastResult score == Just False
                  then Nothing
                  else Just $ "Expected score with failure, but got " ++ show score
              Left err -> Just $ "Failed to decode JSON: " ++ err
        }

postJSON :: BS.ByteString -> ByteString -> WaiSession () SResponse
postJSON url = request "POST" url [("Content-Type", "application/json")]

arrayOfLengthOf :: forall elem proxy. (FromJSON elem) => proxy elem -> Int -> MatchBody
arrayOfLengthOf _ len = MatchBody $ \_ actual ->
  case eitherDecode actual of
    Right (scores :: [elem]) ->
      if length scores == len
        then Nothing
        else Just $ "Expected array of length " ++ show len ++ ", but got " ++ show (length scores)
    Left err -> Just $ "Failed to decode JSON: " ++ err

app :: StdGen -> IO Application
app g = do
  env <- makeEnv g defaultChallenges
  pure $ serveAPI env

testSeed :: StdGen
testSeed = mkStdGen64 42