aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Crypto
diff options
context:
space:
mode:
authorJulien Tanguy <julien.tanguy@jhome.fr>2015-04-14 17:40:08 +0200
committerJulien Tanguy <julien.tanguy@jhome.fr>2015-04-14 17:40:08 +0200
commita20c77f85bcbc74b70c108f440435c70b29ab822 (patch)
tree34f0ca81908496939b3010d376be589c09ddfb5d /src/Crypto
parentb44d2aa13fc1172e4bda303e7d177389e22d3f95 (diff)
downloadhmacaroons-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.hs35
-rw-r--r--src/Crypto/Macaroon/Serializer/Base64.hs85
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
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