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
122
123
124
125
126
127
128
|
{-# 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.
Do not use in production
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
, Sig
-- * 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.Char
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 Data.Word
import Data.Serialize
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)
-- | Caveat target location
caveatLoc :: Caveat -> Location
caveatLoc = cl
-- | Caveat identifier
caveatId :: Caveat -> Key
caveatId = cid
-- | Caveat verification identifier
caveatVId :: Caveat -> Key
caveatVId = vid
-- | Inspect a macaroon's contents. For debugging purposes.
inspect :: Macaroon -> String
inspect = show
-- | Serialize a macaroon in an URL-safe Base64 encoding
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)
]
putPacket key dat = BS.concat [
B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
, key
, " "
, dat
, "\n"
]
where
size = 4 + 2 + BS.length key + BS.length dat
-- | 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
|
