aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Crypto
diff options
context:
space:
mode:
authorJulien Tanguy <julien.tanguy@jhome.fr>2015-04-09 17:29:37 +0200
committerJulien Tanguy <julien.tanguy@jhome.fr>2015-04-09 17:29:37 +0200
commit2aede11ad7e5addd50cd4e3c202e094319e942f2 (patch)
treeaf40c821fef8b8066e736937396a08ec5b4ded35 /src/Crypto
parentf678145637ba6f42c36d07c19f8c764e5d537f72 (diff)
downloadhmacaroons-2aede11ad7e5addd50cd4e3c202e094319e942f2.tar.gz
hmacaroons-2aede11ad7e5addd50cd4e3c202e094319e942f2.tar.zst
hmacaroons-2aede11ad7e5addd50cd4e3c202e094319e942f2.zip
Rewording and lint
Diffstat (limited to 'src/Crypto')
-rw-r--r--src/Crypto/Macaroon.hs31
-rw-r--r--src/Crypto/Macaroon/Binder.hs2
-rw-r--r--src/Crypto/Macaroon/Internal.hs33
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
8Stability : experimental 8Stability : experimental
9Portability : portable 9Portability : portable
10 10
11
12Pure haskell implementations of macaroons. 11Pure haskell implementations of macaroons.
13 12
14Warning: this implementation has not been audited by security experts. 13Warning: this implementation has not been audited by security experts.
15Use it with caution. 14Do not use in production
16 15
17 16
18References: 17References:
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-}
24module Crypto.Macaroon ( 22module Crypto.Macaroon (
25 -- * Types 23 -- * Types
@@ -50,11 +48,14 @@ module Crypto.Macaroon (
50 48
51import Crypto.Cipher.AES 49import Crypto.Cipher.AES
52import Crypto.Hash 50import Crypto.Hash
51import Data.Char
53import Data.Byteable 52import Data.Byteable
54import qualified Data.ByteString as BS 53import qualified Data.ByteString as BS
55import qualified Data.ByteString.Base64.URL as B64 54import qualified Data.ByteString.Base64.URL as B64
56import qualified Data.ByteString.Char8 as B8 55import qualified Data.ByteString.Char8 as B8
57import Data.Hex 56import Data.Hex
57import Data.Word
58import Data.Serialize
58 59
59import Crypto.Macaroon.Internal 60import Crypto.Macaroon.Internal
60 61
@@ -62,7 +63,7 @@ import Crypto.Macaroon.Internal
62create :: Key -> Key -> Location -> Macaroon 63create :: Key -> Key -> Location -> Macaroon
63create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256)) 64create 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
67caveatLoc :: Caveat -> Location 68caveatLoc :: Caveat -> Location
68caveatLoc = cl 69caveatLoc = cl
@@ -74,17 +75,7 @@ caveatVId :: Caveat -> Key
74caveatVId = vid 75caveatVId = vid
75 76
76inspect :: Macaroon -> String 77inspect :: Macaroon -> String
77inspect m = unlines [ "location " ++ show (location m) 78inspect = 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
89serialize :: Macaroon -> BS.ByteString 80serialize :: Macaroon -> BS.ByteString
90serialize m = B8.filter (/= '=') . B64.encode $ packets 81serialize 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
26hashSigs :: Binder 26hashSigs :: Binder
27hashSigs = Binder $ \m m' -> toBytes $ (HMAC . hash $ BS.append (toBytes $ signature m') (toBytes $ signature m) :: HMAC SHA256) 27hashSigs = 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
21import qualified Data.ByteString as BS 21import qualified Data.ByteString as BS
22import qualified Data.ByteString.Base64 as B64 22import qualified Data.ByteString.Base64 as B64
23import qualified Data.ByteString.Char8 as B8 23import qualified Data.ByteString.Char8 as B8
24import Data.Char
25import Data.Hex 24import Data.Hex
26import Data.Serialize 25import Data.List
27import Data.Word
28 26
29-- |Type alias for Macaroons and Caveat keys and identifiers 27-- |Type alias for Macaroons and Caveat keys and identifiers
30type Key = BS.ByteString 28type 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
46instance 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
49instance NFData Macaroon where 55instance 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
69instance 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
63instance NFData Caveat where 77instance 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
67putPacket :: BS.ByteString -> BS.ByteString -> BS.ByteString
68putPacket 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
78addCaveat :: Location 81addCaveat :: 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