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.Hash
  19 import           Data.Byteable
  20 import qualified Data.ByteString        as BS
  21 import qualified Data.ByteString.Base64 as B64
  22 import qualified Data.ByteString.Char8  as B8
  23 import           Data.Hex
  24 import           Data.List
  25
  26
  27 -- |Type alias for Macaroons secret keys
  28 type Secret = BS.ByteString
  29
  30 -- |Type alias for Macaroons and Caveat and identifiers
  31 type Key = BS.ByteString
  32
  33 -- |Type alias for Macaroons and Caveat locations
  34 type Location = BS.ByteString
  35
  36 -- |Type alias for Macaroons signatures
  37 type Sig = BS.ByteString
  38
  39 -- | Main structure of a macaroon
  40 data Macaroon = MkMacaroon { location   :: Location
  41                            -- ^ Target location
  42                            , identifier :: Key
  43                            -- ^ Macaroon Identifier
  44                            , caveats    :: [Caveat]
  45                            -- ^ List of caveats
  46                            , signature  :: Sig
  47                            -- ^ Macaroon HMAC signature
  48                            }
  49
  50 -- | Constant-time Eq instance
  51 instance Eq Macaroon where
  52     (MkMacaroon l1 i1 c1 s1) == (MkMacaroon l2 i2 c2 s2) =
  53         (l1 `constEqBytes` l2) &&!
  54         (i1 `constEqBytes` i2) &&!
  55         (c1 == c2) &&!
  56         (s1 `constEqBytes` s2)
  57
  58
  59 -- | show instance conforming to the @inspect@ "specification"
  60 instance Show Macaroon where
  61     -- We use intercalate because unlines would add a trailing newline
  62     show (MkMacaroon l i c s) = intercalate "\n" [
  63                       "location " ++ B8.unpack l
  64                     , "identifier " ++ B8.unpack i
  65                     , intercalate "\n" (map show c)
  66                     , "signature " ++ B8.unpack (hex s)
  67                     ]
  68
  69 -- | NFData instance for use in the benchmark
  70 instance NFData Macaroon where
  71     rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig
  72
  73
  74 -- | Caveat structure
  75 data Caveat = MkCaveat { cid :: Key
  76                        -- ^ Caveat identifier
  77                        , vid :: Key
  78                        -- ^ Caveat verification key identifier
  79                        , cl  :: Location
  80                        -- ^ Caveat target location
  81                        }
  82
  83 -- | Constant-time Eq instance
  84 instance Eq Caveat where
  85     (MkCaveat c1 v1 l1) == (MkCaveat c2 v2 l2) =
  86         (c1 `constEqBytes` c2) &&!
  87         (v1 `constEqBytes` v2) &&!
  88         (l1 `constEqBytes` l2)
  89
  90 -- | show instance conforming to the @inspect@ "specification"
  91 instance Show Caveat where
  92     show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c
  93                           | otherwise = unlines [ "cid " ++ B8.unpack c
  94                                                 , "vid " ++ B8.unpack v
  95                                                 , "cl " ++ B8.unpack l
  96                                                 ]
  97
  98
  99 -- | NFData instance for use in the benchmark
 100 instance NFData Caveat where
 101     rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
 102
 103 -- | Primitive to add a First or Third party caveat to a macaroon
 104 -- For internal use only
 105 addCaveat :: Location
 106           -> Key
 107           -> Key
 108           -> Macaroon
 109           -> Macaroon
 110 addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
 111   where
 112     cavs = caveats m
 113     cav' = MkCaveat cid vid loc
 114     sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
 115
 116 -- | Utility non-short circuiting '&&' function.
 117 (&&!) :: Bool -> Bool -> Bool
 118 True  &&! True  = True
 119 True  &&! False = False
 120 False &&! True  = False
 121 False &&! False = False
 122