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 alias for Macaroons signatures
  34 type Sig = BS.ByteString
  35
  36 -- | Main structure of a macaroon
  37 data Macaroon = MkMacaroon { location   :: Location
  38                            -- ^ Target location
  39                            , identifier :: Key
  40                            -- ^ Macaroon Identifier
  41                            , caveats    :: [Caveat]
  42                            -- ^ List of caveats
  43                            , signature  :: Sig
  44                            -- ^ Macaroon HMAC signature
  45                            } deriving (Eq)
  46
  47 -- | show instance conforming to the @inspect@ "specification"
  48 instance Show Macaroon where
  49     -- We use intercalate because unlines would add a trailing newline
  50     show (MkMacaroon l i c s) = intercalate "\n" [
  51                       "location " ++ B8.unpack l
  52                     , "identifier " ++ B8.unpack i
  53                     , concatMap show c
  54                     , "signature " ++ B8.unpack (hex s)
  55                     ]
  56
  57 -- | NFData instance for use in the benchmark
  58 instance NFData Macaroon where
  59     rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig
  60
  61
  62 -- | Caveat structure
  63 data Caveat = MkCaveat { cid :: Key
  64                        -- ^ Caveat identifier
  65                        , vid :: Key
  66                        -- ^ Caveat verification key identifier
  67                        , cl  :: Location
  68                        -- ^ Caveat target location
  69
  70                        } deriving (Eq)
  71
  72 -- | show instance conforming to the @inspect@ "specification"
  73 instance Show Caveat where
  74     show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c
  75                           | otherwise = unlines [ "cid " ++ B8.unpack c
  76                                                 , "vid " ++ B8.unpack v
  77                                                 , "cl " ++ B8.unpack l
  78                                                 ]
  79
  80
  81 -- | NFData instance for use in the benchmark
  82 instance NFData Caveat where
  83     rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
  84
  85 -- | Primitive to add a First or Third party caveat to a macaroon
  86 -- For internal use only
  87 addCaveat :: Location
  88           -> Key
  89           -> Key
  90           -> Macaroon
  91           -> Macaroon
  92 addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
  93   where
  94     cavs = caveats m
  95     cav' = MkCaveat cid vid loc
  96     sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
  97