aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Crypto/Macaroon.hs
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/Macaroon.hs
parentf678145637ba6f42c36d07c19f8c764e5d537f72 (diff)
downloadhmacaroons-2aede11ad7e5addd50cd4e3c202e094319e942f2.tar.gz
hmacaroons-2aede11ad7e5addd50cd4e3c202e094319e942f2.tar.zst
hmacaroons-2aede11ad7e5addd50cd4e3c202e094319e942f2.zip
Rewording and lint
Diffstat (limited to 'src/Crypto/Macaroon.hs')
-rw-r--r--src/Crypto/Macaroon.hs31
1 files changed, 16 insertions, 15 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