<commit_before>{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Exception
import           Control.Lens
import           Control.Monad
import           Control.Monad.Error.Class
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Except
import           Data.Aeson.Lens
import           Data.ByteString.Char8       (ByteString)
import qualified Data.ByteString.Char8       as BC
import qualified Data.ByteString.Lazy        as BSL
import           Data.Either
import           Data.Function
import           Data.Maybe
import           Data.Monoid
import qualified Data.Text.Encoding          as T
import           Network.HTTP.Client         (HttpException (..))
import           Network.HTTP.Types          (Status (..), hLocation)
import           Network.URI
import           Network.Wreq                hiding (statusCode)
import           Servant.Common.Text
import           System.Environment
import           Test.Hspec
import           Text.HandsomeSoup
import           Text.XML.HXT.Core           (IOSArrow, XmlTree, runX)

import           Network.OAuth2.Server       hiding (refreshToken)
import qualified Network.OAuth2.Server.Types as OAuth2

main :: IO ()
main = do
    args <- getArgs
    case args of
        (uri:rest) | Just x <- parseURI uri -> withArgs rest $ hspec (tests x)
        _ -> putStrLn "First argument must be a server URI."

tests :: URI -> Spec
tests base_uri = do
    describe "verify endpoint" $ do

        it "returns a response when given valid credentials and a matching token" $ do
            resp <- verifyToken base_uri client1 (fst tokenVV)
            resp `shouldSatisfy` isRight

        it "returns an error when given valid credentials and a token from another client" $ do
            resp <- verifyToken base_uri client2 (fst tokenVV)
            resp `shouldBe` Left "404 Not Found - This is not a valid token."

        it "returns an error when given invalid client credentials" $ do
            resp <- verifyToken base_uri client3 (fst tokenVV)
            resp `shouldBe` Left "401 Unauthorized - Login to validate a token."

        it "returns an error when given a token which has been revoked" $ do
            resp <- verifyToken base_uri client1 (fst tokenRV)
            resp `shouldBe` Left "404 Not Found - This is not a valid token."

        it "returns an error when given a token which is not valid" $ do
            resp <- verifyToken base_uri client1 (fst tokenDERP)
            resp `shouldBe` Left "404 Not Found - This is not a valid token."

    describe "token endpoint" $ do
        it "uses the same details when refreshing a token" $ do
            -- Verify a good token.
            t1' <- verifyToken base_uri client1 (fst tokenVV)
            t1 <- either (\_ -> fail "Valid token is invalid, so can't test!")
                         (return) t1'

            -- Refresh it.
            t2_id' <- runExceptT $ refreshToken base_uri client1 (snd tokenVV)
            t2_id <- either (\e -> fail $ "Couldn't refresh: " <> e)
                            (return) t2_id'

            -- Verify that token.
            t2' <- verifyToken base_uri client1 t2_id
            t2 <- either (\_ -> fail "Couldn't verify new token.")
                         (return) t2'

            -- If we got a new refresh token, the old one should be revoked.
            when (isJust $ OAuth2.refreshToken t2) $ do
                    r1 <- verifyToken base_uri client1 (snd tokenVV)
                    r1 `shouldBe` Left "404 Not Found - This is not a valid token."

            -- The original bearer token should now be revoked.
            t1'' <- verifyToken base_uri client1 (fst tokenVV)
            t1'' `shouldBe` Left "404 Not Found - This is not a valid token."

            -- Compare them in all the respects which should be identical.
            (shouldBe `on` tokenType) t1 t2
            -- (shouldBe `on` accessToken) t1 t2
            -- (shouldBe `on` refreshToken) t1 t2
            -- (shouldBe `on` tokenExpiresIn) t1 t2
            (shouldBe `on` tokenUserID) t1 t2
            (shouldBe `on` tokenClientID) t1 t2
            (shouldBe `on` tokenScope) t1 t2

        it "revokes the existing token when it is refreshed" $ do
            let tok = tokenVV

            -- Verify a pair of existing tokens.
            t1' <- verifyToken base_uri client1 (fst tok)
            t1' `shouldSatisfy` isRight

            t1r' <- verifyToken base_uri client1 (snd tok)
            t1r' `shouldSatisfy` isRight

            -- Refresh to get new bearer and, optionally, refresh tokens.
            t2_id' <- runExceptT $ refreshToken base_uri client1 (snd tok)
            t2_id <- either (\e -> fail $ "Couldn't refresh: " <> e)
                            (return) t2_id'

            -- Verify new bearer token.
            t2' <- verifyToken base_uri client1 t2_id
            t2 <- either (\_ -> fail "Couldn't verify new token.")
                         (return) t2'

            -- The old bearer token should now be invalid.
            t1_2' <- verifyToken base_uri client1 (fst tok)
            t1_2' `shouldBe` Left "404 Not Found - This is not a valid token."

            -- If we got a new refresh token, the old one should be revoked.
            when (isJust $ OAuth2.refreshToken t2) $ do
                    r1 <- verifyToken base_uri client1 (snd tok)
                    r1 `shouldBe` Left "404 Not Found - This is not a valid token."<commit_msg>Acceptance-tests: use space valid token for second destructive test<commit_after>{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}

module Main where

import           Control.Applicative
import           Control.Arrow
import           Control.Exception
import           Control.Lens
import           Control.Monad
import           Control.Monad.Error.Class
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Except
import           Data.Aeson.Lens
import           Data.ByteString.Char8       (ByteString)
import qualified Data.ByteString.Char8       as BC
import qualified Data.ByteString.Lazy        as BSL
import           Data.Either
import           Data.Function
import           Data.Maybe
import           Data.Monoid
import qualified Data.Text.Encoding          as T
import           Network.HTTP.Client         (HttpException (..))
import           Network.HTTP.Types          (Status (..), hLocation)
import           Network.URI
import           Network.Wreq                hiding (statusCode)
import           Servant.Common.Text
import           System.Environment
import           Test.Hspec
import           Text.HandsomeSoup
import           Text.XML.HXT.Core           (IOSArrow, XmlTree, runX)

import           Network.OAuth2.Server       hiding (refreshToken)
import qualified Network.OAuth2.Server.Types as OAuth2

main :: IO ()
main = do
    args <- getArgs
    case args of
        (uri:rest) | Just x <- parseURI uri -> withArgs rest $ hspec (tests x)
        _ -> putStrLn "First argument must be a server URI."

tests :: URI -> Spec
tests base_uri = do
    describe "verify endpoint" $ do

        it "returns a response when given valid credentials and a matching token" $ do
            resp <- verifyToken base_uri client1 (fst tokenVV)
            resp `shouldSatisfy` isRight

        it "returns an error when given valid credentials and a token from another client" $ do
            resp <- verifyToken base_uri client2 (fst tokenVV)
            resp `shouldBe` Left "404 Not Found - This is not a valid token."

        it "returns an error when given invalid client credentials" $ do
            resp <- verifyToken base_uri client3 (fst tokenVV)
            resp `shouldBe` Left "401 Unauthorized - Login to validate a token."

        it "returns an error when given a token which has been revoked" $ do
            resp <- verifyToken base_uri client1 (fst tokenRV)
            resp `shouldBe` Left "404 Not Found - This is not a valid token."

        it "returns an error when given a token which is not valid" $ do
            resp <- verifyToken base_uri client1 (fst tokenDERP)
            resp `shouldBe` Left "404 Not Found - This is not a valid token."

    describe "token endpoint" $ do
        it "uses the same details when refreshing a token" $ do
            -- Verify a good token.
            t1' <- verifyToken base_uri client1 (fst tokenVV)
            t1 <- either (\_ -> fail "Valid token is invalid, so can't test!")
                         (return) t1'

            -- Refresh it.
            t2_id' <- runExceptT $ refreshToken base_uri client1 (snd tokenVV)
            t2_id <- either (\e -> fail $ "Couldn't refresh: " <> e)
                            (return) t2_id'

            -- Verify that token.
            t2' <- verifyToken base_uri client1 t2_id
            t2 <- either (\_ -> fail "Couldn't verify new token.")
                         (return) t2'

            -- If we got a new refresh token, the old one should be revoked.
            when (isJust $ OAuth2.refreshToken t2) $ do
                    r1 <- verifyToken base_uri client1 (snd tokenVV)
                    r1 `shouldBe` Left "404 Not Found - This is not a valid token."

            -- The original bearer token should now be revoked.
            t1'' <- verifyToken base_uri client1 (fst tokenVV)
            t1'' `shouldBe` Left "404 Not Found - This is not a valid token."

            -- Compare them in all the respects which should be identical.
            (shouldBe `on` tokenType) t1 t2
            -- (shouldBe `on` accessToken) t1 t2
            -- (shouldBe `on` refreshToken) t1 t2
            -- (shouldBe `on` tokenExpiresIn) t1 t2
            (shouldBe `on` tokenUserID) t1 t2
            (shouldBe `on` tokenClientID) t1 t2
            (shouldBe `on` tokenScope) t1 t2

        it "revokes the existing token when it is refreshed" $ do
            let tok = tokenVV2

            -- Verify a pair of existing tokens.
            t1' <- verifyToken base_uri client1 (fst tok)
            t1' `shouldSatisfy` isRight

            t1r' <- verifyToken base_uri client1 (snd tok)
            t1r' `shouldSatisfy` isRight

            -- Refresh to get new bearer and, optionally, refresh tokens.
            t2_id' <- runExceptT $ refreshToken base_uri client1 (snd tok)
            t2_id <- either (\e -> fail $ "Couldn't refresh: " <> e)
                            (return) t2_id'

            -- Verify new bearer token.
            t2' <- verifyToken base_uri client1 t2_id
            t2 <- either (\_ -> fail "Couldn't verify new token.")
                         (return) t2'

            -- The old bearer token should now be invalid.
            t1_2' <- verifyToken base_uri client1 (fst tok)
            t1_2' `shouldBe` Left "404 Not Found - This is not a valid token."

            -- If we got a new refresh token, the old one should be revoked.
            when (isJust $ OAuth2.refreshToken t2) $ do
                    r1 <- verifyToken base_uri client1 (snd tok)
                    r1 `shouldBe` Left "404 Not Found - This is not a valid token."
{'fraction_non_alphanumeric': 0.07680815537393444, 'fraction_numerical': 0.016609543896651726, 'mean_word_length': 1.7434908389585342, 'pattern_counts': {'":': 0, '<': 53, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1025381', 'n_tokens_mistral': 3213, 'n_tokens_neox': 3037, 'n_words': 1185}