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
118
119
120
121
|
{-# LANGUAGE OverloadedStrings #-}
{-|
Module : Crypto.Macaroon
Copyright : (c) 2015 Julien Tanguy
License : BSD3
Maintainer : julien.tanguy@jhome.fr
Stability : experimental
Portability : portable
Pure haskell implementations of macaroons.
Warning: this implementation has not been audited by security experts.
Use it with caution.
References:
- Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html>
- Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex>
-}
module Crypto.Macaroon (
-- * Types
Macaroon
, Caveat
, Key
, Location
-- * Accessing functions
-- ** Macaroons
, location
, identifier
, caveats
, signature
-- ** Caveats
, caveatLoc
, caveatId
, caveatVId
-- * Create Macaroons
, create
, inspect
, addFirstPartyCaveat
, addThirdPartyCaveat
-- * Prepare Macaroons for transfer
, serialize
) where
import Crypto.Cipher.AES
import Crypto.Hash
import Data.Byteable
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as B64
import qualified Data.ByteString.Char8 as B8
import Data.Hex
import Crypto.Macaroon.Internal
-- | Create a Macaroon from its key, identifier and location
create :: Key -> Key -> Location -> Macaroon
create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256))
where
derivedKey = toBytes $ (hmac "macaroons-key-generator" secret :: HMAC SHA256)
caveatLoc :: Caveat -> Location
caveatLoc = cl
caveatId :: Caveat -> Key
caveatId = cid
caveatVId :: Caveat -> Key
caveatVId = vid
inspect :: Macaroon -> String
inspect m = unlines [ "location " ++ show (location m)
, "identifier " ++ show (identifier m)
, (concatMap (showCav (location m)) (caveats m))
, "signature " ++ show (hex $ signature m)
]
where
showCav loc c | cl c == loc && vid c == BS.empty = "cid " ++ show (cid c)
| otherwise = unlines [ "cid " ++ show (cid c)
, "vid " ++ show (vid c)
, "cl " ++ show (cl c)
]
serialize :: Macaroon -> BS.ByteString
serialize m = B8.filter (/= '=') . B64.encode $ packets
where
packets = BS.concat [ putPacket "location" (location m)
, putPacket "identifier" (identifier m)
, caveatPackets
, putPacket "signature" (signature m)
]
caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m)
cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c)
| otherwise = BS.concat [ putPacket "cid" (cid c)
, putPacket "vid" (vid c)
, putPacket "cl" (cl c)
]
-- | Add a first party Caveat to a Macaroon, with its identifier
addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
-- |Add a third party Caveat to a Macaroon, using its location, identifier and
-- verification key
addThirdPartyCaveat :: Key
-> Key
-> Location
-> Macaroon
-> Macaroon
addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m
where
vid = encryptECB (initAES (signature m)) key
|
