Change verifier api and split Verifier module

[github/fretlink/hmacaroons.git] / src / Crypto / Macaroon / Internal.hs

diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs
index fc50486aa42f0a69c95c225b452f0e93a417577e..d6e80d3700d4e416858021b987b4bf72c00c1be4 100644 (file)
--- a/src/Crypto/Macaroon/Internal.hs
+++ b/src/Crypto/Macaroon/Internal.hs
@@ -15,23 +15,25 @@ module Crypto.Macaroon.Internal where
 
 
 import           Control.DeepSeq
 
 
 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           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.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 Key = BS.ByteString
 

--- |Type alias For Macaroons and Caveat locations
+-- |Type alias for Macaroons and Caveat locations

 type Location = BS.ByteString
 
 type Location = BS.ByteString
 

+-- |Type alias for Macaroons signatures

 type Sig = BS.ByteString
 
 -- | Main structure of a macaroon
 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
                            -- ^ 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
 
 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
                        -- ^ 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
 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
   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