src/Crypto/Macaroon/Internal.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-|
   3 Module      : Crypto.Macaroon.Internal
   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 Internal representation of a macaroon
  13 -}
  14 module Crypto.Macaroon.Internal where
  15
  16
  17 import           Control.DeepSeq
  18 import           Crypto.Cipher.AES
  19 import           Crypto.Hash
  20 import           Data.Byteable
  21 import qualified Data.ByteString        as BS
  22 import qualified Data.ByteString.Base64 as B64
  23 import qualified Data.ByteString.Char8  as B8
  24 import           Data.Hex
  25 import           Data.List
  26
  27 -- |Type alias for Macaroons and Caveat keys and identifiers
  28 type Key = BS.ByteString
  29
  30 -- |Type alias For Macaroons and Caveat locations
  31 type Location = BS.ByteString
  32
  33 type Sig = BS.ByteString
  34
  35 -- | Main structure of a macaroon
  36 data Macaroon = MkMacaroon { location   :: Location
  37                            -- ^ Target location
  38                            , identifier :: Key
  39                            -- ^ Macaroon Identifier
  40                            , caveats    :: [Caveat]
  41                            -- ^ List of caveats
  42                            , signature  :: Sig
  43                            -- ^ Macaroon HMAC signature
  44                            } deriving (Eq)
  45
  46 instance Show Macaroon where
  47     -- We use intercalate because unlines would add a trailing newline
  48     show (MkMacaroon l i c s) = intercalate "\n" [
  49                       "location " ++ B8.unpack l
  50                     , "identifier " ++ B8.unpack i
  51                     , concatMap show c
  52                     , "signature " ++ B8.unpack (hex s)
  53                     ]
  54
  55 instance NFData Macaroon where
  56     rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig
  57
  58
  59 -- | Caveat structure
  60 data Caveat = MkCaveat { cid :: Key
  61                        -- ^ Caveat identifier
  62                        , vid :: Key
  63                        -- ^ Caveat verification key identifier
  64                        , cl  :: Location
  65                        -- ^ Caveat target location
  66
  67                        } deriving (Eq)
  68
  69 instance Show Caveat where
  70     show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c
  71                           | otherwise = unlines [ "cid " ++ B8.unpack c
  72                                                 , "vid " ++ B8.unpack v
  73                                                 , "cl " ++ B8.unpack l
  74                                                 ]
  75
  76
  77 instance NFData Caveat where
  78     rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
  79
  80
  81 addCaveat :: Location
  82           -> Key
  83           -> Key
  84           -> Macaroon
  85           -> Macaroon
  86 addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
  87   where
  88     cavs = caveats m
  89     cav' = MkCaveat cid vid loc
  90     sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
  91