From f678145637ba6f42c36d07c19f8c764e5d537f72 Mon Sep 17 00:00:00 2001 From: Julien Tanguy Date: Thu, 9 Apr 2015 01:12:36 +0200 Subject: Initial commit --- src/Crypto/Macaroon.hs | 121 ++++++++++++++++++++++++++++++++++++++++ src/Crypto/Macaroon/Binder.hs | 28 ++++++++++ src/Crypto/Macaroon/Internal.hs | 88 +++++++++++++++++++++++++++++ 3 files changed, 237 insertions(+) create mode 100644 src/Crypto/Macaroon.hs create mode 100644 src/Crypto/Macaroon/Binder.hs create mode 100644 src/Crypto/Macaroon/Internal.hs (limited to 'src') 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 +- Time for better security in NoSQL + +-} +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 + + diff --git a/src/Crypto/Macaroon/Binder.hs b/src/Crypto/Macaroon/Binder.hs new file mode 100644 index 0000000..3ec3d67 --- /dev/null +++ b/src/Crypto/Macaroon/Binder.hs @@ -0,0 +1,28 @@ +{-| +Module : Crypto.Macaroon.Binder +Copyright : (c) 2015 Julien Tanguy +License : BSD3 + +Maintainer : julien.tanguy@jhome.fr +Stability : experimental +Portability : portable + + + +-} +module Crypto.Macaroon.Binder where + +import Crypto.Hash +import Data.Byteable +import qualified Data.ByteString as BS + +import Crypto.Macaroon.Internal + +-- | Datatype for binding discharging and authorizing macaroons together +newtype Binder = Binder { bind :: Macaroon -> Macaroon -> BS.ByteString } + + +-- | Binder which concatenates the two signatures and hashes them +hashSigs :: Binder +hashSigs = Binder $ \m m' -> toBytes $ (HMAC . hash $ BS.append (toBytes $ signature m') (toBytes $ signature m) :: HMAC SHA256) + diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs new file mode 100644 index 0000000..fc50486 --- /dev/null +++ b/src/Crypto/Macaroon/Internal.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Crypto.Macaroon.Internal +Copyright : (c) 2015 Julien Tanguy +License : BSD3 + +Maintainer : julien.tanguy@jhome.fr +Stability : experimental +Portability : portable + + +Internal representation of a macaroon +-} +module Crypto.Macaroon.Internal where + + +import Control.DeepSeq +import Crypto.Cipher.AES +import Crypto.Hash +import Data.Byteable +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as B8 +import Data.Char +import Data.Hex +import Data.Serialize +import Data.Word + +-- |Type alias for Macaroons and Caveat keys and identifiers +type Key = BS.ByteString + +-- |Type alias For Macaroons and Caveat locations +type Location = BS.ByteString + +type Sig = BS.ByteString + +-- | Main structure of a macaroon +data Macaroon = MkMacaroon { location :: Location + -- ^ Target location + , identifier :: Key + -- ^ Macaroon Identifier + , caveats :: [Caveat] + -- ^ List of caveats + , signature :: Sig + -- ^ Macaroon HMAC signature + } deriving (Eq) + + +instance NFData Macaroon where + rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig + + +-- | Caveat structure +data Caveat = MkCaveat { cid :: Key + -- ^ Caveat identifier + , vid :: Key + -- ^ Caveat verification key identifier + , cl :: Location + -- ^ Caveat target location + + } deriving (Eq) + +instance NFData Caveat where + rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl + + +putPacket :: BS.ByteString -> BS.ByteString -> BS.ByteString +putPacket key dat = BS.concat [ + B8.map toLower . hex . encode $ (fromIntegral size :: Word16) + , key + , " " + , dat + , "\n" + ] + where + size = 4 + 2 + BS.length key + BS.length dat + +addCaveat :: Location + -> Key + -> Key + -> Macaroon + -> Macaroon +addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig} + where + cavs = caveats m + cav' = MkCaveat cid vid loc + sig = toBytes $ (hmac (signature m) (BS.append vid cid) :: HMAC SHA256) + -- cgit v1.2.3