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