aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--test/Crypto/Macaroon/Verifier/Internal/Tests.hs60
-rw-r--r--test/Crypto/Macaroon/Verifier/Tests.hs44
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-}
12module Crypto.Macaroon.Verifier.Internal.Tests where 12module Crypto.Macaroon.Verifier.Internal.Tests where
13 13
14import Data.Bool
15import qualified Data.ByteString as BS
14import qualified Data.ByteString.Char8 as B8 16import qualified Data.ByteString.Char8 as B8
17import Data.Either
18import Data.Either.Validation
15import Data.List 19import Data.List
16import Test.Tasty 20import Test.Tasty
17-- import Test.Tasty.HUnit 21import Test.Tasty.HUnit
18import Data.Either
19import Test.Tasty.QuickCheck hiding (Failure, Success) 22import Test.Tasty.QuickCheck hiding (Failure, Success)
20 23
21import Crypto.Macaroon 24import Crypto.Macaroon
@@ -25,6 +28,59 @@ import Crypto.Macaroon.Instances
25 28
26tests :: TestTree 29tests :: TestTree
27tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs 30tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs
31 , firstParty
28 ] 32 ]
29 33
34{-
35 - Test fixtures
36 -}
37sec = B8.pack "this is our super secret key; only we should know it"
38
39m :: Macaroon
40m = create sec key loc
41 where
42 key = B8.pack "we used our sec key"
43 loc = B8.pack "http://mybank/"
44
45m2 :: Macaroon
46m2 = addFirstPartyCaveat "test = caveat" m
47
48vtest :: Caveat -> IO (Maybe (Either ValidationError ()))
49vtest 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
54m3 :: Macaroon
55m3 = addFirstPartyCaveat "value = 42" m2
56
57vval :: Caveat -> IO (Maybe (Either ValidationError ()))
58vval 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
30sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm) 67sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm)
68
69
70firstParty = 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
15import qualified Data.ByteString.Char8 as B8 15import qualified Data.ByteString.Char8 as B8
16import Data.Either
16import Data.List 17import Data.List
17import Test.Tasty 18import Test.Tasty
18-- import Test.Tasty.HUnit 19import Test.Tasty.HUnit
19import Data.Either 20import Test.Tasty.QuickCheck
20import Test.Tasty.QuickCheck hiding (Failure, Success)
21 21
22import Crypto.Macaroon 22import Crypto.Macaroon
23import Crypto.Macaroon.Verifier 23import 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{-
53firstParty = 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 -}