]>
Commit | Line | Data |
---|---|---|
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 | |
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 | |
23 | import Data.Hex | |
24 | import Data.List | |
25 | ||
26 | ||
27 | -- |Type alias for Macaroons secret keys | |
28 | type Secret = BS.ByteString | |
29 | ||
30 | -- |Type alias for Macaroons and Caveat and identifiers | |
31 | type Key = BS.ByteString | |
32 | ||
33 | -- |Type alias for Macaroons and Caveat locations | |
34 | type Location = BS.ByteString | |
35 | ||
36 | -- |Type alias for Macaroons signatures | |
37 | type Sig = BS.ByteString | |
38 | ||
39 | -- | Main structure of a macaroon | |
40 | data Macaroon = MkMacaroon { location :: Location | |
41 | -- ^ Target location | |
42 | , identifier :: Key | |
43 | -- ^ Macaroon Identifier | |
44 | , caveats :: [Caveat] | |
45 | -- ^ List of caveats | |
46 | , signature :: Sig | |
47 | -- ^ Macaroon HMAC signature | |
48 | } | |
49 | ||
50 | -- | Constant-time Eq instance | |
51 | instance Eq Macaroon where | |
52 | (MkMacaroon l1 i1 c1 s1) == (MkMacaroon l2 i2 c2 s2) = | |
53 | (l1 `constEqBytes` l2) &&! | |
54 | (i1 `constEqBytes` i2) &&! | |
55 | (c1 == c2) &&! | |
56 | (s1 `constEqBytes` s2) | |
57 | ||
58 | ||
59 | -- | show instance conforming to the @inspect@ "specification" | |
60 | instance Show Macaroon where | |
61 | -- We use intercalate because unlines would add a trailing newline | |
62 | show (MkMacaroon l i c s) = intercalate "\n" [ | |
63 | "location " ++ B8.unpack l | |
64 | , "identifier " ++ B8.unpack i | |
65 | , intercalate "\n" (map show c) | |
66 | , "signature " ++ B8.unpack (hex s) | |
67 | ] | |
68 | ||
69 | -- | NFData instance for use in the benchmark | |
70 | instance NFData Macaroon where | |
71 | rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig | |
72 | ||
73 | ||
74 | -- | Caveat structure | |
75 | data Caveat = MkCaveat { cid :: Key | |
76 | -- ^ Caveat identifier | |
77 | , vid :: Key | |
78 | -- ^ Caveat verification key identifier | |
79 | , cl :: Location | |
80 | -- ^ Caveat target location | |
81 | } | |
82 | ||
83 | -- | Constant-time Eq instance | |
84 | instance Eq Caveat where | |
85 | (MkCaveat c1 v1 l1) == (MkCaveat c2 v2 l2) = | |
86 | (c1 `constEqBytes` c2) &&! | |
87 | (v1 `constEqBytes` v2) &&! | |
88 | (l1 `constEqBytes` l2) | |
89 | ||
90 | -- | show instance conforming to the @inspect@ "specification" | |
91 | instance Show Caveat where | |
92 | show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c | |
93 | | otherwise = unlines [ "cid " ++ B8.unpack c | |
94 | , "vid " ++ B8.unpack v | |
95 | , "cl " ++ B8.unpack l | |
96 | ] | |
97 | ||
98 | ||
99 | -- | NFData instance for use in the benchmark | |
100 | instance NFData Caveat where | |
101 | rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl | |
102 | ||
103 | -- | Primitive to add a First or Third party caveat to a macaroon | |
104 | -- For internal use only | |
105 | addCaveat :: Location | |
106 | -> Key | |
107 | -> Key | |
108 | -> Macaroon | |
109 | -> Macaroon | |
110 | addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig} | |
111 | where | |
112 | cavs = caveats m | |
113 | cav' = MkCaveat cid vid loc | |
114 | sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256) | |
115 | ||
116 | -- | Utility non-short circuiting '&&' function. | |
117 | (&&!) :: Bool -> Bool -> Bool | |
118 | True &&! True = True | |
119 | True &&! False = False | |
120 | False &&! True = False | |
121 | False &&! False = False | |
122 |