diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/Crypto/Macaroon/Instances.hs | 11 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Tests.hs | 2 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Internal/Tests.hs | 86 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Tests.hs | 63 | ||||
-rw-r--r-- | test/Sanity.hs | 26 | ||||
-rw-r--r-- | test/main.hs | 10 |
6 files changed, 121 insertions, 77 deletions
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs index 6955637..019c094 100644 --- a/test/Crypto/Macaroon/Instances.hs +++ b/test/Crypto/Macaroon/Instances.hs | |||
@@ -11,9 +11,10 @@ This test suite is based on the pymacaroons test suite: | |||
11 | -} | 11 | -} |
12 | module Crypto.Macaroon.Instances where | 12 | module Crypto.Macaroon.Instances where |
13 | 13 | ||
14 | import Control.Monad | 14 | import Control.Applicative |
15 | import Control.Monad | ||
15 | import Data.Byteable | 16 | import Data.Byteable |
16 | import qualified Data.ByteString as BS | 17 | import qualified Data.ByteString as BS |
17 | import qualified Data.ByteString.Char8 as B8 | 18 | import qualified Data.ByteString.Char8 as B8 |
18 | import Data.Hex | 19 | import Data.Hex |
19 | import Data.List | 20 | import Data.List |
@@ -32,10 +33,10 @@ instance Arbitrary Url where | |||
32 | domain <- elements [".com",".net"] | 33 | domain <- elements [".com",".net"] |
33 | return . Url . B8.pack $ (protocol ++ name ++ domain) | 34 | return . Url . B8.pack $ (protocol ++ name ++ domain) |
34 | 35 | ||
35 | newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show) | 36 | newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show) |
36 | 37 | ||
37 | instance Arbitrary Secret where | 38 | instance Arbitrary BSSecret where |
38 | arbitrary = Secret . B8.pack <$> scale (*3) arbitrary | 39 | arbitrary = BSSecret . B8.pack <$> scale (*3) arbitrary |
39 | 40 | ||
40 | newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) | 41 | newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) |
41 | 42 | ||
diff --git a/test/Crypto/Macaroon/Tests.hs b/test/Crypto/Macaroon/Tests.hs index 25d77c8..c934cc1 100644 --- a/test/Crypto/Macaroon/Tests.hs +++ b/test/Crypto/Macaroon/Tests.hs | |||
@@ -12,7 +12,7 @@ This test suite is based on the pymacaroons test suite: | |||
12 | module Crypto.Macaroon.Tests where | 12 | module Crypto.Macaroon.Tests where |
13 | 13 | ||
14 | import Data.Byteable | 14 | import Data.Byteable |
15 | import qualified Data.ByteString.Char8 as B8 | 15 | import qualified Data.ByteString.Char8 as B8 |
16 | import Data.Hex | 16 | import Data.Hex |
17 | import Test.Tasty | 17 | import Test.Tasty |
18 | import Test.Tasty.HUnit | 18 | import Test.Tasty.HUnit |
diff --git a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs new file mode 100644 index 0000000..826b631 --- /dev/null +++ b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs | |||
@@ -0,0 +1,86 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | {-| | ||
3 | Copyright : (c) 2015 Julien Tanguy | ||
4 | License : BSD3 | ||
5 | |||
6 | Maintainer : julien.tanguy@jhome.fr | ||
7 | |||
8 | |||
9 | This test suite is based on the pymacaroons test suite: | ||
10 | <https://github.com/ecordell/pymacaroons> | ||
11 | -} | ||
12 | module Crypto.Macaroon.Verifier.Internal.Tests where | ||
13 | |||
14 | import Data.Bool | ||
15 | import qualified Data.ByteString as BS | ||
16 | import qualified Data.ByteString.Char8 as B8 | ||
17 | import Data.Either | ||
18 | import Data.Either.Validation | ||
19 | import Data.List | ||
20 | import Test.Tasty | ||
21 | import Test.Tasty.HUnit | ||
22 | import Test.Tasty.QuickCheck hiding (Failure, Success) | ||
23 | |||
24 | import Crypto.Macaroon | ||
25 | import Crypto.Macaroon.Verifier.Internal | ||
26 | |||
27 | import Crypto.Macaroon.Instances | ||
28 | |||
29 | tests :: TestTree | ||
30 | tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs | ||
31 | , firstParty | ||
32 | ] | ||
33 | |||
34 | {- | ||
35 | - Test fixtures | ||
36 | -} | ||
37 | sec = B8.pack "this is our super secret key; only we should know it" | ||
38 | |||
39 | m :: Macaroon | ||
40 | m = create sec key loc | ||
41 | where | ||
42 | key = B8.pack "we used our sec key" | ||
43 | loc = B8.pack "http://mybank/" | ||
44 | |||
45 | m2 :: Macaroon | ||
46 | m2 = addFirstPartyCaveat "test = caveat" m | ||
47 | |||
48 | vtest :: Caveat -> IO (Maybe (Either ValidationError ())) | ||
49 | vtest c = return $ if "test" `BS.isPrefixOf` cid c then | ||
50 | Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "test = caveat" == cid c | ||
51 | else Nothing | ||
52 | |||
53 | |||
54 | m3 :: Macaroon | ||
55 | m3 = addFirstPartyCaveat "value = 42" m2 | ||
56 | |||
57 | vval :: Caveat -> IO (Maybe (Either ValidationError ())) | ||
58 | vval c = return $ if "value" `BS.isPrefixOf` cid c then | ||
59 | Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "value = 42" == cid c | ||
60 | else Nothing | ||
61 | |||
62 | |||
63 | {- | ||
64 | - Tests | ||
65 | -} | ||
66 | |||
67 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm) | ||
68 | |||
69 | |||
70 | firstParty = testGroup "First party caveats" [ | ||
71 | testCase "Zero caveat" $ do | ||
72 | res <- verifyCavs [] m :: IO (Either ValidationError Macaroon) | ||
73 | Right m @=? res | ||
74 | , testCase "One caveat empty" $ do | ||
75 | res <- verifyCavs [] m2 :: IO (Either ValidationError Macaroon) | ||
76 | Left NoVerifier @=? res | ||
77 | , testCase "One caveat fail" $ do | ||
78 | res <- verifyCavs [vval] m2 :: IO (Either ValidationError Macaroon) | ||
79 | Left NoVerifier @=? res | ||
80 | , testCase "One caveat win" $ do | ||
81 | res <- verifyCavs [vtest] m2 :: IO (Either ValidationError Macaroon) | ||
82 | Right m2 @=? res | ||
83 | , testCase "Two caveat win" $ do | ||
84 | res <- verifyCavs [vtest, vval] m3 :: IO (Either ValidationError Macaroon) | ||
85 | Right m3 @=? res | ||
86 | ] | ||
diff --git a/test/Crypto/Macaroon/Verifier/Tests.hs b/test/Crypto/Macaroon/Verifier/Tests.hs index 101fa26..d69ad8d 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs | |||
@@ -12,21 +12,20 @@ This test suite is based on the pymacaroons test suite: | |||
12 | module Crypto.Macaroon.Verifier.Tests where | 12 | module Crypto.Macaroon.Verifier.Tests where |
13 | 13 | ||
14 | 14 | ||
15 | import Data.List | 15 | import qualified Data.ByteString.Char8 as B8 |
16 | import qualified Data.ByteString.Char8 as B8 | 16 | import Data.Either |
17 | import Test.Tasty | 17 | import Data.List |
18 | -- import Test.Tasty.HUnit | 18 | import Test.Tasty |
19 | import Test.Tasty.QuickCheck | 19 | import Test.Tasty.HUnit |
20 | import Test.Tasty.QuickCheck | ||
20 | 21 | ||
21 | import Crypto.Macaroon | 22 | import Crypto.Macaroon |
22 | import Crypto.Macaroon.Verifier | 23 | import Crypto.Macaroon.Verifier |
23 | 24 | ||
24 | import Crypto.Macaroon.Instances | 25 | import Crypto.Macaroon.Instances |
25 | 26 | ||
26 | tests :: TestTree | 27 | tests :: TestTree |
27 | tests = testGroup "Crypto.Macaroon.Verifier" [ sigs | 28 | tests = testGroup "Crypto.Macaroon.Verifier" [ ] |
28 | , firstParty | ||
29 | ] | ||
30 | 29 | ||
31 | {- | 30 | {- |
32 | - Test fixtures | 31 | - Test fixtures |
@@ -45,52 +44,8 @@ m2 = addFirstPartyCaveat "test = caveat" m | |||
45 | m3 :: Macaroon | 44 | m3 :: Macaroon |
46 | m3 = addFirstPartyCaveat "value = 42" m2 | 45 | m3 = addFirstPartyCaveat "value = 42" m2 |
47 | 46 | ||
48 | exTC = verifyExact "test" "caveat" (many' letter_ascii) <???> "test = caveat" | ||
49 | exTZ = verifyExact "test" "bleh" (many' letter_ascii) <???> "test = bleh" | ||
50 | exV42 = verifyExact "value" 42 decimal <???> "value = 42" | ||
51 | exV43 = verifyExact "value" 43 decimal <???> "value = 43" | ||
52 | |||
53 | funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) <???> "test startsWith cav" | ||
54 | funTV43lte = verifyFun "value" (<= 43) decimal <???> "value <= 43" | ||
55 | |||
56 | allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] | ||
57 | |||
58 | {- | 47 | {- |
59 | - Tests | 48 | - Tests |
60 | -} | 49 | -} |
61 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok | ||
62 | 50 | ||
63 | firstParty = testGroup "First party caveats" [ | 51 | -- TODO |
64 | testGroup "Pure verifiers" [ | ||
65 | testProperty "Zero caveat" $ | ||
66 | forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m) | ||
67 | , testProperty "One caveat" $ | ||
68 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
69 | Ok == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | ||
70 | , Failed === verifyCavs vs m2 | ||
71 | ]) | ||
72 | , testProperty "Two Exact" $ | ||
73 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
74 | Ok == verifyCavs vs m3 .&&. | ||
75 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | ||
76 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | ||
77 | , Failed === verifyCavs vs m3 | ||
78 | ]) | ||
79 | ] | ||
80 | , testGroup "Pure verifiers with sig" [ | ||
81 | testProperty "Zero caveat" $ | ||
82 | forAll (sublistOf allvs) (\vs -> Ok == verifyMacaroon sec vs m) | ||
83 | , testProperty "One caveat" $ | ||
84 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
85 | Ok == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | ||
86 | , Failed === verifyMacaroon sec vs m2 | ||
87 | ]) | ||
88 | , testProperty "Two Exact" $ | ||
89 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
90 | Ok == verifyMacaroon sec vs m3 .&&. | ||
91 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | ||
92 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | ||
93 | , Failed === verifyMacaroon sec vs m3 | ||
94 | ]) | ||
95 | ] | ||
96 | ] | ||
diff --git a/test/Sanity.hs b/test/Sanity.hs index 8def3ca..635e627 100644 --- a/test/Sanity.hs +++ b/test/Sanity.hs | |||
@@ -1,17 +1,17 @@ | |||
1 | {-#LANGUAGE OverloadedStrings#-} | 1 | {-# LANGUAGE OverloadedStrings #-} |
2 | module Sanity where | 2 | module Sanity where |
3 | 3 | ||
4 | import Crypto.Hash | 4 | import Crypto.Hash |
5 | import Data.ByteString (ByteString) | 5 | import Data.Byteable |
6 | import qualified Data.ByteString as B | 6 | import Data.ByteString (ByteString) |
7 | import Data.Hex | 7 | import qualified Data.ByteString as B |
8 | import Data.Byteable | 8 | import Data.Hex |
9 | 9 | ||
10 | import Test.Tasty | 10 | import Test.Tasty |
11 | import Test.Tasty.HUnit | 11 | import Test.Tasty.HUnit |
12 | 12 | ||
13 | import qualified Crypto.Macaroon.Tests | ||
14 | import qualified Crypto.Macaroon.Serializer.Base64.Tests | 13 | import qualified Crypto.Macaroon.Serializer.Base64.Tests |
14 | import qualified Crypto.Macaroon.Tests | ||
15 | 15 | ||
16 | tests :: TestTree | 16 | tests :: TestTree |
17 | tests = testGroup "Python HMAC Sanity check" [ checkKey | 17 | tests = testGroup "Python HMAC Sanity check" [ checkKey |
@@ -44,18 +44,18 @@ mac4 :: ByteString | |||
44 | mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256) | 44 | mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256) |
45 | 45 | ||
46 | 46 | ||
47 | checkKey = testCase "Truncated key" $ | 47 | checkKey = testCase "Truncated key" $ |
48 | key @?= "this is our super secret key; on" | 48 | key @?= "this is our super secret key; on" |
49 | 49 | ||
50 | checkMac1 = testCase "HMAC key" $ | 50 | checkMac1 = testCase "HMAC key" $ |
51 | "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1 | 51 | "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1 |
52 | 52 | ||
53 | checkMac2 = testCase "HMAC key account" $ | 53 | checkMac2 = testCase "HMAC key account" $ |
54 | "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2 | 54 | "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2 |
55 | 55 | ||
56 | checkMac3 = testCase "HMAC key account time" $ | 56 | checkMac3 = testCase "HMAC key account time" $ |
57 | "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3 | 57 | "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3 |
58 | 58 | ||
59 | checkMac4 = testCase "HMAC key account time email" $ | 59 | checkMac4 = testCase "HMAC key account time email" $ |
60 | "E42BBB02A9A5A303483CB6295C497AE51AD1D5CB10003CBE548D907E7E62F5E4" @=? hex mac4 | 60 | "E42BBB02A9A5A303483CB6295C497AE51AD1D5CB10003CBE548D907E7E62F5E4" @=? hex mac4 |
61 | 61 | ||
diff --git a/test/main.hs b/test/main.hs index 3edbe54..67ebcd5 100644 --- a/test/main.hs +++ b/test/main.hs | |||
@@ -1,12 +1,13 @@ | |||
1 | module Main where | 1 | module Main where |
2 | 2 | ||
3 | import Test.Tasty | 3 | import Test.Tasty |
4 | import Test.Tasty.HUnit | 4 | import Test.Tasty.HUnit |
5 | 5 | ||
6 | import qualified Sanity | ||
7 | import qualified Crypto.Macaroon.Tests | ||
8 | import qualified Crypto.Macaroon.Serializer.Base64.Tests | 6 | import qualified Crypto.Macaroon.Serializer.Base64.Tests |
7 | import qualified Crypto.Macaroon.Tests | ||
8 | import qualified Crypto.Macaroon.Verifier.Internal.Tests | ||
9 | import qualified Crypto.Macaroon.Verifier.Tests | 9 | import qualified Crypto.Macaroon.Verifier.Tests |
10 | import qualified Sanity | ||
10 | 11 | ||
11 | main = defaultMain tests | 12 | main = defaultMain tests |
12 | 13 | ||
@@ -15,5 +16,6 @@ tests = testGroup "Tests" [ Sanity.tests | |||
15 | , Crypto.Macaroon.Tests.tests | 16 | , Crypto.Macaroon.Tests.tests |
16 | , Crypto.Macaroon.Serializer.Base64.Tests.tests | 17 | , Crypto.Macaroon.Serializer.Base64.Tests.tests |
17 | , Crypto.Macaroon.Verifier.Tests.tests | 18 | , Crypto.Macaroon.Verifier.Tests.tests |
19 | , Crypto.Macaroon.Verifier.Internal.Tests.tests | ||
18 | ] | 20 | ] |
19 | 21 | ||