From: Julien Tanguy Date: Mon, 17 Aug 2015 17:40:19 +0000 (+0200) Subject: Merge branch 'verification' X-Git-Url: https://git.immae.eu/?a=commitdiff_plain;h=cfeb65a103cb58048328b2ca3ce74351017f70d1;hp=a1b6481db1e02013f668851096b084ff6088f682;p=github%2Ffretlink%2Fhmacaroons.git Merge branch 'verification' --- diff --git a/.travis.yml b/.travis.yml index 618741d..f0ecd95 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,45 +1,80 @@ -# See also https://github.com/hvr/multi-ghc-travis for more information +# This file has been generated -- see https://github.com/hvr/multi-ghc-travis language: c - sudo: false -# The following lines enable several GHC versions and/or HP versions -# to be tested; often it's enough to test only against the last -# release of a major GHC version. Setting HPVER implictly sets -# GHCVER. Omit lines with versions you don't need/want testing for. +cache: + directories: + - $HOME/.cabsnap + - $HOME/.cabal/packages + +before_cache: + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log + - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar + matrix: - include: - - env: CABALVER=1.18 GHCVER=7.8.4 CTOPTS="" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.1 CTOPTS="--show-details=streaming" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1],sources: [hvr-ghc]}} - - env: CABALVER=head GHCVER=head CTOPTS="--show-details=streaming" - addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} + include: + - env: CABALVER=1.18 GHCVER=7.8.4 + compiler: ": #GHC 7.8.4" + addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}} + - env: CABALVER=1.22 GHCVER=7.10.1 + compiler: ": #GHC 7.10.1" + addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.1], sources: [hvr-ghc]}} - allow_failures: - - env: CABALVER=head GHCVER=head before_install: - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH + - unset CC + - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH install: - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - travis_retry cabal update - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config # The container environment reports 16 cores - - cabal install --only-dependencies --enable-tests --enable-benchmarks + - cabal --version + - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" + - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; + then + zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > + $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; + fi + - travis_retry cabal update -v + - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config + - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt + - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt -script: - - cabal configure --enable-tests --enable-benchmarks -v2 - - cabal build - - - cabal test $CTOPTS +# check whether current requested install-plan matches cached package-db snapshot + - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; + then + echo "cabal build-cache HIT"; + rm -rfv .ghc; + cp -a $HOME/.cabsnap/ghc $HOME/.ghc; + cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; + else + echo "cabal build-cache MISS"; + rm -rf $HOME/.cabsnap; + mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; + cabal install --only-dependencies --enable-tests --enable-benchmarks; + fi - - cabal check +# snapshot package-db on cache miss + - if [ ! -d $HOME/.cabsnap ]; + then + echo "snapshotting package-db to build-cache"; + mkdir $HOME/.cabsnap; + cp -a $HOME/.ghc $HOME/.cabsnap/ghc; + cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; + fi - - cabal sdist +# Here starts the actual work to be performed for the package under test; +# any command which exits with a non-zero exit code causes the build to fail. +script: + - if [ -f configure.ac ]; then autoreconf -i; fi + - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging + - cabal build # this builds all libraries and executables (including tests/benchmarks) + - cabal test + - cabal check + - cabal sdist # tests that a source-distribution can be generated - - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && - (cd dist && cabal install --force-reinstalls "$SRC_TGZ") +# Check that the resulting source distribution can be built & installed. +# If there are no other `.tar.gz` files in `dist`, this can be even simpler: +# `cabal install --force-reinstalls dist/*-*.tar.gz` + - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && + (cd dist && cabal install --force-reinstalls "$SRC_TGZ") # EOF diff --git a/default.nix b/default.nix index d968974..a392583 100644 --- a/default.nix +++ b/default.nix @@ -1,18 +1,19 @@ { mkDerivation, attoparsec, base, base64-bytestring, byteable -, bytestring, cereal, cryptohash, deepseq, hex, QuickCheck, stdenv -, tasty, tasty-hunit, tasty-quickcheck +, bytestring, cereal, cryptohash, deepseq, either, hex, QuickCheck +, stdenv, tasty, tasty-hunit, tasty-quickcheck, transformers }: mkDerivation { pname = "hmacaroons"; - version = "0.1.0.0"; + version = "0.4.0.0"; src = ./.; buildDepends = [ attoparsec base base64-bytestring byteable bytestring cereal - cryptohash deepseq hex + cryptohash deepseq either hex transformers ]; testDepends = [ attoparsec base base64-bytestring byteable bytestring cereal - cryptohash hex QuickCheck tasty tasty-hunit tasty-quickcheck + cryptohash deepseq either hex QuickCheck tasty tasty-hunit + tasty-quickcheck transformers ]; homepage = "https://github.com/jtanguy/hmacaroons"; description = "Haskell implementation of macaroons"; diff --git a/hmacaroons.cabal b/hmacaroons.cabal index b70a984..8c6f410 100644 --- a/hmacaroons.cabal +++ b/hmacaroons.cabal @@ -1,17 +1,14 @@ name: hmacaroons -version: 0.1.0.0 +version: 0.4.0.0 synopsis: Haskell implementation of macaroons description: - = Macaroons: Pure haskell implementation of macaroons - #macaroons-pure-haskell-implementation-of-macaroons# - . - Macaroons is a pure haskell implementation of macaroons. It aims to + Hmacaroons is a pure haskell implementation of macaroons. It aims to provide compatibility at a serialized level with the and the . __WARNING: This library has not been audited by security experts.__ - __There is no error handling at the moment, everyhting is silently accepted__ + __There is no error handling at the moment, everything is silently accepted__ . It is developed in the purpose of exploration purposes, and would need much more attention if it were to be used in production. @@ -46,6 +43,7 @@ extra-source-files: README.md CONTRIBUTING.md CHANGELOG.md cabal-version: >=1.10 +tested-with: GHC==7.8.4, GHC==7.10.1 source-repository head type: git @@ -54,18 +52,21 @@ source-repository head library exposed-modules: Crypto.Macaroon - Crypto.Macaroon.Binder + -- Crypto.Macaroon.Binder Crypto.Macaroon.Serializer.Base64 Crypto.Macaroon.Verifier other-modules: Crypto.Macaroon.Internal + Crypto.Macaroon.Verifier.Internal build-depends: base >=4 && < 5, attoparsec >=0.12, + transformers >= 0.3, bytestring >=0.10, base64-bytestring >= 1.0, byteable >= 0.1 && <0.2, cereal >= 0.4, cryptohash >=0.11 && <0.12, either >=4.4, + -- nonce, -- cipher-aes >=0.2 && <0.3, deepseq >= 1.1, hex >= 0.1 @@ -86,6 +87,7 @@ benchmark bench cereal >= 0.4, cryptohash >=0.11 && <0.12, -- cipher-aes >=0.2 && <0.3, + either >=4.4, hex >= 0.1, deepseq >= 1.1, criterion >= 1.1 @@ -93,7 +95,7 @@ benchmark bench test-suite test default-language: Haskell2010 type: exitcode-stdio-1.0 - hs-source-dirs: test + hs-source-dirs: src, test main-is: main.hs build-depends: base >= 4 && <5, attoparsec >=0.12, @@ -102,9 +104,11 @@ test-suite test byteable >= 0.1 && <0.2, cereal >= 0.4, cryptohash >=0.11 && <0.12, + either >=4.4, hex >= 0.1, tasty >= 0.10, tasty-hunit >= 0.9, tasty-quickcheck >= 0.8, QuickCheck >= 2.8, - hmacaroons + deepseq >= 1.1, + transformers >= 0.3 diff --git a/shell.nix b/shell.nix index 07952fc..3846dd5 100644 --- a/shell.nix +++ b/shell.nix @@ -1,5 +1,5 @@ -with (import {}).pkgs; -let hspkgs = haskell-ng.packages.ghc7101.override { +{ pkgs ? import {}, compiler ? "ghc7101" }: +let hspkgs = pkgs.haskell.packages.${compiler}.override { overrides = self: super: { hmacaroons = self.callPackage ./. {}; }; diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs index bfcf8df..86d8eb7 100644 --- a/src/Crypto/Macaroon.hs +++ b/src/Crypto/Macaroon.hs @@ -23,6 +23,7 @@ module Crypto.Macaroon ( -- * Types Macaroon , Caveat + , Secret , Key , Location , Sig @@ -33,44 +34,36 @@ module Crypto.Macaroon ( , caveats , signature -- ** Caveats - , caveatLoc - , caveatId - , caveatVId + , cl + , cid + , vid -- * Create Macaroons , create , inspect , addFirstPartyCaveat -- , addThirdPartyCaveat + -- * Serialize + , module Crypto.Macaroon.Serializer.Base64 + -- * Verify + , module Crypto.Macaroon.Verifier ) where -- import Crypto.Cipher.AES import Crypto.Hash import Data.Byteable -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base64.URL as B64 -import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString as BS import Crypto.Macaroon.Internal +import Crypto.Macaroon.Serializer.Base64 +import Crypto.Macaroon.Verifier -- | Create a Macaroon from its key, identifier and location -create :: Key -> Key -> Location -> Macaroon +create :: Secret -> Key -> Location -> Macaroon create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) where derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) --- | Caveat target location -caveatLoc :: Caveat -> Location -caveatLoc = cl - --- | Caveat identifier -caveatId :: Caveat -> Key -caveatId = cid - --- | Caveat verification identifier -caveatVId :: Caveat -> Key -caveatVId = vid - -- | Inspect a macaroon's contents. For debugging purposes. inspect :: Macaroon -> String inspect = show @@ -89,5 +82,3 @@ addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m -- addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m -- where -- vid = encryptECB (initAES (signature m)) key - - diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs index 2f56512..d6e80d3 100644 --- a/src/Crypto/Macaroon/Internal.hs +++ b/src/Crypto/Macaroon/Internal.hs @@ -23,7 +23,11 @@ import qualified Data.ByteString.Char8 as B8 import Data.Hex import Data.List --- |Type alias for Macaroons and Caveat keys and identifiers + +-- |Type alias for Macaroons secret keys +type Secret = BS.ByteString + +-- |Type alias for Macaroons and Caveat and identifiers type Key = BS.ByteString -- |Type alias for Macaroons and Caveat locations diff --git a/src/Crypto/Macaroon/Verifier.hs b/src/Crypto/Macaroon/Verifier.hs index ed24ea4..4fc6aff 100644 --- a/src/Crypto/Macaroon/Verifier.hs +++ b/src/Crypto/Macaroon/Verifier.hs @@ -1,5 +1,8 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} {-| Module : Crypto.Macaroon.Verifier Copyright : (c) 2015 Julien Tanguy @@ -13,80 +16,77 @@ Portability : portable -} module Crypto.Macaroon.Verifier ( - Verified(..) - , CaveatVerifier - , () - , verifyMacaroon - , verifySig - , verifyExact - , verifyFun - , module Data.Attoparsec.ByteString.Char8 - , verifyCavs + verify + , ValidationError(ValidatorError, ParseError) + -- , (.<), (.<=), (.==), (.>), (.>=) + -- , module Data.Attoparsec.ByteString.Char8 ) where -import Crypto.Hash +import Control.Applicative +import Control.Monad hiding (forM) +import Control.Monad.IO.Class +import Data.Attoparsec.ByteString +import Data.Attoparsec.ByteString.Char8 import Data.Bool -import qualified Data.ByteString as BS -import Data.Byteable -import Data.Foldable -import Data.Function -import Data.Maybe -import Data.Monoid import Data.Traversable -import Data.Attoparsec.ByteString -import Data.Attoparsec.ByteString.Char8 +import qualified Data.ByteString as BS +import Data.Either.Combinators import Crypto.Macaroon.Internal +import Crypto.Macaroon.Verifier.Internal + + + + +-- (.<) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- (.<) = verifyOpBool "Greater or equal" (<) "<" + +-- (.<=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- (.<=) = verifyOpBool "Strictly greater" (<=) "<=" + +-- (.==) :: (MonadIO m, Eq a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- (.==) = verifyOpBool "Not equal" (==) "=" + +-- (.>) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- (.>) = verifyOpBool "Less or equal" (>) ">" + +-- (.>=) :: (MonadIO m, Ord a, Parsable a) => Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- (.>=) = verifyOpBool "Strictly less" (>=) ">=" + +-- | Verify a Macaroon's signature and caveats, given the corresponding Secret +-- and verifiers. +-- +-- A verifier is a function of type +-- @'MonadIO' m => 'Caveat' -> m ('Maybe' ('Either' 'ValidatorError' 'Caveat'))@. +-- +-- It should return: +-- +-- * 'Nothing' if the caveat is not related to the verifier +-- (for instance a time verifier is given an action caveat); +-- * 'Just' ('Left' ('ParseError' reason)) if the verifier is related to the +-- caveat, but failed to parse it completely; +-- * 'Just' ('Left' ('ValidatorError' reason)) if the verifier is related to the +-- caveat, parsed it and invalidated it; +-- * 'Just' ('Right' '()') if the verifier has successfully verified the +-- given caveat +verify :: (Functor m, MonadIO m) => Secret -> [Caveat -> m (Maybe (Either ValidationError ()))] -> Macaroon -> m (Either ValidationError Macaroon) +verify secret verifiers m = join <$> forM (verifySig secret m) (verifyCavs verifiers) + + +-- verifyOpBool :: MonadIO m => String -> Parser a -> (a -> a -> Bool) -> BS.ByteString -> Key -> m a -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- verifyOpBool err p f op k val = verifyParser k valueParser $ \s -> do +-- expected <- val +-- return $ bool (Left $ ValidatorError err) (Right Win) =<< f expected <$> mapLeft ParseError (parseOnly p s) +-- where +-- valueParser = string op *> skipSpace *> takeByteString + +-- verifyParser :: (MonadIO m) => Key -> Parser a -> (a -> m (Either ValidationError Win)) -> Caveat -> m (Maybe (Either ValidationError Caveat)) +-- verifyParser k p f c = case parseOnly keyParser . cid $ c of +-- Left _ -> return Nothing +-- Right bs -> Just <$> case parseOnly p bs of +-- Left err -> return $ Left $ ParseError err +-- Right a -> fmap (const c) <$> f a +-- where +-- keyParser = string k *> skipSpace *> takeByteString - --- | Opaque datatype for now. Might need more explicit errors -data Verified = Ok | Failed deriving (Show,Eq) - -instance Monoid Verified where - mempty = Ok - mappend Ok Ok = Ok - mappend _ _ = Failed - - -data CaveatVerifier = CV { vFun :: Caveat -> Maybe Verified , helpText :: String} - -instance Eq CaveatVerifier where - (==) = (==) `on` helpText - -instance Show CaveatVerifier where - show = helpText - -() :: (Caveat -> Maybe Verified) -> String -> CaveatVerifier -f t = CV f t - -verifySig :: Key -> Macaroon -> Verified -verifySig k m = bool Failed Ok $ - signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) - where - hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) - derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) - -verifyMacaroon :: Key -> [CaveatVerifier] -> Macaroon -> Verified -verifyMacaroon secret verifiers m = verifySig secret m `mappend` verifyCavs verifiers m - - -verifyCavs :: [CaveatVerifier] -> Macaroon -> Verified -verifyCavs verifiers m = foldMap (\c -> fromMaybe Failed $ foldMap (($ c) . vFun) verifiers) (caveats m) - -verifyExact :: (Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified -verifyExact k expected = verifyFun k (expected ==) - -verifyFun :: Key -> (a -> Bool) -> Parser a -> Caveat -> Maybe Verified -verifyFun key f parser cav = if key `BS.isPrefixOf` cid cav then - case parseOnly kvparser (cid cav) of - Right v -> (bool Failed Ok . f) <$> Just v - Left _ -> Just Failed - else Nothing - where - kvparser = do - key <- string key - skipSpace - string "=" - skipSpace - parser <* endOfInput diff --git a/src/Crypto/Macaroon/Verifier/Internal.hs b/src/Crypto/Macaroon/Verifier/Internal.hs new file mode 100644 index 0000000..b3ad7f2 --- /dev/null +++ b/src/Crypto/Macaroon/Verifier/Internal.hs @@ -0,0 +1,79 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-| +Module : Crypto.Macaroon.Verifier.Internal +Copyright : (c) 2015 Julien Tanguy +License : BSD3 + +Maintainer : julien.tanguy@jhome.fr +Stability : experimental +Portability : portable + + + +-} +module Crypto.Macaroon.Verifier.Internal where + +import Control.Applicative +import Control.Monad +import Control.Monad.IO.Class +import Crypto.Hash +import Data.Bool +import Data.Byteable +import qualified Data.ByteString as BS +import Data.Either +import Data.Either.Validation +import Data.Foldable +import Data.Maybe +import Data.Monoid + +import Crypto.Macaroon.Internal + +-- | Type representing different validation errors. +-- Only 'ParseError' and 'ValidatorError' are exported, @SigMismatch@ and +-- @NoVerifier@ are used internally and should not be used by the user +data ValidationError = SigMismatch -- ^ Signatures do not match + | NoVerifier -- ^ No verifier can handle a given caveat + | ParseError String -- ^ A verifier had a parse error + | ValidatorError String -- ^ A verifier failed + deriving (Show,Eq) + +-- | The 'Monoid' instance is written so @SigMismatch@ is an annihilator, +-- and @NoVerifier@ is the identity element +instance Monoid ValidationError where + mempty = NoVerifier + NoVerifier `mappend` e = e + e `mappend` NoVerifier = e + SigMismatch `mappend` _ = SigMismatch + _ `mappend` SigMismatch = SigMismatch + (ValidatorError e) `mappend` (ParseError _) = ValidatorError e + (ParseError _) `mappend` (ValidatorError e) = ValidatorError e + +-- | Check that the given macaroon has a correct signature +verifySig :: Key -> Macaroon -> Either ValidationError Macaroon +verifySig k m = bool (Left SigMismatch) (Right m) $ + signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) + where + hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) + derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) + +-- | Given a list of verifiers, verify each caveat of the given macaroon +verifyCavs :: (Functor m, MonadIO m) + => [Caveat -> m (Maybe (Either ValidationError ()))] + -> Macaroon + -> m (Either ValidationError Macaroon) +verifyCavs verifiers m = gatherEithers <$> mapM validateCaveat (caveats m) + where + {- + - validateCaveat :: Caveat -> m (Validation String Caveat) + - We can use fromJust here safely since we use a `Just Failure` as a + - starting value for the foldM. We are guaranteed to have a `Just something` + - from it. + -} + validateCaveat c = fmap (const c) . fromJust <$> foldM (\res v -> mappend res . fmap eitherToValidation <$> v c) (defErr c) verifiers + -- defErr :: Caveat -> Maybe (Validation String Caveat) + defErr c = Just $ Failure NoVerifier + -- gatherEithers :: [Validation String Caveat] -> Either String Caveat + gatherEithers vs = case partitionEithers . map validationToEither $ vs of + ([],_) -> Right m + (errs,_) -> Left (mconcat errs) 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: -} module Crypto.Macaroon.Instances where -import Control.Monad +import Control.Applicative +import Control.Monad import Data.Byteable -import qualified Data.ByteString as BS +import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 import Data.Hex import Data.List @@ -32,10 +33,10 @@ instance Arbitrary Url where domain <- elements [".com",".net"] return . Url . B8.pack $ (protocol ++ name ++ domain) -newtype Secret = Secret { unSecret :: BS.ByteString } deriving (Show) +newtype BSSecret = BSSecret { unSecret :: BS.ByteString } deriving (Show) -instance Arbitrary Secret where - arbitrary = Secret . B8.pack <$> scale (*3) arbitrary +instance Arbitrary BSSecret where + arbitrary = BSSecret . B8.pack <$> scale (*3) arbitrary newtype Identifier = Identifier { unIdent :: BS.ByteString } deriving (Show) 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: module Crypto.Macaroon.Tests where import Data.Byteable -import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Char8 as B8 import Data.Hex import Test.Tasty 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 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Copyright : (c) 2015 Julien Tanguy +License : BSD3 + +Maintainer : julien.tanguy@jhome.fr + + +This test suite is based on the pymacaroons test suite: + +-} +module Crypto.Macaroon.Verifier.Internal.Tests where + +import Data.Bool +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as B8 +import Data.Either +import Data.Either.Validation +import Data.List +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck hiding (Failure, Success) + +import Crypto.Macaroon +import Crypto.Macaroon.Verifier.Internal + +import Crypto.Macaroon.Instances + +tests :: TestTree +tests = testGroup "Crypto.Macaroon.Verifier.Internal" [ sigs + , firstParty + ] + +{- + - Test fixtures + -} +sec = B8.pack "this is our super secret key; only we should know it" + +m :: Macaroon +m = create sec key loc + where + key = B8.pack "we used our sec key" + loc = B8.pack "http://mybank/" + +m2 :: Macaroon +m2 = addFirstPartyCaveat "test = caveat" m + +vtest :: Caveat -> IO (Maybe (Either ValidationError ())) +vtest c = return $ if "test" `BS.isPrefixOf` cid c then + Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "test = caveat" == cid c + else Nothing + + +m3 :: Macaroon +m3 = addFirstPartyCaveat "value = 42" m2 + +vval :: Caveat -> IO (Maybe (Either ValidationError ())) +vval c = return $ if "value" `BS.isPrefixOf` cid c then + Just $ bool (Left (ValidatorError "Failed")) (Right ()) $ "value = 42" == cid c + else Nothing + + +{- + - Tests + -} + +sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Right (macaroon sm) + + +firstParty = testGroup "First party caveats" [ + testCase "Zero caveat" $ do + res <- verifyCavs [] m :: IO (Either ValidationError Macaroon) + Right m @=? res + , testCase "One caveat empty" $ do + res <- verifyCavs [] m2 :: IO (Either ValidationError Macaroon) + Left NoVerifier @=? res + , testCase "One caveat fail" $ do + res <- verifyCavs [vval] m2 :: IO (Either ValidationError Macaroon) + Left NoVerifier @=? res + , testCase "One caveat win" $ do + res <- verifyCavs [vtest] m2 :: IO (Either ValidationError Macaroon) + Right m2 @=? res + , testCase "Two caveat win" $ do + res <- verifyCavs [vtest, vval] m3 :: IO (Either ValidationError Macaroon) + Right m3 @=? res + ] 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: module Crypto.Macaroon.Verifier.Tests where -import Data.List -import qualified Data.ByteString.Char8 as B8 -import Test.Tasty --- import Test.Tasty.HUnit -import Test.Tasty.QuickCheck +import qualified Data.ByteString.Char8 as B8 +import Data.Either +import Data.List +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck import Crypto.Macaroon import Crypto.Macaroon.Verifier -import Crypto.Macaroon.Instances +import Crypto.Macaroon.Instances tests :: TestTree -tests = testGroup "Crypto.Macaroon.Verifier" [ sigs - , firstParty - ] +tests = testGroup "Crypto.Macaroon.Verifier" [ ] {- - Test fixtures @@ -45,52 +44,8 @@ m2 = addFirstPartyCaveat "test = caveat" m m3 :: Macaroon m3 = addFirstPartyCaveat "value = 42" m2 -exTC = verifyExact "test" "caveat" (many' letter_ascii) "test = caveat" -exTZ = verifyExact "test" "bleh" (many' letter_ascii) "test = bleh" -exV42 = verifyExact "value" 42 decimal "value = 42" -exV43 = verifyExact "value" 43 decimal "value = 43" - -funTCPre = verifyFun "test" ("cav" `isPrefixOf`) (many' letter_ascii) "test startsWith cav" -funTV43lte = verifyFun "value" (<= 43) decimal "value <= 43" - -allvs = [exTC, exTZ, exV42, exV43, funTCPre, funTV43lte] - {- - Tests -} -sigs = testProperty "Signatures" $ \sm -> verifySig (secret sm) (macaroon sm) == Ok -firstParty = testGroup "First party caveats" [ - testGroup "Pure verifiers" [ - testProperty "Zero caveat" $ - forAll (sublistOf allvs) (\vs -> Ok == verifyCavs vs m) - , testProperty "One caveat" $ - forAll (sublistOf allvs) (\vs -> disjoin [ - Ok == verifyCavs vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) - , Failed === verifyCavs vs m2 - ]) - , testProperty "Two Exact" $ - forAll (sublistOf allvs) (\vs -> disjoin [ - Ok == verifyCavs vs m3 .&&. - any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. - any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) - , Failed === verifyCavs vs m3 - ]) - ] - , testGroup "Pure verifiers with sig" [ - testProperty "Zero caveat" $ - forAll (sublistOf allvs) (\vs -> Ok == verifyMacaroon sec vs m) - , testProperty "One caveat" $ - forAll (sublistOf allvs) (\vs -> disjoin [ - Ok == verifyMacaroon sec vs m2 .&&. any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) - , Failed === verifyMacaroon sec vs m2 - ]) - , testProperty "Two Exact" $ - forAll (sublistOf allvs) (\vs -> disjoin [ - Ok == verifyMacaroon sec vs m3 .&&. - any (`elem` vs) [exTC,funTCPre] .&&. (exTZ `notElem` vs) .&&. - any (`elem` vs) [exV42,funTV43lte] .&&. (exV43 `notElem` vs) - , Failed === verifyMacaroon sec vs m3 - ]) - ] - ] +-- TODO 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 @@ -{-#LANGUAGE OverloadedStrings#-} +{-# LANGUAGE OverloadedStrings #-} module Sanity where import Crypto.Hash -import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Hex -import Data.Byteable +import Data.Byteable +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Hex -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit -import qualified Crypto.Macaroon.Tests import qualified Crypto.Macaroon.Serializer.Base64.Tests +import qualified Crypto.Macaroon.Tests tests :: TestTree tests = testGroup "Python HMAC Sanity check" [ checkKey @@ -44,18 +44,18 @@ mac4 :: ByteString mac4 = toBytes (hmac mac3 "email = alice@example.org" :: HMAC SHA256) -checkKey = testCase "Truncated key" $ +checkKey = testCase "Truncated key" $ key @?= "this is our super secret key; on" -checkMac1 = testCase "HMAC key" $ +checkMac1 = testCase "HMAC key" $ "C60B4B3540BB1B2F2EF28D1C895691CC4A5E07A38A9D3B1C3379FB485293372F" @=? hex mac1 -checkMac2 = testCase "HMAC key account" $ +checkMac2 = testCase "HMAC key account" $ "5C933DC9A7D036DFCD1740B4F26D737397A1FF635EAC900F3226973503CAAAA5" @=? hex mac2 -checkMac3 = testCase "HMAC key account time" $ +checkMac3 = testCase "HMAC key account time" $ "7A559B20C8B607009EBCE138C200585E9D0DECA6D23B3EAD6C5E0BA6861D3858" @=? hex mac3 -checkMac4 = testCase "HMAC key account time email" $ +checkMac4 = testCase "HMAC key account time email" $ "E42BBB02A9A5A303483CB6295C497AE51AD1D5CB10003CBE548D907E7E62F5E4" @=? hex mac4 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 @@ module Main where -import Test.Tasty -import Test.Tasty.HUnit +import Test.Tasty +import Test.Tasty.HUnit -import qualified Sanity -import qualified Crypto.Macaroon.Tests import qualified Crypto.Macaroon.Serializer.Base64.Tests +import qualified Crypto.Macaroon.Tests +import qualified Crypto.Macaroon.Verifier.Internal.Tests import qualified Crypto.Macaroon.Verifier.Tests +import qualified Sanity main = defaultMain tests @@ -15,5 +16,6 @@ tests = testGroup "Tests" [ Sanity.tests , Crypto.Macaroon.Tests.tests , Crypto.Macaroon.Serializer.Base64.Tests.tests , Crypto.Macaroon.Verifier.Tests.tests + , Crypto.Macaroon.Verifier.Internal.Tests.tests ]