From a22bcdb648d1f540ae895cb246997dcdcce7b568 Mon Sep 17 00:00:00 2001
From: Julien Tanguy <julien.tanguy@jhome.fr>
Date: Wed, 15 Apr 2015 15:30:28 +0200
Subject: Add quickchecked serialization properties

---
 hmacaroons.cabal                                |  1 +
 test/Crypto/Macaroon/Instances.hs               | 54 +++++++++++++++++++++++++
 test/Crypto/Macaroon/Serializer/Base64/Tests.hs |  6 +++
 3 files changed, 61 insertions(+)
 create mode 100644 test/Crypto/Macaroon/Instances.hs

diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index 92d435d..2b23c89 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -64,4 +64,5 @@ test-suite test
                   hex >= 0.1,
                   tasty >= 0.10,
                   tasty-hunit >= 0.9,
+                  tasty-quickcheck >= 0.8,
                   hmacaroons
diff --git a/test/Crypto/Macaroon/Instances.hs b/test/Crypto/Macaroon/Instances.hs
new file mode 100644
index 0000000..5d4b062
--- /dev/null
+++ b/test/Crypto/Macaroon/Instances.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Copyright   : (c) 2015 Julien Tanguy
+License     : BSD3
+
+Maintainer  : julien.tanguy@jhome.fr
+
+
+This test suite is based on the pymacaroons test suite:
+<https://github.com/ecordell/pymacaroons>
+-}
+module Crypto.Macaroon.Instances where
+
+import Control.Monad
+import           Data.Byteable
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as B8
+import           Data.Hex
+import           Data.List
+import           Test.Tasty
+import           Test.Tasty.HUnit
+import           Test.Tasty.QuickCheck
+
+import           Crypto.Macaroon
+
+newtype Url = Url { unUrl :: BS.ByteString } deriving (Show)
+
+instance Arbitrary Url where
+    arbitrary = do
+        protocol <- elements ["http://"]
+        name <-  fmap (intercalate ".") <$> listOf1 . listOf1 $ elements ['a'..'z']
+        domain <- elements [".com",".net"]
+        return . Url . B8.pack $ (protocol ++ name ++ domain)
+
+newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show)
+
+instance Arbitrary Secret where
+    arbitrary = Secret . B8.pack <$> scale (*3) arbitrary
+
+newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show)
+
+instance Arbitrary Identifier where
+    arbitrary = Identifier . B8.pack <$>(scale (*3) . listOf1 . elements $ ['a'..'z'])
+
+data SimpleMac = SimpleMac { secret :: BS.ByteString, macaroon :: Macaroon } deriving Show
+
+instance Arbitrary SimpleMac where
+    arbitrary = do
+        secret <- unSecret <$> arbitrary
+        location <- unUrl <$> arbitrary
+        ident <- unIdent <$> arbitrary
+        return $ SimpleMac secret (create secret ident location)
+
+
diff --git a/test/Crypto/Macaroon/Serializer/Base64/Tests.hs b/test/Crypto/Macaroon/Serializer/Base64/Tests.hs
index 9c49e96..fe5352e 100644
--- a/test/Crypto/Macaroon/Serializer/Base64/Tests.hs
+++ b/test/Crypto/Macaroon/Serializer/Base64/Tests.hs
@@ -15,17 +15,23 @@ module Crypto.Macaroon.Serializer.Base64.Tests where
 import qualified Data.ByteString.Char8 as B8
 import Test.Tasty
 import Test.Tasty.HUnit
+import           Test.Tasty.QuickCheck
 
 import           Crypto.Macaroon
 import           Crypto.Macaroon.Serializer.Base64
 
+import Crypto.Macaroon.Instances
+
 tests :: TestTree
 tests = testGroup "Crypto.Macaroon.Serializer.Base64" [ basic
+                                                      , basicQC
                                                       , minted
                                                       , minted2
                                                       -- , minted3
                                                       ]
 
+basicQC = testProperty "Reversibility" $
+    forAll (macaroon <$> arbitrary) (\m -> deserialize (serialize m) == Right m)
 
 m :: Macaroon
 m = create secret key loc
-- 
cgit v1.2.3