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