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     , Sig
  29     -- * Accessing functions
  30     -- ** Macaroons
  31     , location
  32     , identifier
  33     , caveats
  34     , signature
  35     -- ** Caveats
  36     , caveatLoc
  37     , caveatId
  38     , caveatVId
  39
  40     -- * Create Macaroons
  41     , create
  42     , inspect
  43     , addFirstPartyCaveat
  44     , addThirdPartyCaveat
  45
  46     -- * Prepare Macaroons for transfer
  47     , serialize
  48     ) where
  49
  50 import           Crypto.Cipher.AES
  51 import           Crypto.Hash
  52 import           Data.Char
  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 import           Data.Word
  59 import           Data.Serialize
  60
  61 import           Crypto.Macaroon.Internal
  62
  63 -- | Create a Macaroon from its key, identifier and location
  64 create :: Key -> Key -> Location -> Macaroon
  65 create secret ident loc = MkMacaroon loc ident [] (toBytes (hmac derivedKey ident :: HMAC SHA256))
  66   where
  67     derivedKey = toBytes (hmac "macaroons-key-generator" secret :: HMAC SHA256)
  68
  69 -- | Caveat target location
  70 caveatLoc :: Caveat -> Location
  71 caveatLoc = cl
  72
  73 -- | Caveat identifier
  74 caveatId :: Caveat -> Key
  75 caveatId = cid
  76
  77 -- | Caveat verification identifier
  78 caveatVId :: Caveat -> Key
  79 caveatVId = vid
  80
  81 -- | Inspect a macaroon's contents. For debugging purposes.
  82 inspect :: Macaroon -> String
  83 inspect = show
  84
  85 -- | Serialize a macaroon in an URL-safe Base64 encoding
  86 serialize :: Macaroon -> BS.ByteString
  87 serialize 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
 114 addFirstPartyCaveat :: Key -> Macaroon -> Macaroon
 115 addFirstPartyCaveat ident m = addCaveat (location m) ident BS.empty m
 116
 117 -- |Add a third party Caveat to a Macaroon, using its location, identifier and
 118 -- verification key
 119 addThirdPartyCaveat :: Key
 120                     -> Key
 121                     -> Location
 122                     -> Macaroon
 123                     -> Macaroon
 124 addThirdPartyCaveat key cid loc m = addCaveat loc cid vid m
 125   where
 126     vid = encryptECB (initAES (signature m)) key
 127
 128