Initial commit

1 files changed, 121 insertions, 0 deletions

diff --git a/src/Crypto/Macaroon.hs b/src/Crypto/Macaroon.hs
new file mode 100644
index 0000000..819a9eb
--- /dev/null
+++ b/src/Crypto/Macaroon.hs
@@ -0,0 +1,121 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-|
+Module      : Crypto.Macaroon
+Copyright   : (c) 2015 Julien Tanguy
+License     : BSD3
+
+Maintainer  : julien.tanguy@jhome.fr
+Stability   : experimental
+Portability : portable
+
+
+Pure haskell implementations of macaroons.
+
+Warning: this implementation has not been audited by security experts.
+Use it with caution.
+
+
+References:
+
+- Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html>
+- Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex>
+
+-}
+module Crypto.Macaroon (
+    -- * Types
+      Macaroon
+    , Caveat
+    , Key
+    , Location
+    -- * Accessing functions
+    -- ** Macaroons
+    , location
+    , identifier
+    , caveats
+    , signature
+    -- ** Caveats
+    , caveatLoc
+    , caveatId
+    , caveatVId
+
+    -- * Create Macaroons
+    , create
+    , inspect
+    , addFirstPartyCaveat
+    , addThirdPartyCaveat
+
+    -- * Prepare Macaroons for transfer
+    , serialize
+    ) where
+
+import           Crypto.Cipher.AES
+import           Crypto.Hash
+import           Data.Byteable
+import qualified Data.ByteString            as BS
+import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.ByteString.Char8      as B8
+import           Data.Hex
+
+import           Crypto.Macaroon.Internal
+
+-- | Create a Macaroon from its key, identifier and location
+create :: Key -> Key -> Location -> Macaroon
+create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256))
+  where
+    derivedKey = toBytes $ (hmac "macaroons-key-generator" secret :: HMAC SHA256)
+
+caveatLoc :: Caveat -> Location
+caveatLoc = cl
+
+caveatId :: Caveat -> Key
+caveatId = cid
+
+caveatVId :: Caveat -> Key
+caveatVId = vid
+
+inspect :: Macaroon -> String
+inspect m = unlines [ "location " ++ show (location m)
+                    , "identifier " ++ show (identifier m)
+                    , (concatMap (showCav (location m)) (caveats m))
+                    , "signature " ++ show (hex $ signature m)
+                    ]
+  where
+    showCav loc c | cl c == loc && vid c == BS.empty = "cid " ++ show (cid c)
+                  | otherwise = unlines [ "cid " ++ show (cid c)
+                                        , "vid " ++ show (vid c)
+                                        , "cl " ++ show (cl c)
+                                        ]
+
+serialize :: Macaroon -> BS.ByteString
+serialize m = B8.filter (/= '=') . B64.encode $ packets
+  where
+    packets = BS.concat [ putPacket "location" (location m)
+                        , putPacket "identifier" (identifier m)
+                        , caveatPackets
+                        , putPacket "signature" (signature m)
+                        ]
+    caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m)
+    cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c)
+                    | otherwise = BS.concat [ putPacket "cid" (cid c)
+                                            , putPacket "vid" (vid c)
+                                            , putPacket "cl" (cl c)
+                                            ]
+
+
+
+-- | Add a first party Caveat to a Macaroon, with its identifier
+addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
+addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
+
+-- |Add a third party Caveat to a Macaroon, using its location, identifier and
+-- verification key
+addThirdPartyCaveat :: Key
+                    -> Key
+                    -> Location
+                    -> Macaroon
+                    -> Macaroon
+addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m
+  where
+    vid = encryptECB (initAES (signature m)) key
+
+