<commit_before>{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE ViewPatterns         #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- Module      : Test.Signing
-- Copyright   : (c) 2013 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Test.Signing (tests) where

import           Control.Applicative
import           Control.Monad
import           Data.Attoparsec                as P
import           Data.Attoparsec.Char8          (char8, endOfLine, isDigit_w8)
import qualified Data.Attoparsec.Char8          as P8
import           Data.ByteString                (ByteString)
import qualified Data.ByteString.Char8          as BS
import           Data.List                      ((\\))
import           Data.Time
import           Network.AWS.Internal
import           Network.HTTP.Types             (urlDecode)
import           System.Directory
import           System.Locale
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit                     hiding (Test, path)

tests :: [Test]
tests =
    [ testGroup "Version4"
        [ testSigner "get-header-key-duplicate"
        -- , testSigner "get-header-value-order"
        -- , testSigner "get-header-value-trim"
        -- , testSigner "get-relative-relative"
        -- , testSigner "get-relative"
        -- , testSigner "get-slash-dot-slash"
        -- , testSigner "get-slash-pointless-dot"
        -- , testSigner "get-slash"
        -- , testSigner "get-slashes"
        -- , testSigner "get-space"
        -- , testSigner "get-unreserved"
        -- , testSigner "get-utf8"
        , testSigner "get-vanilla-empty-query-key"
        , testSigner "get-vanilla-query-order-key-case"
        , testSigner "get-vanilla-query-order-key"
        , testSigner "get-vanilla-query-order-value"
        , testSigner "get-vanilla-query-unreserved"
        , testSigner "get-vanilla-query"
        -- , testSigner "get-vanilla-ut8-query"
        , testSigner "get-vanilla"
        -- , testSigner "post-header-key-case"
        -- , testSigner "post-header-key-sort"
        -- , testSigner "post-header-value-case"
        -- , testSigner "post-vanilla-empty-query-value"
        -- , testSigner "post-vanilla-query-nonunreserved"
        -- , testSigner "post-vanilla-query-space"
        -- , testSigner "post-vanilla-query"
        -- , testSigner "post-vanilla"
        -- , testSigner "post-x-www-form-urlencoded-parameters"
        -- , testSigner "post-x-www-form-urlencoded"
        ]
    ]

testSigner :: String -> Test
testSigner name = testCase name $ do
    (rq, expect) <- loadMetadata SigningVersion4 name

    let hdr  = BS.unpack . fromMaybe "" $ "Date" `lookup` rqHeaders rq
        time = readTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" hdr

    (_ , actual) <- sign' rq auth NorthVirgnia time

    when (actual /= expect) $ do
        let f = \(BS.unpack -> x) (BS.unpack -> y) -> (x \\ y) ++ (y \\ x)

        print $ f (smdCReq expect) (smdCReq actual)
        print $ f (smdSTS expect) (smdSTS actual)
        print $ f (smdAuthz expect) (smdAuthz actual)
        print $ f (smdSReq expect) (smdSReq actual)

    assertEqual "Signing results do not match." expect actual
  where
    auth = Auth "AKIDEXAMPLE" "<KEY>"

loadMetadata :: SigningVersion -> String -> IO (RawRequest, SigningMetadata)<commit_msg>Re-enabling all version 4 signer tests<commit_after>{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE ViewPatterns         #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

-- Module      : Test.Signing
-- Copyright   : (c) 2013 <NAME> <<EMAIL>>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Test.Signing (tests) where

import           Control.Applicative
import           Control.Monad
import           Data.Attoparsec                as P
import           Data.Attoparsec.Char8          (char8, endOfLine, isDigit_w8)
import qualified Data.Attoparsec.Char8          as P8
import           Data.ByteString                (ByteString)
import qualified Data.ByteString.Char8          as BS
import           Data.List                      ((\\))
import           Data.Time
import           Network.AWS.Internal
import           Network.HTTP.Types             (urlDecode)
import           System.Directory
import           System.Locale
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit                     hiding (Test, path)

tests :: [Test]
tests =
    [ testGroup "Version4"
        [ testSigner "get-header-key-duplicate"
        , testSigner "get-header-value-order"
        , testSigner "get-header-value-trim"
        , testSigner "get-relative-relative"
        , testSigner "get-relative"
        , testSigner "get-slash-dot-slash"
        , testSigner "get-slash-pointless-dot"
        , testSigner "get-slash"
        , testSigner "get-slashes"
        , testSigner "get-space"
        , testSigner "get-unreserved"
        , testSigner "get-utf8"
        , testSigner "get-vanilla-empty-query-key"
        , testSigner "get-vanilla-query-order-key-case"
        , testSigner "get-vanilla-query-order-key"
        , testSigner "get-vanilla-query-order-value"
        , testSigner "get-vanilla-query-unreserved"
        , testSigner "get-vanilla-query"
        , testSigner "get-vanilla-ut8-query"
        , testSigner "get-vanilla"
        , testSigner "post-header-key-case"
        , testSigner "post-header-key-sort"
        , testSigner "post-header-value-case"
        , testSigner "post-vanilla-empty-query-value"
        , testSigner "post-vanilla-query-nonunreserved"
        , testSigner "post-vanilla-query-space"
        , testSigner "post-vanilla-query"
        , testSigner "post-vanilla"
        , testSigner "post-x-www-form-urlencoded-parameters"
        , testSigner "post-x-www-form-urlencoded"
        ]
    ]

testSigner :: String -> Test
testSigner name = testCase name $ do
    (rq, expect) <- loadMetadata SigningVersion4 name

    let hdr  = BS.unpack . fromMaybe "" $ "Date" `lookup` rqHeaders rq
        time = readTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" hdr

    (_ , actual) <- sign' rq auth NorthVirgnia time

    when (actual /= expect) $ do
        let f = \(BS.unpack -> x) (BS.unpack -> y) -> (x \\ y) ++ (y \\ x)

        print $ f (smdCReq expect) (smdCReq actual)
        print $ f (smdSTS expect) (smdSTS actual)
        print $ f (smdAuthz expect) (smdAuthz actual)
        print $ f (smdSReq expect) (smdSReq actual)

    assertEqual "Signing results do not match." expect actual
  where
    auth = Auth "AKIDEXAMPLE" "<KEY>"

loadMetadata :: SigningVersion -> String -> IO (RawRequest, SigningMetadata)
{'fraction_non_alphanumeric': 0.11840151208316457, 'fraction_numerical': 0.004995274740110706, 'mean_word_length': 2.0175152749490834, 'pattern_counts': {'":': 0, '<': 21, '<?xml version=': 0, '>': 29, 'https://': 0, 'lorem ipsum': 0, 'www.': 4, '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': '2317987', 'n_tokens_mistral': 2375, 'n_tokens_neox': 2314, 'n_words': 548}