1 {-# LANGUAGE OverloadedStrings #-}
3 Module : Crypto.Macaroon.Internal
4 Copyright : (c) 2015 Julien Tanguy
7 Maintainer : julien.tanguy@jhome.fr
8 Stability : experimental
12 Internal representation of a macaroon
14 module Crypto.Macaroon.Internal where
17 import Control.DeepSeq
18 import Crypto.Cipher.AES
21 import qualified Data.ByteString as BS
22 import qualified Data.ByteString.Base64 as B64
23 import qualified Data.ByteString.Char8 as B8
27 -- |Type alias for Macaroons and Caveat keys and identifiers
28 type Key = BS.ByteString
30 -- |Type alias for Macaroons and Caveat locations
31 type Location = BS.ByteString
33 -- |Type alias for Macaroons signatures
34 type Sig = BS.ByteString
36 -- | Main structure of a macaroon
37 data Macaroon = MkMacaroon { location :: Location
40 -- ^ Macaroon Identifier
44 -- ^ Macaroon HMAC signature
47 instance Eq Macaroon where
48 (MkMacaroon l1 i1 c1 s1) == (MkMacaroon l2 i2 c2 s2) =
49 (l1 `constEqBytes` l2) &&!
50 (i1 `constEqBytes` i2) &&!
52 (s1 `constEqBytes` s2)
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
62 , "signature " ++ B8.unpack (hex s)
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
71 data Caveat = MkCaveat { cid :: Key
72 -- ^ Caveat identifier
74 -- ^ Caveat verification key identifier
76 -- ^ Caveat target location
79 instance Eq Caveat where
80 (MkCaveat c1 v1 l1) == (MkCaveat c2 v2 l2) =
81 (c1 `constEqBytes` c2) &&!
82 (v1 `constEqBytes` v2) &&!
83 (l1 `constEqBytes` l2)
85 -- | show instance conforming to the @inspect@ "specification"
86 instance Show Caveat where
87 show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c
88 | otherwise = unlines [ "cid " ++ B8.unpack c
89 , "vid " ++ B8.unpack v
90 , "cl " ++ B8.unpack l
94 -- | NFData instance for use in the benchmark
95 instance NFData Caveat where
96 rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
98 -- | Primitive to add a First or Third party caveat to a macaroon
99 -- For internal use only
100 addCaveat :: Location
105 addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
108 cav' = MkCaveat cid vid loc
109 sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
111 -- | Utility non-short circuiting '&&' function.
112 (&&!) :: Bool -> Bool -> Bool
114 True &&! False = False
115 False &&! True = False
116 False &&! False = False