diff options
author | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-04-14 17:40:08 +0200 |
---|---|---|
committer | Julien Tanguy <julien.tanguy@jhome.fr> | 2015-04-14 17:40:08 +0200 |
commit | a20c77f85bcbc74b70c108f440435c70b29ab822 (patch) | |
tree | 34f0ca81908496939b3010d376be589c09ddfb5d /src/Crypto | |
parent | b44d2aa13fc1172e4bda303e7d177389e22d3f95 (diff) | |
download | hmacaroons-a20c77f85bcbc74b70c108f440435c70b29ab822.tar.gz hmacaroons-a20c77f85bcbc74b70c108f440435c70b29ab822.tar.zst hmacaroons-a20c77f85bcbc74b70c108f440435c70b29ab822.zip |
Deserialize Macaroons
- Refactor serialization/deserialization into its own module
- Refactor tests
Diffstat (limited to 'src/Crypto')
-rw-r--r-- | src/Crypto/Macaroon.hs | 35 | ||||
-rw-r--r-- | src/Crypto/Macaroon/Serializer/Base64.hs | 85 |
2 files changed, 85 insertions, 35 deletions
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 | ||
50 | import Crypto.Cipher.AES | 47 | import Crypto.Cipher.AES |
51 | import Crypto.Hash | 48 | import Crypto.Hash |
52 | import Data.Char | ||
53 | import Data.Byteable | 49 | import Data.Byteable |
54 | import qualified Data.ByteString as BS | 50 | import qualified Data.ByteString as BS |
55 | import qualified Data.ByteString.Base64.URL as B64 | 51 | import qualified Data.ByteString.Base64.URL as B64 |
56 | import qualified Data.ByteString.Char8 as B8 | 52 | import qualified Data.ByteString.Char8 as B8 |
57 | import Data.Hex | ||
58 | import Data.Word | ||
59 | import Data.Serialize | ||
60 | 53 | ||
61 | import Crypto.Macaroon.Internal | 54 | import Crypto.Macaroon.Internal |
62 | 55 | ||
@@ -82,34 +75,6 @@ caveatVId = vid | |||
82 | inspect :: Macaroon -> String | 75 | inspect :: Macaroon -> String |
83 | inspect = show | 76 | inspect = show |
84 | 77 | ||
85 | -- | Serialize a macaroon in an URL-safe Base64 encoding | ||
86 | serialize :: Macaroon -> BS.ByteString | ||
87 | serialize 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 |
114 | addFirstPartyCaveat :: Key -> Macaroon -> Macaroon | 79 | addFirstPartyCaveat :: Key -> Macaroon -> Macaroon |
115 | addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m | 80 | addFirstPartyCaveat 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 | {-| | ||
3 | Module : Crypto.Macaroon.Serializer.Base64 | ||
4 | Copyright : (c) 2015 Julien Tanguy | ||
5 | License : BSD3 | ||
6 | |||
7 | Maintainer : julien.tanguy@jhome.fr | ||
8 | Stability : experimental | ||
9 | Portability : portable | ||
10 | |||
11 | Base64 serializer/deserializer | ||
12 | |||
13 | -} | ||
14 | module Crypto.Macaroon.Serializer.Base64 ( | ||
15 | serialize | ||
16 | , deserialize | ||
17 | ) where | ||
18 | |||
19 | import Control.Applicative | ||
20 | import Control.Monad | ||
21 | import qualified Data.ByteString as BS | ||
22 | import qualified Data.ByteString.Base64.URL as B64 | ||
23 | import qualified Data.ByteString.Char8 as B8 | ||
24 | import Data.Attoparsec.ByteString | ||
25 | import qualified Data.Attoparsec.ByteString.Char8 as A8 | ||
26 | import Data.Bits | ||
27 | import Data.Char | ||
28 | import Data.Hex | ||
29 | import Data.Int | ||
30 | import Data.List | ||
31 | import Data.Maybe | ||
32 | import Data.Word | ||
33 | import Data.Serialize | ||
34 | import Crypto.Macaroon.Internal | ||
35 | |||
36 | |||
37 | -- | Serialize a macaroon in an URL-safe Base64 encoding | ||
38 | serialize :: Macaroon -> BS.ByteString | ||
39 | serialize 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 | |||
49 | packetize :: BS.ByteString -> BS.ByteString -> Put | ||
50 | packetize 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 | |||
58 | deserialize :: BS.ByteString -> Either String Macaroon | ||
59 | deserialize = parseOnly macaroon . B64.decodeLenient | ||
60 | |||
61 | |||
62 | macaroon :: Parser Macaroon | ||
63 | macaroon = 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 | |||
76 | packet :: Parser (BS.ByteString, BS.ByteString) | ||
77 | packet = 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 | |||