]>
Commit | Line | Data |
---|---|---|
f6781456 JT |
1 | {-# LANGUAGE OverloadedStrings #-} |
2 | {-| | |
3 | Module : Crypto.Macaroon.Internal | |
4 | Copyright : (c) 2015 Julien Tanguy | |
5 | License : BSD3 | |
6 | ||
7 | Maintainer : julien.tanguy@jhome.fr | |
8 | Stability : experimental | |
9 | Portability : portable | |
10 | ||
11 | ||
12 | Internal representation of a macaroon | |
13 | -} | |
14 | module Crypto.Macaroon.Internal where | |
15 | ||
16 | ||
17 | import Control.DeepSeq | |
f6781456 JT |
18 | import Crypto.Hash |
19 | import Data.Byteable | |
20 | import qualified Data.ByteString as BS | |
21 | import qualified Data.ByteString.Base64 as B64 | |
22 | import qualified Data.ByteString.Char8 as B8 | |
f6781456 | 23 | import Data.Hex |
2aede11a | 24 | import Data.List |
f6781456 JT |
25 | |
26 | -- |Type alias for Macaroons and Caveat keys and identifiers | |
27 | type Key = BS.ByteString | |
28 | ||
1971e224 | 29 | -- |Type alias for Macaroons and Caveat locations |
f6781456 JT |
30 | type Location = BS.ByteString |
31 | ||
1971e224 | 32 | -- |Type alias for Macaroons signatures |
f6781456 JT |
33 | type Sig = BS.ByteString |
34 | ||
35 | -- | Main structure of a macaroon | |
36 | data Macaroon = MkMacaroon { location :: Location | |
37 | -- ^ Target location | |
38 | , identifier :: Key | |
39 | -- ^ Macaroon Identifier | |
40 | , caveats :: [Caveat] | |
41 | -- ^ List of caveats | |
42 | , signature :: Sig | |
43 | -- ^ Macaroon HMAC signature | |
30c4b925 JT |
44 | } |
45 | ||
7986de7c | 46 | -- | Constant-time Eq instance |
30c4b925 JT |
47 | instance Eq Macaroon where |
48 | (MkMacaroon l1 i1 c1 s1) == (MkMacaroon l2 i2 c2 s2) = | |
49 | (l1 `constEqBytes` l2) &&! | |
50 | (i1 `constEqBytes` i2) &&! | |
51 | (c1 == c2) &&! | |
52 | (s1 `constEqBytes` s2) | |
53 | ||
f6781456 | 54 | |
1971e224 | 55 | -- | show instance conforming to the @inspect@ "specification" |
2aede11a JT |
56 | instance Show Macaroon where |
57 | -- We use intercalate because unlines would add a trailing newline | |
58 | show (MkMacaroon l i c s) = intercalate "\n" [ | |
59 | "location " ++ B8.unpack l | |
60 | , "identifier " ++ B8.unpack i | |
61 | , concatMap show c | |
62 | , "signature " ++ B8.unpack (hex s) | |
63 | ] | |
f6781456 | 64 | |
1971e224 | 65 | -- | NFData instance for use in the benchmark |
f6781456 JT |
66 | instance NFData Macaroon where |
67 | rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig | |
68 | ||
69 | ||
70 | -- | Caveat structure | |
71 | data Caveat = MkCaveat { cid :: Key | |
72 | -- ^ Caveat identifier | |
73 | , vid :: Key | |
74 | -- ^ Caveat verification key identifier | |
75 | , cl :: Location | |
76 | -- ^ Caveat target location | |
30c4b925 | 77 | } |
f6781456 | 78 | |
7986de7c | 79 | -- | Constant-time Eq instance |
30c4b925 JT |
80 | instance Eq Caveat where |
81 | (MkCaveat c1 v1 l1) == (MkCaveat c2 v2 l2) = | |
82 | (c1 `constEqBytes` c2) &&! | |
83 | (v1 `constEqBytes` v2) &&! | |
84 | (l1 `constEqBytes` l2) | |
f6781456 | 85 | |
1971e224 | 86 | -- | show instance conforming to the @inspect@ "specification" |
2aede11a JT |
87 | instance Show Caveat where |
88 | show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c | |
89 | | otherwise = unlines [ "cid " ++ B8.unpack c | |
90 | , "vid " ++ B8.unpack v | |
91 | , "cl " ++ B8.unpack l | |
92 | ] | |
93 | ||
94 | ||
1971e224 | 95 | -- | NFData instance for use in the benchmark |
f6781456 JT |
96 | instance NFData Caveat where |
97 | rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl | |
98 | ||
1971e224 JT |
99 | -- | Primitive to add a First or Third party caveat to a macaroon |
100 | -- For internal use only | |
f6781456 JT |
101 | addCaveat :: Location |
102 | -> Key | |
103 | -> Key | |
104 | -> Macaroon | |
105 | -> Macaroon | |
106 | addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig} | |
107 | where | |
108 | cavs = caveats m | |
109 | cav' = MkCaveat cid vid loc | |
2aede11a | 110 | sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256) |
f6781456 | 111 | |
30c4b925 JT |
112 | -- | Utility non-short circuiting '&&' function. |
113 | (&&!) :: Bool -> Bool -> Bool | |
114 | True &&! True = True | |
115 | True &&! False = False | |
116 | False &&! True = False | |
117 | False &&! False = False | |
118 |