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