aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--hmacaroons.cabal4
-rw-r--r--src/Crypto/Macaroon.hs35
-rw-r--r--src/Crypto/Macaroon/Serializer/Base64.hs85
-rw-r--r--test/Crypto/Macaroon/Tests.hs48
4 files changed, 127 insertions, 45 deletions
diff --git a/hmacaroons.cabal b/hmacaroons.cabal
index a9f6ea5..9733a18 100644
--- a/hmacaroons.cabal
+++ b/hmacaroons.cabal
@@ -15,9 +15,11 @@ cabal-version: >=1.10
15library 15library
16 exposed-modules: Crypto.Macaroon, 16 exposed-modules: Crypto.Macaroon,
17 Crypto.Macaroon.Binder 17 Crypto.Macaroon.Binder
18 Crypto.Macaroon.Serializer.Base64
18 other-modules: Crypto.Macaroon.Internal 19 other-modules: Crypto.Macaroon.Internal
19 -- other-extensions: 20 -- other-extensions:
20 build-depends: base >=4 && < 5, 21 build-depends: base >=4 && < 5,
22 attoparsec >=0.12,
21 bytestring >=0.10, 23 bytestring >=0.10,
22 base64-bytestring >= 1.0, 24 base64-bytestring >= 1.0,
23 byteable >= 0.1 && <0.2, 25 byteable >= 0.1 && <0.2,
@@ -36,6 +38,7 @@ benchmark bench
36 main-is: bench.hs 38 main-is: bench.hs
37 ghc-options: -O2 39 ghc-options: -O2
38 build-depends: base >= 4 && <5, 40 build-depends: base >= 4 && <5,
41 attoparsec >=0.12,
39 bytestring >=0.10, 42 bytestring >=0.10,
40 base64-bytestring >= 1.0, 43 base64-bytestring >= 1.0,
41 cereal >= 0.4, 44 cereal >= 0.4,
@@ -52,6 +55,7 @@ test-suite test
52 hs-source-dirs: test 55 hs-source-dirs: test
53 main-is: tests.hs 56 main-is: tests.hs
54 build-depends: base >= 4 && <5, 57 build-depends: base >= 4 && <5,
58 attoparsec >=0.12,
55 bytestring >=0.10, 59 bytestring >=0.10,
56 base64-bytestring >= 1.0, 60 base64-bytestring >= 1.0,
57 byteable >= 0.1 && <0.2, 61 byteable >= 0.1 && <0.2,
diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs
index 07043f7..36aecf9 100644
--- a/src/Crypto/Macaroon.hs
+++ b/src/Crypto/Macaroon.hs
@@ -42,21 +42,14 @@ module Crypto.Macaroon (
42 , inspect 42 , inspect
43 , addFirstPartyCaveat 43 , addFirstPartyCaveat
44 , addThirdPartyCaveat 44 , addThirdPartyCaveat
45
46 -- * Prepare Macaroons for transfer
47 , serialize
48 ) where 45 ) where
49 46
50import Crypto.Cipher.AES 47import Crypto.Cipher.AES
51import Crypto.Hash 48import Crypto.Hash
52import Data.Char
53import Data.Byteable 49import Data.Byteable
54import qualified Data.ByteString as BS 50import qualified Data.ByteString as BS
55import qualified Data.ByteString.Base64.URL as B64 51import qualified Data.ByteString.Base64.URL as B64
56import qualified Data.ByteString.Char8 as B8 52import qualified Data.ByteString.Char8 as B8
57import Data.Hex
58import Data.Word
59import Data.Serialize
60 53
61import Crypto.Macaroon.Internal 54import Crypto.Macaroon.Internal
62 55
@@ -82,34 +75,6 @@ caveatVId = vid
82inspect :: Macaroon -> String 75inspect :: Macaroon -> String
83inspect = show 76inspect = show
84 77
85-- | Serialize a macaroon in an URL-safe Base64 encoding
86serialize :: Macaroon -> BS.ByteString
87serialize m = B8.filter (/= '=') . B64.encode $ packets
88 where
89 packets = BS.concat [ putPacket "location" (location m)
90 , putPacket "identifier" (identifier m)
91 , caveatPackets
92 , putPacket "signature" (signature m)
93 ]
94 caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m)
95 cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c)
96 | otherwise = BS.concat [ putPacket "cid" (cid c)
97 , putPacket "vid" (vid c)
98 , putPacket "cl" (cl c)
99 ]
100 putPacket key dat = BS.concat [
101 B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
102 , key
103 , " "
104 , dat
105 , "\n"
106 ]
107 where
108 size = 4 + 2 + BS.length key + BS.length dat
109
110
111
112
113-- | Add a first party Caveat to a Macaroon, with its identifier 78-- | Add a first party Caveat to a Macaroon, with its identifier
114addFirstPartyCaveat :: Key -> Macaroon -> Macaroon 79addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
115addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m 80addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
diff --git a/src/Crypto/Macaroon/Serializer/Base64.hs b/src/Crypto/Macaroon/Serializer/Base64.hs
new file mode 100644
index 0000000..6fc8fcb
--- /dev/null
+++ b/src/Crypto/Macaroon/Serializer/Base64.hs
@@ -0,0 +1,85 @@
1{-# LANGUAGE OverloadedStrings #-}
2{-|
3Module : Crypto.Macaroon.Serializer.Base64
4Copyright : (c) 2015 Julien Tanguy
5License : BSD3
6
7Maintainer : julien.tanguy@jhome.fr
8Stability : experimental
9Portability : portable
10
11Base64 serializer/deserializer
12
13-}
14module Crypto.Macaroon.Serializer.Base64 (
15 serialize
16 , deserialize
17 ) where
18
19import Control.Applicative
20import Control.Monad
21import qualified Data.ByteString as BS
22import qualified Data.ByteString.Base64.URL as B64
23import qualified Data.ByteString.Char8 as B8
24import Data.Attoparsec.ByteString
25import qualified Data.Attoparsec.ByteString.Char8 as A8
26import Data.Bits
27import Data.Char
28import Data.Hex
29import Data.Int
30import Data.List
31import Data.Maybe
32import Data.Word
33import Data.Serialize
34import Crypto.Macaroon.Internal
35
36
37-- | Serialize a macaroon in an URL-safe Base64 encoding
38serialize :: Macaroon -> BS.ByteString
39serialize m = B8.filter (/= '=') . B64.encode . runPut $ do
40 packetize "location" (location m)
41 packetize "identifier" (identifier m)
42 forM_ (caveats m) $ \c -> do
43 packetize "cid" (cid c)
44 unless (cl c == location m && vid c == BS.empty) $ do
45 packetize "vid" (vid c)
46 packetize "cl" (cl c)
47 packetize "signature" (signature m)
48
49packetize :: BS.ByteString -> BS.ByteString -> Put
50packetize key dat = do
51 let size = 4 + 2 + BS.length key + BS.length dat
52 putByteString $ B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
53 putByteString key
54 putByteString " "
55 putByteString dat
56 putByteString "\n"
57
58deserialize :: BS.ByteString -> Either String Macaroon
59deserialize = parseOnly macaroon . B64.decodeLenient
60
61
62macaroon :: Parser Macaroon
63macaroon = do
64 ps <- many packet <* endOfInput
65 let ([("location",l),("identifier",i)],ps') = splitAt 2 ps
66 let (caveats,sig) = splitAt (length ps' - 1) ps'
67 let [("signature",s)] = sig
68 return $ MkMacaroon l i (map (mkCaveat l) (groupBy splitCavs caveats)) s
69 where
70 mkCaveat _ [("cid",c),("vid",v),("cl",l)] = MkCaveat c v l
71 mkCaveat l [("cid",c)] = MkCaveat c BS.empty l
72 mkCaveat _ _ = error "Malformed caveat"
73 splitCavs _ ("cid",_) = False
74 splitCavs _ _ = True
75
76packet :: Parser (BS.ByteString, BS.ByteString)
77packet = do
78 size <- A8.take 4
79 case A8.parseOnly (A8.hexadecimal :: Parser Word16) size of
80 Left e -> fail e
81 Right s -> do
82 bs <- A8.take (fromIntegral $ s - 4)
83 let (key, dat) = B8.break (== ' ') bs
84 return (key, B8.tail $ B8.init dat)
85
diff --git a/test/Crypto/Macaroon/Tests.hs b/test/Crypto/Macaroon/Tests.hs
index f57bec3..6fa6504 100644
--- a/test/Crypto/Macaroon/Tests.hs
+++ b/test/Crypto/Macaroon/Tests.hs
@@ -18,13 +18,13 @@ import Test.Tasty
18import Test.Tasty.HUnit 18import Test.Tasty.HUnit
19 19
20import Crypto.Macaroon 20import Crypto.Macaroon
21import Crypto.Macaroon.Serializer.Base64
21 22
22tests :: TestTree 23tests :: TestTree
23tests = testGroup "Crypto.Macaroon" [ basicSignature 24tests = testGroup "Crypto.Macaroon" [ basic
24 , basicSerialize 25 , minted
25 , basicMint 26 , minted2
26 , basicInspect 27 , minted3
27 , basicMintTrimmed
28 ] 28 ]
29 29
30 30
@@ -35,7 +35,13 @@ m = create secret key loc
35 key = B8.pack "we used our secret key" 35 key = B8.pack "we used our secret key"
36 loc = B8.pack "http://mybank/" 36 loc = B8.pack "http://mybank/"
37 37
38basicSignature = testCase "Basic signature" $ 38basic :: TestTree
39basic = testGroup "Basic macaroon" [ basicSignature
40 , basicSerialize
41 , basicDeserialize
42 ]
43
44basicSignature = testCase "Signature" $
39 "E3D9E02908526C4C0039AE15114115D97FDD68BF2BA379B342AAF0F617D0552F" @=? (hex . signature) m 45 "E3D9E02908526C4C0039AE15114115D97FDD68BF2BA379B342AAF0F617D0552F" @=? (hex . signature) m
40 46
41basicSerialize = testCase "Serialization" $ 47basicSerialize = testCase "Serialization" $
@@ -43,30 +49,49 @@ basicSerialize = testCase "Serialization" $
43 \lmaWVyIHdlIHVzZWQgb3VyIHNlY3JldCBrZXkKMDAyZnNpZ25h\ 49 \lmaWVyIHdlIHVzZWQgb3VyIHNlY3JldCBrZXkKMDAyZnNpZ25h\
44 \dHVyZSDj2eApCFJsTAA5rhURQRXZf91ovyujebNCqvD2F9BVLwo" @=? serialize m 50 \dHVyZSDj2eApCFJsTAA5rhURQRXZf91ovyujebNCqvD2F9BVLwo" @=? serialize m
45 51
52basicDeserialize = testCase "Deserialization" $
53 Right m @=? (deserialize . serialize) m
54
46m2 :: Macaroon 55m2 :: Macaroon
47m2 = addFirstPartyCaveat "test = caveat" m 56m2 = addFirstPartyCaveat "test = caveat" m
48 57
49basicInspect = testCase "Inspect" $ 58minted :: TestTree
59minted = testGroup "Macaroon with first party caveat" [ mintInspect
60 , mintSerialize
61 , mintDeserialize
62 ]
63
64mintInspect = testCase "Inspect" $
50 "location http://mybank/\nidentifier we used\ 65 "location http://mybank/\nidentifier we used\
51 \ our secret key\ncid test = caveat\nsignature\ 66 \ our secret key\ncid test = caveat\nsignature\
52 \ 197BAC7A044AF33332865B9266E26D49\ 67 \ 197BAC7A044AF33332865B9266E26D49\
53 \3BDD668A660E44D88CE1A998C23DBD67" @=? inspect m2 68 \3BDD668A660E44D88CE1A998C23DBD67" @=? inspect m2
54 69
55 70
56basicMint = testCase "First Party Caveat" $ 71mintSerialize = testCase "Serialization" $
57 "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVzZ\ 72 "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVzZ\
58 \WQgb3VyIHNlY3JldCBrZXkKMDAxNmNpZCB0ZXN0ID0gY2F2ZWF0CjAwMmZzaWduYXR1cmUgGXusegR\ 73 \WQgb3VyIHNlY3JldCBrZXkKMDAxNmNpZCB0ZXN0ID0gY2F2ZWF0CjAwMmZzaWduYXR1cmUgGXusegR\
59 \K8zMyhluSZuJtSTvdZopmDkTYjOGpmMI9vWcK" @=? serialize m2 74 \K8zMyhluSZuJtSTvdZopmDkTYjOGpmMI9vWcK" @=? serialize m2
60 75
76mintDeserialize = testCase "Deserialization" $
77 Right m2 @=? (deserialize . serialize) m2
78
61 79
62m3 :: Macaroon 80m3 :: Macaroon
63m3 = addFirstPartyCaveat "test = acaveat" m 81m3 = addFirstPartyCaveat "test = acaveat" m
64 82
65basicMintTrimmed = testCase "Trimmed base64" $ 83minted2 :: TestTree
84minted2 = testGroup "Macaroon with first party caveats" [ mint2Trimmed
85 , mint2Des
86 ]
87
88mint2Trimmed = testCase "Serialization" $
66 "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVz\ 89 "MDAxY2xvY2F0aW9uIGh0dHA6Ly9teWJhbmsvCjAwMjZpZGVudGlmaWVyIHdlIHVz\
67 \ZWQgb3VyIHNlY3JldCBrZXkKMDAxN2NpZCB0ZXN0ID0gYWNhdmVhdAowMDJmc2ln\ 90 \ZWQgb3VyIHNlY3JldCBrZXkKMDAxN2NpZCB0ZXN0ID0gYWNhdmVhdAowMDJmc2ln\
68 \bmF0dXJlIJRJ_V3WNJQnqlVq5eez7spnltwU_AXs8NIRY739sHooCg" @=? serialize m3 91 \bmF0dXJlIJRJ_V3WNJQnqlVq5eez7spnltwU_AXs8NIRY739sHooCg" @=? serialize m3
69 92
93mint2Des = testCase "Deserialization" $
94 Right m3 @=? (deserialize . serialize) m3
70 95
71m4 :: Macaroon 96m4 :: Macaroon
72m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n 97m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n
@@ -79,6 +104,9 @@ m4 = addThirdPartyCaveat caveat_key caveat_id caveat_loc n
79 caveat_id = B8.pack "this was how we remind auth of key/pred" 104 caveat_id = B8.pack "this was how we remind auth of key/pred"
80 caveat_loc = B8.pack "http://auth.mybank/" 105 caveat_loc = B8.pack "http://auth.mybank/"
81 106
107minted3 :: TestTree
108minted3 = testGroup "Macaroon with first and third party caveats" [ mint3sig ]
109
82 110
83basicThirdParty = testCase "Third Party Caveat" $ 111mint3sig = testCase "Signature" $
84 "6B99EDB2EC6D7A4382071D7D41A0BF7DFA27D87D2F9FEA86E330D7850FFDA2B2" @=? (hex . signature) m4 112 "6B99EDB2EC6D7A4382071D7D41A0BF7DFA27D87D2F9FEA86E330D7850FFDA2B2" @=? (hex . signature) m4
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 16:36:32 +0000