macaroon-shop (empty) → 0.1.0.0
raw patch · 10 files changed
+820/−0 lines, 10 filesdep +basedep +bytesdep +bytestringsetup-changed
Dependencies added: base, bytes, bytestring, cereal, containers, cryptonite, hedgehog, memory, saltine, transformers
Files
- CHANGELOG.md +5/−0
- Setup.hs +2/−0
- macaroon-shop.cabal +59/−0
- src/Authorize/Macaroon.hs +123/−0
- src/Authorize/Macaroon/Crypto.hs +86/−0
- src/Authorize/Macaroon/Serialize.hs +76/−0
- src/Authorize/Macaroon/Types.hs +139/−0
- src/Authorize/Macaroon/Verify.hs +114/−0
- test/Authorize/Macaroon/Gen.hs +74/−0
- test/Main.hs +142/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for macaroon-shop++## 0.1.0.0 -- 2020-03-07++First release
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ macaroon-shop.cabal view
@@ -0,0 +1,59 @@+cabal-version: 2.4+name: macaroon-shop+version: 0.1.0.0+synopsis: A toolkit for working with macaroons+license: ISC+author: Ian Shipman+maintainer: ics@gambolingpangolin.com+homepage: https://github.com/GambolingPangolin/macaroon-shop+extra-source-files: CHANGELOG.md+++common core+ default-language: Haskell2010++ ghc-options:+ -Wall++ build-depends:+ base ^>=4.12.0.0+ , bytestring ^>=0.10+ , bytes ^>=0.17+ , cereal ^>=0.5+ , containers ^>=0.6+ , cryptonite ^>=0.26+ , memory >=0.14+ , saltine ^>=0.1+ , transformers ^>=0.5++ other-modules:+ Authorize.Macaroon.Crypto+ Authorize.Macaroon.Serialize+ Authorize.Macaroon.Types+ Authorize.Macaroon.Verify++library+ import: core+ default-language: Haskell2010+ hs-source-dirs: src/+ exposed-modules:+ Authorize.Macaroon++test-suite macaroon-shop-tests+ import: core+ type: exitcode-stdio-1.0+ main-is: Main.hs++ hs-source-dirs:+ src/+ test/++ ghc-options:+ -threaded -O2++ other-modules:+ Authorize.Macaroon+ Authorize.Macaroon.Gen++ build-depends:+ hedgehog ^>=1.0
+ src/Authorize/Macaroon.hs view
@@ -0,0 +1,123 @@+-- |+-- Module: Authorize.Macaroon+-- License: ISC+-- Maintainer: ics@gambolingpangolin.com+-- Stability: experimental+--+-- This module contains an implementation of macaroons as described in+-- <http://theory.stanford.edu/~ataly/Papers/macaroons.pdf>. The+-- serialization, cryptography, and validation semantics are compatible with+-- go-macaroons <https://github.com/go-macaroon/macaroon>.+module Authorize.Macaroon+ (+ -- * Types++ MacaroonId (..)+ , Macaroon+ , SealedMacaroon (..)++ , Key (..)+ , Location++ -- * Core interface++ , createMacaroon+ , addFirstPartyCaveat+ , addThirdPartyCaveat+ , extractThirdPartyCaveats+ , sealMacaroon++ , createDischargeMacaroon++ , verify+ , VerificationFailure (..)+ ) where++import Data.ByteString (ByteString)+import Data.List (foldl')+import Data.Maybe (isJust)++import Authorize.Macaroon.Crypto+import Authorize.Macaroon.Types+import Authorize.Macaroon.Verify+++-- | Mint a macaroon+createMacaroon+ :: Key+ -- ^ signing key+ -> MacaroonId+ -- ^ identifier for this macaroon+ -> Location+ -- ^ location hint+ -> [ByteString]+ -- ^ first party caveats to include+ -> Macaroon+createMacaroon k mid loc = foldl' addFirstPartyCaveat m0+ where+ m0 = Macaroon loc mid [] $ createSignature (deriveKey k) mid+++-- | A first party caveat corresponds to a proposition that might or might not+-- hold in the validation context of the macaroon.+addFirstPartyCaveat :: Macaroon -> ByteString -> Macaroon+addFirstPartyCaveat m = addCaveat m . Caveat mempty Nothing+++-- | A third party caveat links the macaroon to an additional key, and must be+-- discharged by a supplementary macaroon in order to validate.+addThirdPartyCaveat+ :: Macaroon+ -> Key+ -- ^ third party key+ -> Location+ -> ByteString+ -> IO Macaroon+addThirdPartyCaveat m ck loc c+ = addC <$> encryptKey (macaroonSignature m) (deriveKey ck)+ where+ addC k = addCaveat m $ Caveat loc (Just k) c+++addCaveat :: Macaroon -> Caveat -> Macaroon+addCaveat m c@Caveat{ caveatKeyId = k, caveatContent = cc }+ = m { caveats = caveats m <> [c]+ , macaroonSignature = updateSignature (macaroonSignature m) k cc+ }+++-- | Get the third party caveats encoded in the macaroon+extractThirdPartyCaveats :: Macaroon -> [ByteString]+extractThirdPartyCaveats = fmap caveatContent . filter isThirdParty . caveats+++isThirdParty :: Caveat -> Bool+isThirdParty = isJust . caveatKeyId+++-- | Mint a macaroon discharging a third party caveat+createDischargeMacaroon+ :: Key+ -- ^ discharge key+ -> Location+ -- ^ location hint+ -> ByteString+ -- ^ caveat to discharge+ -> [ByteString]+ -- ^ additional first party caveats to include+ -> Macaroon+createDischargeMacaroon k l c = createMacaroon k (MacaroonId c) l+++-- | In order to secure discharge macaroons, they must be bound to the root macaroon before transmission.+sealMacaroon+ :: Macaroon+ -- ^ root macaroon+ -> [Macaroon]+ -- ^ discharge macaroons+ -> SealedMacaroon+sealMacaroon m@Macaroon{ macaroonSignature = s } ms+ = SealedMacaroon m $ bindMacaroon <$> ms+ where+ bindMacaroon m'@Macaroon{ macaroonSignature = s' }+ = m' { macaroonSignature = bindForRequest s s' }
+ src/Authorize/Macaroon/Crypto.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}++module Authorize.Macaroon.Crypto+ ( createSignature+ , updateSignature+ , encryptKey+ , decryptKey+ , bindForRequest+ , deriveKey+ ) where++import Crypto.Hash (SHA256)+import Crypto.MAC.HMAC (HMAC, hmac)+import qualified Crypto.Saltine.Class as Nacl+import Crypto.Saltine.Core.SecretBox (newNonce, secretbox,+ secretboxOpen)+import qualified Crypto.Saltine.Internal.ByteSizes as Sizes+import Data.ByteArray (ByteArray, ByteArrayAccess,+ convert)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS++import Authorize.Macaroon.Types (Key (..), KeyId (..),+ MacaroonId (..),+ Signature (..))+++createSignature :: Key -> MacaroonId -> Signature+createSignature k m = Signature $ keyedHash k m+++updateSignature :: Signature -> Maybe KeyId -> ByteString -> Signature+updateSignature s kid c = Signature $ maybe (keyedHash s) (keyedPairHash s) kid c+++encryptKey :: Signature -> Key -> IO KeyId+encryptKey (Signature s) (Key k) = do+ n <- newNonce+ key <- maybe err return $ Nacl.decode s+ return . KeyId $ Nacl.encode n <> secretbox key n (convert k)+ where+ err = error "Unable to decode key"+++decryptKey :: Signature -> KeyId -> Maybe Key+decryptKey (Signature s) (KeyId kid) = do+ n <- Nacl.decode nonceBytes+ key <- Nacl.decode s+ Key . convert <$> secretboxOpen key n ct+ where+ (nonceBytes, ct) = BS.splitAt Sizes.secretBoxNonce kid+++bindForRequest :: Signature -> Signature -> Signature+bindForRequest = keyedPairHash zeroKey+ where+ zeroKey = BS.replicate 32 0x0+++hmac256 :: (ByteArrayAccess k, ByteArrayAccess x) => k -> x -> HMAC SHA256+hmac256 = hmac+++deriveKey :: Key -> Key+deriveKey (Key k) = Key . convert $ hmac256 tag k+ where+ tag :: ByteString+ tag = "macaroons-key-generator"+++keyedHash+ :: (ByteArrayAccess k, ByteArrayAccess b, ByteArray c)+ => k -> b -> c+keyedHash k = convert . hmac256 k+++keyedPairHash+ :: ( ByteArrayAccess k+ , ByteArrayAccess b+ , ByteArrayAccess c+ , ByteArray d+ , Monoid d+ )+ => k -> b -> c -> d+keyedPairHash k x y+ = keyedHash k (keyedHash k x <> keyedHash k y :: ByteString)
+ src/Authorize/Macaroon/Serialize.hs view
@@ -0,0 +1,76 @@+module Authorize.Macaroon.Serialize+ ( fieldEOS+ , fieldLocation+ , fieldIdentifier+ , fieldVerificationId+ , fieldSignature++ , putField+ , getField+ , getOptionalField+ , getEOS+ , atEOS+ ) where++import qualified Data.Bytes.Serial as By+import Data.Bytes.VarInt (VarInt (..))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Serialize (Get, Put, Serialize (..))+import qualified Data.Serialize as S+import Data.Word (Word8)+++fieldEOS :: Word8+fieldEOS = 0+++fieldLocation :: Word8+fieldLocation = 1+++fieldIdentifier :: Word8+fieldIdentifier = 2+++fieldVerificationId :: Word8+fieldVerificationId = 4+++fieldSignature :: Word8+fieldSignature = 6+++putField :: Word8 -> ByteString -> Put+putField fieldId dat+ = put fieldId >> By.serialize (VarInt $ BS.length dat) >> S.putByteString dat+++getOptionalField :: Word8 -> Get (Maybe ByteString)+getOptionalField f = do+ n <- S.lookAhead S.getWord8+ if n == f+ then S.getWord8 >> Just <$> getFieldData+ else return Nothing+++getField :: Word8 -> Get ByteString+getField f = do+ n <- S.getWord8+ if n == f then getFieldData else fail $ "Expecting field " <> show f <> " but got " <> show n+++getFieldData :: Get ByteString+getFieldData = do+ VarInt n <- By.deserialize+ S.getBytes n+++getEOS :: Get ()+getEOS = do+ f <- S.getWord8+ if f == fieldEOS then return () else fail "Expecting EOS"+++atEOS :: Get Bool+atEOS = (== fieldEOS) <$> S.lookAhead S.getWord8
+ src/Authorize/Macaroon/Types.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++module Authorize.Macaroon.Types+ ( MacaroonId (..)+ , Macaroon (..)+ , Caveat (..)++ , SealedMacaroon (..)++ , Key (..)+ , KeyId (..)+ , Signature (..)+ , Location+ ) where++import Control.Monad (unless)+import Data.ByteArray (ByteArray, ByteArrayAccess,+ ScrubbedBytes)+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Maybe (fromMaybe)+import Data.Serialize (Serialize (..))+import qualified Data.Serialize as S++import Authorize.Macaroon.Serialize+++type Location = ByteString+++newtype MacaroonId = MacaroonId { unMacaroonId :: ByteString }+ deriving (Eq, Ord, Show, ByteArrayAccess, Serialize)+++newtype Key = Key { unKey :: ScrubbedBytes } deriving (Eq, Ord, Show, ByteArrayAccess)+++newtype KeyId = KeyId { unKeyId :: ByteString } deriving (Eq, Ord, Show, ByteArrayAccess)+++newtype Signature = Signature { unSignature :: ByteString }+ deriving ( Eq+ , Ord+ , Semigroup+ , Monoid+ , ByteArray+ , ByteArrayAccess+ , Serialize+ , Show+ )+++data Macaroon = Macaroon+ { locationHint :: Location+ , identifier :: MacaroonId+ , caveats :: [Caveat]+ , macaroonSignature :: Signature+ } deriving (Eq, Show)+++instance Serialize Macaroon where+ put (Macaroon loc i cs sig) = do+ S.putWord8 2 -- version byte++ unless (BS.null loc) $ putField fieldLocation loc+ putField fieldIdentifier $ unMacaroonId i+ put fieldEOS++ mapM_ put cs+ put fieldEOS++ putField fieldSignature $ unSignature sig++ get = do+ getVersion++ mloc <- getOptionalField fieldLocation+ mid <- MacaroonId <$> getField fieldIdentifier+ getEOS++ cs <- getCaveats+ getEOS++ sig <- Signature <$> getField fieldSignature+ return $ Macaroon (fromMaybe mempty mloc) mid cs sig++ where+ getVersion = do+ v <- S.getWord8+ if v == 2 then return () else fail "Unsupported macaroon version"++ getCaveats = do+ eos <- atEOS+ if eos then return [] else (:) <$> get <*> getCaveats+++data Caveat = Caveat+ { caveatLocationHint :: Location+ -- ^ Note: The location hint is not authenticated+ , caveatKeyId :: Maybe KeyId+ -- ^ First party caveats do not require a key ident+ , caveatContent :: ByteString+ -- ^ content semantics are determined in the application layer+ } deriving (Eq, Show)+++instance Serialize Caveat where+ put (Caveat loc mk c) = do+ unless (BS.null loc) $ putField fieldLocation loc+ putField fieldIdentifier c+ mapM_ (putField fieldVerificationId . unKeyId) mk+ put fieldEOS++ get = makeCaveat+ <$> getOptionalField fieldLocation+ <*> getField fieldIdentifier+ <*> getOptionalField fieldVerificationId+ <* getEOS+ where+ makeCaveat mloc c mkeyid = Caveat (fromMaybe mempty mloc) (KeyId <$> mkeyid) c+++-- | Couple a macaroon with its discharges. Application developers should+-- only produce these values either by invoking @prepareForRequest@ or by+-- deserializing a client token.+data SealedMacaroon = SealedMacaroon+ { rootMacaroon :: Macaroon+ , dischargeMacaroons :: [Macaroon]+ } deriving (Eq, Show)+++instance Serialize SealedMacaroon where+ put (SealedMacaroon r ds) = put r >> mapM_ put ds+ get = SealedMacaroon <$> get <*> getMacaroons+ where+ getMacaroons = do+ n <- S.remaining+ if n > 0 then (:) <$> get <*> getMacaroons else return []
+ src/Authorize/Macaroon/Verify.hs view
@@ -0,0 +1,114 @@+module Authorize.Macaroon.Verify+ ( VerificationFailure (..)+ , verify+ , recalcSignature+ ) where++import Control.Arrow ((&&&))+import Control.Monad (foldM, unless)+import Data.ByteArray (constEq)+import Data.ByteString (ByteString)+import Data.Foldable (foldl')+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.Set (Set)+import qualified Data.Set as Set++import Authorize.Macaroon.Crypto+import Authorize.Macaroon.Types+++data VerificationFailure+ = InvalidSignature MacaroonId+ | InvalidBinding MacaroonId+ | MissingDischargeMacaroon MacaroonId+ | ExcessDischarges [Macaroon]+ | ThirdPartyKeyError MacaroonId+ deriving (Eq, Show)+++type Discharges = Map MacaroonId Macaroon+++-- | Macaroon verification succeeds by producing a set of first party caveats+-- requiring further validation.+verify+ :: Key+ -- ^ root key+ -> SealedMacaroon+ -> Either VerificationFailure (Set ByteString)+verify rootKey (SealedMacaroon m ms) = do+ (cs, ds') <- verify' (deriveKey rootKey) m ds+ unless (Map.null ds') $ Left (ExcessDischarges $ Map.elems ds')+ return cs++ where+ ds = Map.fromList $ (identifier &&& id) <$> ms+++verify'+ :: Key+ -> Macaroon+ -> Discharges+ -> Either VerificationFailure (Set ByteString, Discharges)+verify' k m ds = checkSig =<< foldM step (sig0, mempty, ds) (caveats m)+ where+ step (sig, cs, ds') (Caveat _ mk c)+ = updateSig mk c sig <$> maybe firstP (verThirdP sig) mk c cs ds'++ firstP c cs ds' = return (Set.singleton c <> cs, ds')+ verThirdP = verifyThirdParty (macaroonSignature m)++ sig0 = createSignature k (identifier m)+ updateSig mk c sig (x, y) = (updateSignature sig mk c, x, y)++ checkSig (sig, cs', ds')+ = (cs', ds') <$ unless (sig `constEq` macaroonSignature m)+ (Left . InvalidSignature $ identifier m)+++verifyThirdParty+ :: Signature+ -- ^ root signature+ -> Signature+ -- ^ running signature+ -> KeyId+ -> ByteString+ -> Set ByteString+ -> Discharges+ -> Either VerificationFailure (Set ByteString, Discharges)+verifyThirdParty rootSig runningSig k c acc ds = do+ (m, ds') <- getDischarge (MacaroonId c) ds+ k' <- getKey (identifier m) runningSig k++ let unboundSig = recalcSignature k' (identifier m) (caveats m)+ dischargeSig = macaroonSignature m+ unboundDischarge = m {macaroonSignature = unboundSig}++ unless (bindForRequest rootSig unboundSig == dischargeSig)+ $ Left (InvalidBinding $ identifier m)++ (acc', ds'') <- verify' k' unboundDischarge ds'+ return (acc' <> acc, ds'')+++getDischarge+ :: MacaroonId+ -> Discharges+ -> Either VerificationFailure (Macaroon, Discharges)+getDischarge mid ds = maybe noDischarge someDischarge $ Map.lookup mid ds+ where+ someDischarge m = return (m, Map.delete mid ds)+ noDischarge = Left $ MissingDischargeMacaroon mid+++getKey :: MacaroonId -> Signature -> KeyId -> Either VerificationFailure Key+getKey mid sig = maybe noKey return . decryptKey sig+ where+ noKey = Left $ ThirdPartyKeyError mid+++recalcSignature :: Key -> MacaroonId -> [Caveat] -> Signature+recalcSignature k i = foldl' step (createSignature k i)+ where+ step sig (Caveat _ mk c) = updateSignature sig mk c
+ test/Authorize/Macaroon/Gen.hs view
@@ -0,0 +1,74 @@+module Authorize.Macaroon.Gen+ ( sealedMacaroon+ , macaroon+ , location+ , caveat+ , content+ , key+ , signature+ , validMacaroon+ ) where++import Data.ByteArray (convert)+import Data.ByteString (ByteString)+import Data.Set (Set)+import qualified Data.Set as Set+import Hedgehog (Gen)+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range++import Authorize.Macaroon+import Authorize.Macaroon.Types (Caveat (..), KeyId (..),+ Macaroon (..), Signature (..))+++sealedMacaroon :: Gen SealedMacaroon+sealedMacaroon = SealedMacaroon <$> macaroon <*> macaroons+ where+ macaroons = Gen.list (Range.constant 0 100) macaroon+++macaroon :: Gen Macaroon+macaroon = Macaroon <$> location <*> genIdentifier <*> genCaveats <*> signature+ where+ genCaveats = Gen.list (Range.constant 0 100) caveat+++caveat :: Gen Caveat+caveat = Caveat <$> location <*> gKeyId <*> content+ where+ gKeyId = Gen.choice [pure Nothing, Just <$> keyId]+++content :: Gen ByteString+content = Gen.bytes $ Range.constant 1 128+++keyId :: Gen KeyId+keyId = KeyId <$> Gen.bytes (Range.singleton 32)+++location :: Gen Location+location = Gen.bytes $ Range.constant 0 64+++genIdentifier :: Gen MacaroonId+genIdentifier = MacaroonId <$> Gen.bytes (Range.constant 1 256)+++signature :: Gen Signature+signature = Signature <$> Gen.bytes (Range.singleton 32)+++validMacaroon :: Gen (Key, Macaroon, Set ByteString)+validMacaroon = do+ k <- key+ i <- genIdentifier+ cs <- Gen.list (Range.constant 1 10) content+ loc <- location+ let m = createMacaroon k i loc cs+ return (k, m, Set.fromList cs)+++key :: Gen Key+key = Key . convert <$> Gen.bytes (Range.singleton 32)
+ test/Main.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module Main where++import Control.Monad (foldM)+import Control.Monad.IO.Class (liftIO)+import Data.Serialize (Serialize)+import qualified Data.Serialize as S+import qualified Data.Set as Set+import Hedgehog (Gen, Group (..), Property,+ PropertyT, TestLimit, assert,+ checkParallel, diff, forAll,+ property, withTests, (===))+import Hedgehog.Main (defaultMain)+import qualified Hedgehog.Range as Range++import Authorize.Macaroon (Macaroon, SealedMacaroon (..),+ VerificationFailure (..),+ addThirdPartyCaveat,+ createDischargeMacaroon,+ sealMacaroon, verify)+import Authorize.Macaroon.Crypto (decryptKey, encryptKey)+import qualified Authorize.Macaroon.Gen as G+import qualified Hedgehog.Gen as Gen+++main :: IO ()+main = defaultMain [ checkParallel testSerialization+ , checkParallel testCrypto+ , checkParallel testVerification+ ]+++testSerialization :: Group+testSerialization = Group "Serialization"+ [ ("Caveat" , testCaveatSerialization)+ , ("Macaroon" , testMacaroonSerialization)+ , ("SealedMacaroon" , testSealedMacaroonSerialization)+ ]+++testCaveatSerialization :: Property+testCaveatSerialization = roundTripProperty 1000 G.caveat+++testMacaroonSerialization :: Property+testMacaroonSerialization = roundTripProperty 500 G.macaroon+++testSealedMacaroonSerialization :: Property+testSealedMacaroonSerialization = roundTripProperty 20 G.sealedMacaroon+++roundTripProperty :: (Eq a, Show a, Serialize a) => TestLimit -> Gen a -> Property+roundTripProperty n g = withTests n . property $ do+ x <- forAll g+ diff (roundTrip x) (==) (Right x)+++roundTrip :: Serialize a => a -> Either String a+roundTrip = S.decode . S.encode+++testCrypto :: Group+testCrypto = Group "Cryptography"+ [ ("Key encryption", testKeyEncryption) ]+++testKeyEncryption :: Property+testKeyEncryption = withTests 10 . property $ do+ x <- forAll G.key+ s <- forAll G.signature+ ct <- liftIO $ encryptKey s x+ decryptKey s ct === Just x+++testVerification :: Group+testVerification = Group "Verification"+ [ ("Passes (simple)" , testPasses)+ , ("Passes (complex)" , testComplexPasses)+ , ("Fails (missing discharge)" , testMissingDischarge)+ , ("Fails (invalid key)" , testInvalidKey)+ , ("Fails (invalid binding)" , testInvalidBinding)+ ]+++testPasses :: Property+testPasses = withTests 100 . property $ do+ (k, m, cs) <- forAll G.validMacaroon+ verify k (SealedMacaroon m []) === Right cs+++testComplexPasses :: Property+testComplexPasses = withTests 100 . property $ do+ (k, m, cs) <- forAll G.validMacaroon+ sm <- uncurry sealMacaroon <$> addThirdPartyCaveats m+ verify k sm === Right cs+++addThirdPartyCaveats :: Macaroon -> PropertyT IO (Macaroon, [Macaroon])+addThirdPartyCaveats m0+ = forAll genThirdPartyCaveats >>= foldM step (m0, [])+ where+ genThirdPartyCaveats+ = Gen.set (Range.constant 1 10) G.content >>= traverse inflateTPData . Set.toList+ inflateTPData c = (, , c) <$> G.key <*> G.location++ step (m, ds) (ck, l, c) = do+ m' <- liftIO $ addThirdPartyCaveat m ck l c+ let d = createDischargeMacaroon ck l c []+ return (m', ds <> [d])+++testMissingDischarge :: Property+testMissingDischarge = withTests 100 . property $ do+ (k, m, _) <- forAll G.validMacaroon+ (m', _) <- addThirdPartyCaveats m+ assert . isMissingDischarge $ verify k (SealedMacaroon m' [])+ where+ isMissingDischarge (Left (MissingDischargeMacaroon _)) = True+ isMissingDischarge _ = False+++testInvalidKey :: Property+testInvalidKey = withTests 100 . property $ do+ k <- forAll G.key+ (_, m, _) <- forAll G.validMacaroon+ assert . isInvalidSignature $ verify k (SealedMacaroon m [])+ where+ isInvalidSignature (Left (InvalidSignature _)) = True+ isInvalidSignature _ = False+++testInvalidBinding :: Property+testInvalidBinding = withTests 100 . property $ do+ (k, m, _) <- forAll G.validMacaroon+ sm <- uncurry SealedMacaroon <$> addThirdPartyCaveats m+ assert . isInvalidBinding $ verify k sm+ where+ isInvalidBinding (Left (InvalidBinding _)) = True+ isInvalidBinding _ = False