diff options
Diffstat (limited to 'src/Crypto/Macaroon/Internal.hs')
-rw-r--r-- | src/Crypto/Macaroon/Internal.hs | 33 |
1 files changed, 18 insertions, 15 deletions
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 | ||