diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Crypto/Macaroon.hs | 31 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Binder.hs | 2 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Internal.hs | 33 |
3 files changed, 35 insertions, 31 deletions
diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs index 819a9eb..42e4a07 100644 --- a/src/Crypto/Macaroon.hs +++ b/src/Crypto/Macaroon.hs | |||
@@ -8,18 +8,16 @@ Maintainer : julien.tanguy@jhome.fr | |||
8 | Stability : experimental | 8 | Stability : experimental |
9 | Portability : portable | 9 | Portability : portable |
10 | 10 | ||
11 | |||
12 | Pure haskell implementations of macaroons. | 11 | Pure haskell implementations of macaroons. |
13 | 12 | ||
14 | Warning: this implementation has not been audited by security experts. | 13 | Warning: this implementation has not been audited by security experts. |
15 | Use it with caution. | 14 | Do not use in production |
16 | 15 | ||
17 | 16 | ||
18 | References: | 17 | References: |
19 | 18 | ||
20 | - Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html> | 19 | - 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> | 20 | - Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex> |
22 | |||
23 | -} | 21 | -} |
24 | module Crypto.Macaroon ( | 22 | module Crypto.Macaroon ( |
25 | -- * Types | 23 | -- * Types |
@@ -50,11 +48,14 @@ module Crypto.Macaroon ( | |||
50 | 48 | ||
51 | import Crypto.Cipher.AES | 49 | import Crypto.Cipher.AES |
52 | import Crypto.Hash | 50 | import Crypto.Hash |
51 | import Data.Char | ||
53 | import Data.Byteable | 52 | import Data.Byteable |
54 | import qualified Data.ByteString as BS | 53 | import qualified Data.ByteString as BS |
55 | import qualified Data.ByteString.Base64.URL as B64 | 54 | import qualified Data.ByteString.Base64.URL as B64 |
56 | import qualified Data.ByteString.Char8 as B8 | 55 | import qualified Data.ByteString.Char8 as B8 |
57 | import Data.Hex | 56 | import Data.Hex |
57 | import Data.Word | ||
58 | import Data.Serialize | ||
58 | 59 | ||
59 | import Crypto.Macaroon.Internal | 60 | import Crypto.Macaroon.Internal |
60 | 61 | ||
@@ -62,7 +63,7 @@ import Crypto.Macaroon.Internal | |||
62 | create :: Key -> Key -> Location -> Macaroon | 63 | create :: Key -> Key -> Location -> Macaroon |
63 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) | 64 | create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) |
64 | where | 65 | where |
65 | derivedKey = toBytes $ (hmac "macaroons-key-generator" secret :: HMAC SHA256) | 66 | derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256) |
66 | 67 | ||
67 | caveatLoc :: Caveat -> Location | 68 | caveatLoc :: Caveat -> Location |
68 | caveatLoc = cl | 69 | caveatLoc = cl |
@@ -74,17 +75,7 @@ caveatVId :: Caveat -> Key | |||
74 | caveatVId = vid | 75 | caveatVId = vid |
75 | 76 | ||
76 | inspect :: Macaroon -> String | 77 | inspect :: Macaroon -> String |
77 | inspect m = unlines [ "location " ++ show (location m) | 78 | inspect = show |
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 | 79 | ||
89 | serialize :: Macaroon -> BS.ByteString | 80 | serialize :: Macaroon -> BS.ByteString |
90 | serialize m = B8.filter (/= '=') . B64.encode $ packets | 81 | serialize m = B8.filter (/= '=') . B64.encode $ packets |
@@ -100,6 +91,16 @@ serialize m = B8.filter (/= '=') . B64.encode $ packets | |||
100 | , putPacket "vid" (vid c) | 91 | , putPacket "vid" (vid c) |
101 | , putPacket "cl" (cl c) | 92 | , putPacket "cl" (cl c) |
102 | ] | 93 | ] |
94 | putPacket key dat = BS.concat [ | ||
95 | B8.map toLower . hex . encode $ (fromIntegral size :: Word16) | ||
96 | , key | ||
97 | , " " | ||
98 | , dat | ||
99 | , "\n" | ||
100 | ] | ||
101 | where | ||
102 | size = 4 + 2 + BS.length key + BS.length dat | ||
103 | |||
103 | 104 | ||
104 | 105 | ||
105 | 106 | ||
diff --git a/src/Crypto/Macaroon/Binder.hs b/src/Crypto/Macaroon/Binder.hs index 3ec3d67..91f07ce 100644 --- a/src/Crypto/Macaroon/Binder.hs +++ b/src/Crypto/Macaroon/Binder.hs | |||
@@ -24,5 +24,5 @@ newtype Binder = Binder { bind :: Macaroon -> Macaroon -> BS.ByteString } | |||
24 | 24 | ||
25 | -- | Binder which concatenates the two signatures and hashes them | 25 | -- | Binder which concatenates the two signatures and hashes them |
26 | hashSigs :: Binder | 26 | hashSigs :: Binder |
27 | hashSigs = Binder $ \m m' -> toBytes $ (HMAC . hash $ BS.append (toBytes $ signature m') (toBytes $ signature m) :: HMAC SHA256) | 27 | hashSigs = Binder $ \m m' -> toBytes (HMAC . hash $ BS.append (toBytes $ signature m') (toBytes $ signature m) :: HMAC SHA256) |
28 | 28 | ||
diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs index fc50486..82ce0b4 100644 --- a/src/Crypto/Macaroon/Internal.hs +++ b/src/Crypto/Macaroon/Internal.hs | |||
@@ -21,10 +21,8 @@ import Data.Byteable | |||
21 | import qualified Data.ByteString as BS | 21 | import qualified Data.ByteString as BS |
22 | import qualified Data.ByteString.Base64 as B64 | 22 | import qualified Data.ByteString.Base64 as B64 |
23 | import qualified Data.ByteString.Char8 as B8 | 23 | import qualified Data.ByteString.Char8 as B8 |
24 | import Data.Char | ||
25 | import Data.Hex | 24 | import Data.Hex |
26 | import Data.Serialize | 25 | import Data.List |
27 | import Data.Word | ||
28 | 26 | ||
29 | -- |Type alias for Macaroons and Caveat keys and identifiers | 27 | -- |Type alias for Macaroons and Caveat keys and identifiers |
30 | type Key = BS.ByteString | 28 | type Key = BS.ByteString |
@@ -45,6 +43,14 @@ data Macaroon = MkMacaroon { location :: Location | |||
45 | -- ^ Macaroon HMAC signature | 43 | -- ^ Macaroon HMAC signature |
46 | } deriving (Eq) | 44 | } deriving (Eq) |
47 | 45 | ||
46 | instance Show Macaroon where | ||
47 | -- We use intercalate because unlines would add a trailing newline | ||
48 | show (MkMacaroon l i c s) = intercalate "\n" [ | ||
49 | "location " ++ B8.unpack l | ||
50 | , "identifier " ++ B8.unpack i | ||
51 | , concatMap show c | ||
52 | , "signature " ++ B8.unpack (hex s) | ||
53 | ] | ||
48 | 54 | ||
49 | instance NFData Macaroon where | 55 | instance NFData Macaroon where |
50 | rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig | 56 | rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig |
@@ -60,21 +66,18 @@ data Caveat = MkCaveat { cid :: Key | |||
60 | 66 | ||
61 | } deriving (Eq) | 67 | } deriving (Eq) |
62 | 68 | ||
69 | instance Show Caveat where | ||
70 | show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c | ||
71 | | otherwise = unlines [ "cid " ++ B8.unpack c | ||
72 | , "vid " ++ B8.unpack v | ||
73 | , "cl " ++ B8.unpack l | ||
74 | ] | ||
75 | |||
76 | |||
63 | instance NFData Caveat where | 77 | instance NFData Caveat where |
64 | rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl | 78 | rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl |
65 | 79 | ||
66 | 80 | ||
67 | putPacket :: BS.ByteString -> BS.ByteString -> BS.ByteString | ||
68 | putPacket key dat = BS.concat [ | ||
69 | B8.map toLower . hex . encode $ (fromIntegral size :: Word16) | ||
70 | , key | ||
71 | , " " | ||
72 | , dat | ||
73 | , "\n" | ||
74 | ] | ||
75 | where | ||
76 | size = 4 + 2 + BS.length key + BS.length dat | ||
77 | |||
78 | addCaveat :: Location | 81 | addCaveat :: Location |
79 | -> Key | 82 | -> Key |
80 | -> Key | 83 | -> Key |
@@ -84,5 +87,5 @@ addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig} | |||
84 | where | 87 | where |
85 | cavs = caveats m | 88 | cavs = caveats m |
86 | cav' = MkCaveat cid vid loc | 89 | cav' = MkCaveat cid vid loc |
87 | sig = toBytes $ (hmac (signature m) (BS.append vid cid) :: HMAC SHA256) | 90 | sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256) |
88 | 91 | ||