]>
Commit | Line | Data |
---|---|---|
b92e3c15 | 1 | {-# LANGUAGE OverloadedStrings #-} |
6f3c0dca | 2 | {-# LANGUAGE RankNTypes #-} |
b92e3c15 JT |
3 | {-| |
4 | Module : Crypto.Macaroon.Verifier | |
5 | Copyright : (c) 2015 Julien Tanguy | |
6 | License : BSD3 | |
7 | ||
8 | Maintainer : julien.tanguy@jhome.fr | |
9 | Stability : experimental | |
10 | Portability : portable | |
11 | ||
12 | ||
13 | ||
14 | -} | |
6f3c0dca JT |
15 | module Crypto.Macaroon.Verifier ( |
16 | Verified(..) | |
17 | , verifySig | |
18 | , verifyExact | |
19 | , verifyCavs | |
20 | -- , module Data.Attoparsec.ByteString | |
21 | , module Data.Attoparsec.ByteString.Char8 | |
22 | ) where | |
b92e3c15 JT |
23 | |
24 | ||
25 | import Crypto.Hash | |
26 | import Data.Bool | |
27 | import qualified Data.ByteString as BS | |
28 | import Data.Byteable | |
29 | import Data.Foldable | |
6f3c0dca JT |
30 | import Data.Maybe |
31 | import Data.Attoparsec.ByteString | |
32 | import Data.Attoparsec.ByteString.Char8 | |
b92e3c15 JT |
33 | |
34 | import Crypto.Macaroon.Internal | |
35 | ||
36 | ||
37 | -- | Opaque datatype for now. Might need more explicit errors | |
6f3c0dca | 38 | data Verified = Ok | Failed deriving (Show,Eq) |
b92e3c15 | 39 | |
6f3c0dca JT |
40 | instance Monoid Verified where |
41 | mempty = Ok | |
42 | mappend Ok Ok = Ok | |
43 | mappend _ _ = Failed | |
44 | ||
45 | ||
46 | type CaveatVerifier = Caveat -> Maybe Verified | |
47 | ||
48 | verifySig :: Key -> Macaroon -> Verified | |
49 | verifySig k m = bool Failed Ok $ | |
b92e3c15 JT |
50 | signature m == foldl' hash (toBytes (hmac derivedKey (identifier m) :: HMAC SHA256)) (caveats m) |
51 | where | |
52 | hash s c = toBytes (hmac s (vid c `BS.append` cid c) :: HMAC SHA256) | |
53 | derivedKey = toBytes (hmac "macaroons-key-generator" k :: HMAC SHA256) | |
6f3c0dca JT |
54 | |
55 | verifyCavs :: [Caveat -> Maybe Verified] -> Macaroon -> Verified | |
56 | verifyCavs verifiers m = mconcat $ map (\c -> mconcat . catMaybes $ map ($ c) verifiers) (caveats m) | |
57 | ||
58 | verifyExact :: (Show a, Eq a) => Key -> a -> Parser a -> Caveat -> Maybe Verified | |
59 | verifyExact key expected parser cav = if key `BS.isPrefixOf` cid cav then | |
60 | case parseOnly kvparser (cid cav) of | |
61 | Right v -> verify <$> Just v | |
62 | Left _ -> Just Failed | |
63 | else Nothing | |
64 | where | |
65 | kvparser = do | |
66 | key <- string key | |
67 | skipSpace | |
68 | string "=" | |
69 | skipSpace | |
70 | parser | |
71 | ||
72 | -- *> skipSpace *> string "=" *> skipSpace *> parser <* endOfInput | |
73 | verify a = bool Failed Ok (a == expected) |