]> git.immae.eu Git - github/fretlink/hmacaroons.git/blobdiff - src/Crypto/Macaroon/Internal.hs
Change verifier api and split Verifier module
[github/fretlink/hmacaroons.git] / src / Crypto / Macaroon / Internal.hs
index fc50486aa42f0a69c95c225b452f0e93a417577e..d6e80d3700d4e416858021b987b4bf72c00c1be4 100644 (file)
@@ -15,23 +15,25 @@ module Crypto.Macaroon.Internal where
 
 
 import           Control.DeepSeq
-import           Crypto.Cipher.AES
 import           Crypto.Hash
 import           Data.Byteable
 import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8  as B8
-import           Data.Char
 import           Data.Hex
-import           Data.Serialize
-import           Data.Word
+import           Data.List
 
--- |Type alias for Macaroons and Caveat keys and identifiers
+
+-- |Type alias for Macaroons secret keys
+type Secret = BS.ByteString
+
+-- |Type alias for Macaroons and Caveat and identifiers
 type Key = BS.ByteString
 
--- |Type alias For Macaroons and Caveat locations
+-- |Type alias for Macaroons and Caveat locations
 type Location = BS.ByteString
 
+-- |Type alias for Macaroons signatures
 type Sig = BS.ByteString
 
 -- | Main structure of a macaroon
@@ -43,9 +45,28 @@ data Macaroon = MkMacaroon { location   :: Location
                            -- ^ List of caveats
                            , signature  :: Sig
                            -- ^ Macaroon HMAC signature
-                           } deriving (Eq)
-
-
+                           }
+
+-- | Constant-time Eq instance
+instance Eq Macaroon where
+    (MkMacaroon l1 i1 c1 s1) == (MkMacaroon l2 i2 c2 s2) =
+        (l1 `constEqBytes` l2) &&!
+        (i1 `constEqBytes` i2) &&!
+        (c1 == c2) &&!
+        (s1 `constEqBytes` s2)
+
+
+-- | show instance conforming to the @inspect@ "specification"
+instance Show Macaroon where
+    -- We use intercalate because unlines would add a trailing newline
+    show (MkMacaroon l i c s) = intercalate "\n" [
+                      "location " ++ B8.unpack l
+                    , "identifier " ++ B8.unpack i
+                    , intercalate "\n" (map show c)
+                    , "signature " ++ B8.unpack (hex s)
+                    ]
+
+-- | NFData instance for use in the benchmark
 instance NFData Macaroon where
     rnf (MkMacaroon loc ident cavs sig) = rnf loc `seq` rnf ident `seq` rnf cavs `seq` rnf sig
 
@@ -57,24 +78,30 @@ data Caveat = MkCaveat { cid :: Key
                        -- ^ Caveat verification key identifier
                        , cl  :: Location
                        -- ^ Caveat target location
+                       }
 
-                       } deriving (Eq)
+-- | Constant-time Eq instance
+instance Eq Caveat where
+    (MkCaveat c1 v1 l1) == (MkCaveat c2 v2 l2) =
+        (c1 `constEqBytes` c2) &&!
+        (v1 `constEqBytes` v2) &&!
+        (l1 `constEqBytes` l2)
 
-instance NFData Caveat where
-    rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
+-- | show instance conforming to the @inspect@ "specification"
+instance Show Caveat where
+    show (MkCaveat c v l) | v == BS.empty = "cid " ++ B8.unpack c
+                          | otherwise = unlines [ "cid " ++ B8.unpack c
+                                                , "vid " ++ B8.unpack v
+                                                , "cl " ++ B8.unpack l
+                                                ]
 
 
-putPacket :: BS.ByteString -> BS.ByteString -> BS.ByteString
-putPacket key dat = BS.concat [
-    B8.map toLower . hex . encode $ (fromIntegral size :: Word16)
-    , key
-    , " "
-    , dat
-    , "\n"
-    ]
-  where
-    size = 4 + 2 + BS.length key + BS.length dat
+-- | NFData instance for use in the benchmark
+instance NFData Caveat where
+    rnf (MkCaveat cid vid cl) = rnf cid `seq` rnf vid `seq` rnf cl
 
+-- | Primitive to add a First or Third party caveat to a macaroon
+-- For internal use only
 addCaveat :: Location
           -> Key
           -> Key
@@ -84,5 +111,12 @@ addCaveat loc cid vid m = m { caveats = cavs ++ [cav'], signature = sig}
   where
     cavs = caveats m
     cav' = MkCaveat cid vid loc
-    sig = toBytes $ (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
+    sig = toBytes (hmac (signature m) (BS.append vid cid) :: HMAC SHA256)
+
+-- | Utility non-short circuiting '&&' function.
+(&&!) :: Bool -> Bool -> Bool
+True  &&! True  = True
+True  &&! False = False
+False &&! True  = False
+False &&! False = False