X-Git-Url: https://git.immae.eu/?a=blobdiff_plain;f=src%2FCrypto%2FMacaroon%2FInternal.hs;h=d6e80d3700d4e416858021b987b4bf72c00c1be4;hb=1fcdeab5264180025ac2e48db312c1fbd5ae22ca;hp=fc50486aa42f0a69c95c225b452f0e93a417577e;hpb=f678145637ba6f42c36d07c19f8c764e5d537f72;p=github%2Ffretlink%2Fhmacaroons.git diff --git a/src/Crypto/Macaroon/Internal.hs b/src/Crypto/Macaroon/Internal.hs index fc50486..d6e80d3 100644 --- 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 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