{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE QuasiQuotes        #-}

module Main where

import           Data.Aeson
import           Data.ByteString                             (ByteString)
import           Data.Either
import qualified Data.Text                                   as T
import           System.Directory
import           Test.Hspec
import           Testing.CurlRunnings
import           Testing.CurlRunnings.Internal
import qualified Testing.CurlRunnings.Internal.Aeson         as A
import           Testing.CurlRunnings.Internal.Headers
import           Testing.CurlRunnings.Internal.KeyValuePairs
import           Testing.CurlRunnings.Internal.Parser
import           Testing.CurlRunnings.Internal.Payload
import           Text.RawString.QQ

main :: IO ()
main = hspec $
  describe "Curl Runnings" $ do
  it "should provide valid example yaml specs" $
    testValidSpec "/examples/example-spec.yaml"

  it "should provide valid example json specs" $
    testValidSpec "/examples/example-spec.json"

  it "should provide valid example dhall specs" $
    testValidSpec "/examples/example-spec.dhall"

  -- note that this doesn't actually try to parse the interpolations themselves,
  -- but that would be useful thing to add here
  it "should provid a valid interpolation spec" $
    testValidSpec "/examples/interpolation-spec.yaml"

  it "should parse valid queries" $ do
    parseQuery "just some text" `shouldSatisfy` isRight
    parseQuery "$<RESPONSES[0].key.key>" `shouldSatisfy` isRight
    parseQuery "$<RESPONSES[0].key.key[0].key_with_underscores>" `shouldSatisfy` isRight
    parseQuery "$<RESPONSES[0].key.key[0]._key_starts_with_underscores>" `shouldSatisfy` isRight
    parseQuery "$<RESPONSES[100].key.key[0].key_with_underscores>" `shouldSatisfy` isRight
    parseQuery "some text before $<RESPONSES[100].key.key[0].key_with_underscores> and after" `shouldSatisfy` isRight
    parseQuery "some $<RESPONSES[100]> querires $<RESPONSES[100]>" `shouldSatisfy` isRight
    parseQuery "some $<RESPONSES[100]> querires $<RESPONSES[100]> ${SOME_ENV_VARIABLE} asdf" `shouldSatisfy` isRight
    parseQuery "$<SUITE[0].key.key>" `shouldSatisfy` isRight -- legacy SUITE should still be supported

  it "should reject invalid queries" $ do
    parseQuery "$<" `shouldSatisfy` isLeft
    parseQuery "$<RESPONSES[f].key>" `shouldSatisfy` isLeft
    parseQuery "$<RESPONSES[1].key[r]>" `shouldSatisfy` isLeft
    parseQuery "$<RESPONSES[1].key[1][1] $<>>" `shouldSatisfy` isLeft
    parseQuery "$<RESPONSES[1].key[1][1]" `shouldSatisfy` isLeft
    parseQuery "$<RESPONSES[1]>.key[1][1] ${" `shouldSatisfy` isLeft
    parseQuery "$<POOP[0].key.key>" `shouldSatisfy` isLeft
    parseQuery "some text $<BAD_RESPONSES_REF[0].key.key>" `shouldSatisfy` isLeft

  it "should parse valid headers" $ do
    parseHeaders "key:" `shouldBeHeaders` [("key", "")]
    parseHeaders "key: ;" `shouldBeHeaders` [("key", "")]
    parseHeaders "key:" `shouldBeHeaders` [("key", "")]
    parseHeaders "key: value" `shouldBeHeaders` [("key", "value")]
    parseHeaders "key: value;" `shouldBeHeaders` [("key", "value")]
    parseHeaders "key : value" `shouldBeHeaders` [("key", "value")]
    parseHeaders "key :value" `shouldBeHeaders` [("key", "value")]
    parseHeaders "key : value " `shouldBeHeaders` [("key", "value")]
    parseHeaders "  key : value " `shouldBeHeaders` [("key", "value")]
    parseHeaders "key name : value" `shouldBeHeaders` [("key name", "value")]
    parseHeaders "key : value name " `shouldBeHeaders` [("key", "value name")]
    parseHeaders "key1 : value1:value2;" `shouldBeHeaders` [("key1", "value1:value2")]
    parseHeaders "key1 : value1:value2" `shouldBeHeaders` [("key1", "value1:value2")]
    parseHeaders "key1 : value1 ; key2: value2" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]
    parseHeaders "key1 : value1 ;\n key2: value2" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]
    parseHeaders "key1 : value1 ;\n key2: value2\n" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]
    parseHeaders "key1 : value1 ;\n key2: value2;" `shouldBeHeaders` [("key1", "value1"), ("key2", "value2")]
    parseHeaders "Content-Type : application/json" `shouldBeHeaders` [("Content-Type", "application/json")]
    parseHeaders "$<RESPONSES[1].key[r]>: $<RESPONSES[100]> ;" `shouldBeHeaders` [("$<RESPONSES[1].key[r]>", "$<RESPONSES[100]>")]

  it "should reject invalid headers" $ do
    parseHeaders "" `shouldSatisfy` isLeft
    parseHeaders "\n" `shouldSatisfy` isLeft
    parseHeaders "£key: value" `shouldSatisfy` isLeft
    parseHeaders "key: £value" `shouldSatisfy` isLeft
    parseHeaders "key" `shouldSatisfy` isLeft
    parseHeaders "key ;" `shouldSatisfy` isLeft
    parseHeaders " : value" `shouldSatisfy` isLeft
    parseHeaders " : value ;" `shouldSatisfy` isLeft
    parseHeaders " : value ; key : value2" `shouldSatisfy` isLeft

  it "arrayGet should handle positive and negative indexes correctly" $ do
    let a = [1, 2, 3]
        b = [] :: [Int]
    (arrayGet a 0) `shouldBe` Just (1 :: Integer)
    (arrayGet a 1) `shouldBe` Just (2 :: Integer)
    (arrayGet a 2) `shouldBe` Just (3 :: Integer)
    (arrayGet a (-1)) `shouldBe` Just (3 :: Integer)
    (arrayGet a (-2)) `shouldBe` Just (2 :: Integer)
    (arrayGet a (-3)) `shouldBe` Just (1 :: Integer)
    (arrayGet a (-4)) `shouldBe` Nothing
    (arrayGet a 3) `shouldBe` Nothing
    (arrayGet b 0) `shouldBe` Nothing
    (arrayGet b 1) `shouldBe` Nothing
    (arrayGet b (-1)) `shouldBe` Nothing

  it "should decode valid key-value pairs" $ do
    [r|{"key": "value"}|] `shouldBeKeyValuePairs` [("key", "value")]
    [r|{"key": 1}|] `shouldBeKeyValuePairs` [("key", "1")]
    [r|{"key": 9.999}|] `shouldBeKeyValuePairs` [("key", "9.999")]
    [r|{"key": true}|] `shouldBeKeyValuePairs` [("key", "true")]
    [r|{"key1": 10, "key2": "a", "key3": 1.1, "key4": false}|]
      `shouldBeKeyValuePairs`
      [ ("key1", "10")
      , ("key2", "a")
      , ("key3", "1.1")
      , ("key4", "false")
      ]

  it "should not decode invalid key-value pairs" $ do
    decodeKeyValuePair [r|{"key": null}|] `shouldSatisfy` isLeft
    decodeKeyValuePair [r|{"key": [1, "1"]}|] `shouldSatisfy` isLeft
    decodeKeyValuePair [r|{"key": {"nestedKey": true}}|] `shouldSatisfy` isLeft
    decodeKeyValuePair [r|{"key1": "a", "key2": {"nestedKey": true}}|] `shouldSatisfy` isLeft

  it "should decode request body" $ do
    decodePayload [r|{"bodyType": "urlencoded", "content": {"key1": "value1"}}|] `shouldSatisfy` isURLEncoded
    decodePayload [r|{"bodyType": "json", "content": {"key1": "value1"}}|] `shouldSatisfy` isJSON
    decodePayload [r|{"bodyType": "json", "content": ["key1", "value1"]}|] `shouldSatisfy` isJSON
    decodePayload [r|{"content": {"key1": "value1"}}|] `shouldSatisfy` isJSON
    decodePayload [r|{"other": {"key1": "value1"}}|] `shouldSatisfy` isJSON
    decodePayload [r|{"other": ["key1", "value1"]}|] `shouldSatisfy` isJSON
    -- "other" is ignored
    decodePayload [r|{"bodyType": "json", "content": {"a": "b"}, "other": 1}|] `shouldSatisfy` isJSON

  it "should not decode invalid request body" $ do
    decodePayload [r|{"bodyType": "plain", "content": {"key1": "value1"}}|] `shouldSatisfy` isLeft
    decodePayload [r|{"bodyType": "urlencoded"}|] `shouldSatisfy` isLeft
    decodePayload [r|{"bodyType": "json"}|] `shouldSatisfy` isLeft
    decodePayload [r|{"bodyType": "urlencoded", "content": ["key1", "value1"]}|] `shouldSatisfy` isLeft

testValidSpec :: String -> IO ()
testValidSpec file = do
  currentDirectory <- getCurrentDirectory
  spec <- decodeFile (currentDirectory ++ file)
  spec `shouldSatisfy` isRight

decodeKeyValuePair :: ByteString -> Either String KeyValuePairs
decodeKeyValuePair = eitherDecodeStrict

decodePayload :: ByteString -> Either String Payload
decodePayload = eitherDecodeStrict

shouldBeHeaders :: (Eq a, Show a) => Either a Headers -> [(T.Text, T.Text)] -> Expectation
shouldBeHeaders actual expected =
  let expectedHeaders = Right . HeaderSet $ uncurry Header <$> expected in
    actual `shouldBe` expectedHeaders

shouldBeKeyValuePairs :: ByteString -> [(A.KeyType, T.Text)] -> Expectation
shouldBeKeyValuePairs j expected = actual `shouldBe` expectedKeyValuePairs where
  actual = eitherDecodeStrict j
  expectedKeyValuePairs = Right . KeyValuePairs $ uncurry KeyValuePair <$> expected

isURLEncoded :: Either String Payload -> Bool
isURLEncoded (Right (URLEncoded _)) = True
isURLEncoded _                      = False

isJSON :: Either String Payload -> Bool
isJSON (Right (JSON _)) = True
isJSON _                = False