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