{-# LANGUAGE TypeApplications #-}

module Data.GenValidity.URISpec (spec) where

import Data.GenValidity.URI
import Data.Validity.URI
import Network.URI
import Test.QuickCheck
import Test.Syd
import Test.Syd.Validity

spec :: Spec
spec = do
  describe "GenValid URIAuth" $ do
    genValidSpec @URIAuth

  describe "URI" $ do
    describe "considers these examples from the spec valid" $ do
      let roundtripSpec string = it ("Considers valid: " <> show string) $
            case parseURIReference string of
              Nothing -> expectationFailure "should not happen."
              Just uri -> case parseURIReference (dangerousURIToString uri) of
                Nothing -> expectationFailure "should not happen."
                Just uri' -> uri' `shouldBe` uri

          considersValidSpec string = it ("Considers valid: " <> show string) $
            case parseURIReference string of
              Nothing -> expectationFailure "should not happen."
              Just uri -> shouldBeValid uri

          exampleSpec string = do
            considersValidSpec string
            roundtripSpec string

      -- From the spec
      exampleSpec "ftp://ftp.is.co.za/rfc/rfc1808.txt"
      exampleSpec "http://www.ietf.org/rfc/rfc2396.txt"
      exampleSpec "ldap://[2001:db8::7]/c=GB?objectClass?one"
      exampleSpec "mailto:John.Doe@example.com"
      exampleSpec "news:comp.infosystems.www.servers.unix"
      exampleSpec "tel:+1-816-555-1212"
      exampleSpec "telnet://192.0.2.16:80/"
      exampleSpec "urn:oasis:names:specification:docbook:dtd:xml:4.1.2"
      exampleSpec "foo://example.com:8042/over/there?name=ferret#nose"
      exampleSpec "urn:example:animal:ferret:nose"

      -- Extras
      exampleSpec "//:...@255.255.255.241:55?:%5f@67/?P?#6S3e"
      exampleSpec "//4+5*2:...@!8I)Z?%f4?#%aeF"

    describe "genScheme" $ do
      it "generates schemes that are considered valid by validateScheme" $
        forAll genScheme $ \schemeCandidate ->
          case prettyValidation (validateScheme schemeCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genUserInfo" $ do
      it "generates user info  that are considered valid by validateUserInfo" $
        forAll genUserInfo $ \userinfoCandidate ->
          case prettyValidation (validateUserInfo userinfoCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genHost" $ do
      it "generates user info  that are considered valid by validateHost" $
        forAll genHost $ \hostCandidate ->
          case prettyValidation (validateHost hostCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genPort" $ do
      it "generates user info  that are considered valid by validatePort" $
        forAll genPort $ \portCandidate ->
          case prettyValidation (validatePort portCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genPath" $ do
      it "generates user info  that are considered valid by validatePath" $
        forAll genPath $ \portCandidate ->
          case prettyValidation (validatePath portCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genQuery" $ do
      it "generates user info  that are considered valid by validateQuery" $
        forAll genQuery $ \portCandidate ->
          case prettyValidation (validateQuery portCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genFragment" $ do
      it "generates user info  that are considered valid by validateFragment" $
        forAll genFragment $ \portCandidate ->
          case prettyValidation (validateFragment portCandidate) of
            Nothing -> pure ()
            Just err -> expectationFailure err

    describe "genAbsoluteURI" $ do
      it "generates valid URI values" $
        genGeneratesValid genAbsoluteURI
      it "generates values that roundtrip through parseAbsoluteURI" $
        forAll genAbsoluteURI $ \uri ->
          case parseAbsoluteURI (dangerousURIToString uri) of
            Nothing -> expectationFailure "Should have parsed."
            Just uri' -> uri' `shouldBe` uri

    describe "genURIReference" $ do
      it "generates valid URI values" $
        genGeneratesValid genURIReference
      it "generates values that roundtrip through parseURIReference" $
        forAll genURIReference $ \uri ->
          case parseURIReference (dangerousURIToString uri) of
            Nothing -> expectationFailure "Should have parsed."
            Just uri' -> uri' `shouldBe` uri

    describe "genRelativeReference" $ do
      it "generates valid URI values" $
        genGeneratesValid genRelativeReference
      it "generates values that roundtrip through parseRelativeReference" $
        forAll genRelativeReference $ \uri ->
          case parseRelativeReference (dangerousURIToString uri) of
            Nothing -> expectationFailure "Should have parsed."
            Just uri' -> uri' `shouldBe` uri

    describe "genURI" $ do
      it "generates valid URI values" $
        genGeneratesValid genURI
      it "generates values that roundtrip through parseURI" $
        forAll genURI $ \uri ->
          case parseURI (dangerousURIToString uri) of
            Nothing -> expectationFailure "Should have parsed."
            Just uri' -> uri' `shouldBe` uri

    modifyMaxSuccess (* 10) $
      describe "GenValid URI" $ do
        genValidSpec @URI

        it "generates values that roundtrip through parseURIReference" $
          forAllValid $ \uri ->
            case parseURIReference (dangerousURIToString uri) of
              Nothing -> expectationFailure "should not happen."
              Just uri' -> uri' `shouldBe` uri

    it "produces URI that roundtrip through parsing" $
      forAll genValid $ \uri ->
        case parseURIReference (dangerousURIToString uri) of
          Nothing -> expectationFailure $ "Could not parse uri: " <> show (dangerousURIToString uri)
          Just uri' -> uri' `shouldBe` uri