diff options
Diffstat (limited to 'test/Crypto/Macaroon/Verifier')
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Internal/Tests.hs | 60 | ||||
-rw-r--r-- | test/Crypto/Macaroon/Verifier/Tests.hs | 44 |
2 files changed, 62 insertions, 42 deletions
diff --git a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs index cd75118..826b631 100644 --- a/test/Crypto/Macaroon/Verifier/Internal/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Internal/Tests.hs | |||
@@ -11,11 +11,14 @@ This test suite is based on the pymacaroons test suite: | |||
11 | -} | 11 | -} |
12 | module Crypto.Macaroon.Verifier.Internal.Tests where | 12 | module Crypto.Macaroon.Verifier.Internal.Tests where |
13 | 13 | ||
14 | import Data.Bool | ||
15 | import qualified Data.ByteString as BS | ||
14 | import qualified Data.ByteString.Char8 as B8 | 16 | import qualified Data.ByteString.Char8 as B8 |
17 | import Data.Either | ||
18 | import Data.Either.Validation | ||
15 | import Data.List | 19 | import Data.List |
16 | import Test.Tasty | 20 | import Test.Tasty |
17 | -- import Test.Tasty.HUnit | 21 | import Test.Tasty.HUnit |
18 | import Data.Either | ||
19 | import Test.Tasty.QuickCheck hiding (Failure, Success) | 22 | import Test.Tasty.QuickCheck hiding (Failure, Success) |
20 | 23 | ||
21 | import Crypto.Macaroon | 24 | import Crypto.Macaroon |
@@ -25,6 +28,59 @@ import Crypto.Macaroon.Instances | |||
25 | 28 | ||
26 | tests :: TestTree | 29 | tests :: TestTree |
27 | tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs | 30 | tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs |
31 | , firstParty | ||
28 | ] | 32 | ] |
29 | 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 | |||
30 | sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm) | 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 b6220eb..d69ad8d 100644 --- a/test/Crypto/Macaroon/Verifier/Tests.hs +++ b/test/Crypto/Macaroon/Verifier/Tests.hs | |||
@@ -13,11 +13,11 @@ module Crypto.Macaroon.Verifier.Tests where | |||
13 | 13 | ||
14 | 14 | ||
15 | import qualified Data.ByteString.Char8 as B8 | 15 | import qualified Data.ByteString.Char8 as B8 |
16 | import Data.Either | ||
16 | import Data.List | 17 | import Data.List |
17 | import Test.Tasty | 18 | import Test.Tasty |
18 | -- import Test.Tasty.HUnit | 19 | import Test.Tasty.HUnit |
19 | import Data.Either | 20 | import Test.Tasty.QuickCheck |
20 | import Test.Tasty.QuickCheck hiding (Failure, Success) | ||
21 | 21 | ||
22 | import Crypto.Macaroon | 22 | import Crypto.Macaroon |
23 | import Crypto.Macaroon.Verifier | 23 | import Crypto.Macaroon.Verifier |
@@ -48,40 +48,4 @@ m3 = addFirstPartyCaveat "value = 42" m2 | |||
48 | - Tests | 48 | - Tests |
49 | -} | 49 | -} |
50 | 50 | ||
51 | -- TODO: Re-do tests | 51 | -- TODO |
52 | {- | ||
53 | firstParty = testGroup "First party caveats" [ | ||
54 | testGroup "Pure verifiers" [ | ||
55 | testProperty "Zero caveat" $ | ||
56 | forAll (sublistOf allvs) (\vs -> Right m == verifyCavs vs m) | ||
57 | , testProperty "One caveat" $ | ||
58 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
59 | Right m2 == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | ||
60 | , True === isLeft( verifyCavs vs m2) | ||
61 | ]) | ||
62 | , testProperty "Two Exact" $ | ||
63 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
64 | Right m3 == verifyCavs vs m3 .&&. | ||
65 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | ||
66 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | ||
67 | , True === isLeft (verifyCavs vs m3) | ||
68 | ]) | ||
69 | ] | ||
70 | , testGroup "Pure verifiers with sig" [ | ||
71 | testProperty "Zero caveat" $ | ||
72 | forAll (sublistOf allvs) (\vs -> Right m == verifyMacaroon sec vs m) | ||
73 | , testProperty "One caveat" $ | ||
74 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
75 | Right m2 == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) | ||
76 | , True === isLeft (verifyMacaroon sec vs m2) | ||
77 | ]) | ||
78 | , testProperty "Two Exact" $ | ||
79 | forAll (sublistOf allvs) (\vs -> disjoin [ | ||
80 | Right m3 == verifyMacaroon sec vs m3 .&&. | ||
81 | any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. | ||
82 | any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) | ||
83 | , True === isLeft (verifyMacaroon sec vs m3) | ||
84 | ]) | ||
85 | ] | ||
86 | ] | ||
87 | -} | ||