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