src/Crypto/Macaroon.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-|
   3 Module      : Crypto.Macaroon
   4 Copyright   : (c) 2015 Julien Tanguy
   5 License     : BSD3
   6
   7 Maintainer  : julien.tanguy@jhome.fr
   8 Stability   : experimental
   9 Portability : portable
  10
  11
  12 Pure haskell implementations of macaroons.
  13
  14 Warning: this implementation has not been audited by security experts.
  15 Use it with caution.
  16
  17
  18 References:
  19
  20 - Macaroons: Cookies with Contextual Caveats for Decentralized Authorization in the Cloud <http://research.google.com/pubs/pub41892.html>
  21 - Time for better security in NoSQL <http://hackingdistributed.com/2014/11/23/macaroons-in-hyperdex>
  22
  23 -}
  24 module Crypto.Macaroon (
  25     -- * Types
  26       Macaroon
  27     , Caveat
  28     , Key
  29     , Location
  30     -- * Accessing functions
  31     -- ** Macaroons
  32     , location
  33     , identifier
  34     , caveats
  35     , signature
  36     -- ** Caveats
  37     , caveatLoc
  38     , caveatId
  39     , caveatVId
  40
  41     -- * Create Macaroons
  42     , create
  43     , inspect
  44     , addFirstPartyCaveat
  45     , addThirdPartyCaveat
  46
  47     -- * Prepare Macaroons for transfer
  48     , serialize
  49     ) where
  50
  51 import           Crypto.Cipher.AES
  52 import           Crypto.Hash
  53 import           Data.Byteable
  54 import qualified Data.ByteString            as BS
  55 import qualified Data.ByteString.Base64.URL as B64
  56 import qualified Data.ByteString.Char8      as B8
  57 import           Data.Hex
  58
  59 import           Crypto.Macaroon.Internal
  60
  61 -- | Create a Macaroon from its key, identifier and location
  62 create :: Key -> Key -> Location -> Macaroon
  63 create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256))
  64   where
  65     derivedKey = toBytes $ (hmac "macaroons-key-generator" secret :: HMAC SHA256)
  66
  67 caveatLoc :: Caveat -> Location
  68 caveatLoc = cl
  69
  70 caveatId :: Caveat -> Key
  71 caveatId = cid
  72
  73 caveatVId :: Caveat -> Key
  74 caveatVId = vid
  75
  76 inspect :: Macaroon -> String
  77 inspect m = unlines [ "location " ++ show (location m)
  78                     , "identifier " ++ show (identifier m)
  79                     , (concatMap (showCav (location m)) (caveats m))
  80                     , "signature " ++ show (hex $ signature m)
  81                     ]
  82   where
  83     showCav loc c | cl c == loc && vid c == BS.empty = "cid " ++ show (cid c)
  84                   | otherwise = unlines [ "cid " ++ show (cid c)
  85                                         , "vid " ++ show (vid c)
  86                                         , "cl " ++ show (cl c)
  87                                         ]
  88
  89 serialize :: Macaroon -> BS.ByteString
  90 serialize m = B8.filter (/= '=') . B64.encode $ packets
  91   where
  92     packets = BS.concat [ putPacket "location" (location m)
  93                         , putPacket "identifier" (identifier m)
  94                         , caveatPackets
  95                         , putPacket "signature" (signature m)
  96                         ]
  97     caveatPackets = BS.concat $ map (cavPacket (location m)) (caveats m)
  98     cavPacket loc c | cl c == loc && vid c == BS.empty = putPacket "cid" (cid c)
  99                     | otherwise = BS.concat [ putPacket "cid" (cid c)
 100                                             , putPacket "vid" (vid c)
 101                                             , putPacket "cl" (cl c)
 102                                             ]
 103
 104
 105
 106 -- | Add a first party Caveat to a Macaroon, with its identifier
 107 addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
 108 addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
 109
 110 -- |Add a third party Caveat to a Macaroon, using its location, identifier and
 111 -- verification key
 112 addThirdPartyCaveat :: Key
 113                     -> Key
 114                     -> Location
 115                     -> Macaroon
 116                     -> Macaroon
 117 addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m
 118   where
 119     vid = encryptECB (initAES (signature m)) key
 120
 121