]>
Commit | Line | Data |
---|---|---|
1 | {-# LANGUAGE OverloadedStrings #-} | |
2 | {-| | |
3 | Module : Crypto.Macaroon | |
4 | Copyright : (c) 2015 Julien Tanguy | |
5 | License : BSD3 | |
6 | ||
7 | Maintainer : julien.tanguy@jhome.fr | |
8 | Stability : experimental | |
9 | Portability : portable | |
10 | ||
11 | Pure haskell implementations of macaroons. | |
12 | ||
13 | Warning: this implementation has not been audited by security experts. | |
14 | Do not use in production | |
15 | ||
16 | ||
17 | References: | |
18 | ||
19 | - Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html> | |
20 | - Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex> | |
21 | -} | |
22 | module Crypto.Macaroon ( | |
23 | -- * Types | |
24 | Macaroon | |
25 | , Caveat | |
26 | , Key | |
27 | , Location | |
28 | , Sig | |
29 | -- * Accessing functions | |
30 | -- ** Macaroons | |
31 | , location | |
32 | , identifier | |
33 | , caveats | |
34 | , signature | |
35 | -- ** Caveats | |
36 | , caveatLoc | |
37 | , caveatId | |
38 | , caveatVId | |
39 | ||
40 | -- * Create Macaroons | |
41 | , create | |
42 | , inspect | |
43 | , addFirstPartyCaveat | |
44 | , addThirdPartyCaveat | |
45 | ||
46 | -- * Prepare Macaroons for transfer | |
47 | , serialize | |
48 | ) where | |
49 | ||
50 | import Crypto.Cipher.AES | |
51 | import Crypto.Hash | |
52 | import Data.Char | |
53 | import Data.Byteable | |
54 | import qualified Data.ByteString as BS | |
55 | import qualified Data.ByteString.Base64.URL as B64 | |
56 | import qualified Data.ByteString.Char8 as B8 | |
57 | import Data.Hex | |
58 | import Data.Word | |
59 | import Data.Serialize | |
60 | ||
61 | import Crypto.Macaroon.Internal | |
62 | ||
63 | -- | Create a Macaroon from its key, identifier and location | |
64 | create :: Key -> Key -> Location -> Macaroon | |
65 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) | |
66 | where | |
67 | derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) | |
68 | ||
69 | -- | Caveat target location | |
70 | caveatLoc :: Caveat -> Location | |
71 | caveatLoc = cl | |
72 | ||
73 | -- | Caveat identifier | |
74 | caveatId :: Caveat -> Key | |
75 | caveatId = cid | |
76 | ||
77 | -- | Caveat verification identifier | |
78 | caveatVId :: Caveat -> Key | |
79 | caveatVId = vid | |
80 | ||
81 | -- | Inspect a macaroon's contents. For debugging purposes. | |
82 | inspect :: Macaroon -> String | |
83 | inspect = show | |
84 | ||
85 | -- | Serialize a macaroon in an URL-safe Base64 encoding | |
86 | serialize :: Macaroon -> BS.ByteString | |
87 | serialize m = B8.filter (/= '=') . B64.encode $ packets | |
88 | where | |
89 | packets = BS.concat [ putPacket "location" (location m) | |
90 | , putPacket "identifier" (identifier m) | |
91 | , caveatPackets | |
92 | , putPacket "signature" (signature m) | |
93 | ] | |
94 | caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m) | |
95 | cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c) | |
96 | | otherwise = BS.concat [ putPacket "cid" (cid c) | |
97 | , putPacket "vid" (vid c) | |
98 | , putPacket "cl" (cl c) | |
99 | ] | |
100 | putPacket key dat = BS.concat [ | |
101 | B8.map toLower . hex . encode $ (fromIntegral size :: Word16) | |
102 | , key | |
103 | , " " | |
104 | , dat | |
105 | , "\n" | |
106 | ] | |
107 | where | |
108 | size = 4 + 2 + BS.length key + BS.length dat | |
109 | ||
110 | ||
111 | ||
112 | ||
113 | -- | Add a first party Caveat to a Macaroon, with its identifier | |
114 | addFirstPartyCaveat :: Key -> Macaroon -> Macaroon | |
115 | addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m | |
116 | ||
117 | -- |Add a third party Caveat to a Macaroon, using its location, identifier and | |
118 | -- verification key | |
119 | addThirdPartyCaveat :: Key | |
120 | -> Key | |
121 | -> Location | |
122 | -> Macaroon | |
123 | -> Macaroon | |
124 | addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m | |
125 | where | |
126 | vid = encryptECB (initAES (signature m)) key | |
127 | ||
128 |