]> git.immae.eu Git - github/fretlink/hmacaroons.git/blob - src/Crypto/Macaroon.hs
Initial commit
[github/fretlink/hmacaroons.git] / src / Crypto / Macaroon.hs
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
12 Pure haskell implementations of macaroons.
13
14 Warning: this implementation has not been audited by security experts.
15 Use it with caution.
16
17
18 References:
19
20 - Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html>
21 - Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex>
22
23 -}
24 module Crypto.Macaroon (
25 -- * Types
26 Macaroon
27 , Caveat
28 , Key
29 , Location
30 -- * Accessing functions
31 -- ** Macaroons
32 , location
33 , identifier
34 , caveats
35 , signature
36 -- ** Caveats
37 , caveatLoc
38 , caveatId
39 , caveatVId
40
41 -- * Create Macaroons
42 , create
43 , inspect
44 , addFirstPartyCaveat
45 , addThirdPartyCaveat
46
47 -- * Prepare Macaroons for transfer
48 , serialize
49 ) where
50
51 import Crypto.Cipher.AES
52 import Crypto.Hash
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
59 import Crypto.Macaroon.Internal
60
61 -- | Create a Macaroon from its key, identifier and location
62 create :: Key -> Key -> Location -> Macaroon
63 create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256))
64 where
65 derivedKey = toBytes $ (hmac "macaroons-key-generator" secret :: HMAC SHA256)
66
67 caveatLoc :: Caveat -> Location
68 caveatLoc = cl
69
70 caveatId :: Caveat -> Key
71 caveatId = cid
72
73 caveatVId :: Caveat -> Key
74 caveatVId = vid
75
76 inspect :: Macaroon -> String
77 inspect m = unlines [ "location " ++ show (location m)
78 , "identifier " ++ show (identifier m)
79 , (concatMap (showCav (location m)) (caveats m))
80 , "signature " ++ show (hex $ signature m)
81 ]
82 where
83 showCav loc c | cl c == loc && vid c == BS.empty = "cid " ++ show (cid c)
84 | otherwise = unlines [ "cid " ++ show (cid c)
85 , "vid " ++ show (vid c)
86 , "cl " ++ show (cl c)
87 ]
88
89 serialize :: Macaroon -> BS.ByteString
90 serialize m = B8.filter (/= '=') . B64.encode $ packets
91 where
92 packets = BS.concat [ putPacket "location" (location m)
93 , putPacket "identifier" (identifier m)
94 , caveatPackets
95 , putPacket "signature" (signature m)
96 ]
97 caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m)
98 cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c)
99 | otherwise = BS.concat [ putPacket "cid" (cid c)
100 , putPacket "vid" (vid c)
101 , putPacket "cl" (cl c)
102 ]
103
104
105
106 -- | Add a first party Caveat to a Macaroon, with its identifier
107 addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
108 addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
109
110 -- |Add a third party Caveat to a Macaroon, using its location, identifier and
111 -- verification key
112 addThirdPartyCaveat :: Key
113 -> Key
114 -> Location
115 -> Macaroon
116 -> Macaroon
117 addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m
118 where
119 vid = encryptECB (initAES (signature m)) key
120
121