From bf5aebe2c75e2b422b26f49409fd4e73844a6820 Mon Sep 17 00:00:00 2001 From: Clement Delafargue Date: Sun, 1 Dec 2024 21:52:27 +0100 Subject: [PATCH] 3.3: implement new signature algorithms TODO: - sealed biscuits - check datalog block versions for pre-serialized blocks --- biscuit/src/Auth/Biscuit/Crypto.hs | 239 +++++++++++++++----- biscuit/src/Auth/Biscuit/Proto.hs | 6 +- biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs | 29 ++- biscuit/src/Auth/Biscuit/Token.hs | 78 +++---- biscuit/test/Spec/NewCrypto.hs | 19 +- biscuit/test/Spec/Roundtrip.hs | 4 +- biscuit/test/Spec/SampleReader.hs | 2 +- 7 files changed, 252 insertions(+), 125 deletions(-) diff --git a/biscuit/src/Auth/Biscuit/Crypto.hs b/biscuit/src/Auth/Biscuit/Crypto.hs index 4c28e87..e75caaa 100644 --- a/biscuit/src/Auth/Biscuit/Crypto.hs +++ b/biscuit/src/Auth/Biscuit/Crypto.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} @@ -8,14 +9,15 @@ module Auth.Biscuit.Crypto ( SignedBlock , Blocks - , signBlock + , signAuthority + , signAttenuationBlock , signExternalBlock - , sign3rdPartyBlock + , sign3rdPartyBlockV1 , verifyBlocks , verifySecretProof , verifySignatureProof , getSignatureProof - , verifyExternalSig + , verifyExternalSigV1 , PublicKey , pkBytes , readEd25519PublicKey @@ -39,12 +41,14 @@ import Data.Function (on) import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE -import Data.Maybe (catMaybes, fromJust) +import Data.Maybe (catMaybes, fromJust, fromMaybe, + isJust) import Instances.TH.Lift () import Language.Haskell.TH.Syntax import qualified Auth.Biscuit.Proto as PB import qualified Data.Serialize as PB +import Debug.Trace (traceShowId) newtype PublicKey = PublicKey Ed25519.PublicKey deriving newtype (Eq, Show) @@ -103,9 +107,22 @@ pkBytes (PublicKey pk) = convert pk skBytes :: SecretKey -> ByteString skBytes (SecretKey sk) = convert sk -type SignedBlock = (ByteString, Signature, PublicKey, Maybe (Signature, PublicKey)) +type SignedBlock = + ( ByteString -- payload + , Signature -- signature + , PublicKey -- nextKey + , Maybe (Signature, PublicKey) -- externalKey + , Maybe Int -- version + ) type Blocks = NonEmpty SignedBlock +type AnySignedBlock a = + ( ByteString -- payload + , a + , PublicKey -- nextKey + , Maybe (Signature, PublicKey) -- externalKey + , Maybe Int -- version + ) -- | Biscuit 2.0 allows multiple signature algorithms. -- For now this lib only supports Ed25519, but the spec mandates flagging -- each publicKey with an algorithm identifier when serializing it. The @@ -121,97 +138,197 @@ serializePublicKey pk = algBytes = PB.runPut $ PB.putInt32le algId in algBytes <> keyBytes -signBlock :: SecretKey - -> ByteString - -> Maybe (Signature, PublicKey) - -> IO (SignedBlock, SecretKey) -signBlock sk payload eSig = do +signBlockV0 :: SecretKey + -> ByteString + -> Maybe (Signature, PublicKey) + -> IO (SignedBlock, SecretKey) +signBlockV0 sk payload eSig = do let pk = toPublic sk (nextPk, nextSk) <- (toPublic &&& id) <$> generateSecretKey - let toSign = getToSig (payload, (), nextPk, eSig) + let toSign = getSignaturePayloadV0 (payload, (), nextPk, eSig, Nothing) sig = sign sk pk toSign - pure ((payload, sig, nextPk, eSig), nextSk) - -signExternalBlock :: SecretKey - -> SecretKey - -> PublicKey - -> ByteString - -> IO (SignedBlock, SecretKey) -signExternalBlock sk eSk pk payload = - let eSig = sign3rdPartyBlock eSk pk payload - in signBlock sk payload (Just eSig) - -sign3rdPartyBlock :: SecretKey - -> PublicKey - -> ByteString - -> (Signature, PublicKey) -sign3rdPartyBlock eSk nextPk payload = + pure ((payload, sig, nextPk, eSig, Nothing), nextSk) + +signExternalBlockV0 :: SecretKey + -> SecretKey + -> PublicKey + -> ByteString + -> IO (SignedBlock, SecretKey) +signExternalBlockV0 sk eSk pk payload = + let eSig = sign3rdPartyBlockV0 eSk pk payload + in signBlockV0 sk payload (Just eSig) + +sign3rdPartyBlockV0 :: SecretKey + -> PublicKey + -> ByteString + -> (Signature, PublicKey) +sign3rdPartyBlockV0 eSk nextPk payload = let toSign = payload <> serializePublicKey nextPk ePk = toPublic eSk eSig = sign eSk ePk toSign in (eSig, ePk) +-- TODO: decide how to handle that in biscuit 3.3 getSignatureProof :: SignedBlock -> SecretKey -> Signature -getSignatureProof (lastPayload, Signature lastSig, lastPk, _todo) nextSecret = +getSignatureProof (lastPayload, Signature lastSig, lastPk, _, _) nextSecret = let sk = nextSecret pk = toPublic nextSecret toSign = lastPayload <> serializePublicKey lastPk <> lastSig in sign sk pk toSign -getToSig :: (ByteString, a, PublicKey, Maybe (Signature, PublicKey)) -> ByteString -getToSig (p, _, nextPk, ePk) = +getSignaturePayloadV0 :: AnySignedBlock a -> ByteString +getSignaturePayloadV0 (p, _, nextPk, ePk, _) = p <> foldMap (sigBytes . fst) ePk <> serializePublicKey nextPk -getSignature :: SignedBlock -> Signature -getSignature (_, sig, _, _) = sig - -getPublicKey :: SignedBlock -> PublicKey -getPublicKey (_, _, pk, _) = pk - -- | The data signed by the external key is the payload for the current block + the public key from -- the previous block: this prevents signature reuse (the external signature cannot be used on another -- token) -getExternalSigPayload :: PublicKey -> SignedBlock -> Maybe (PublicKey, ByteString, Signature) -getExternalSigPayload pkN (payload, _, _, Just (eSig, ePk)) = Just (ePk, payload <> serializePublicKey pkN, eSig) -getExternalSigPayload _ _ = Nothing +getExternalSignaturePayloadV0 :: PublicKey -> SignedBlock -> Maybe (PublicKey, ByteString, Signature) +getExternalSignaturePayloadV0 pkN (payload, _, _, Just (eSig, ePk), _) = Just (ePk, payload <> serializePublicKey pkN, eSig) +getExternalSignaturePayloadV0 _ _ = Nothing + +getAuthoritySignaturePayloadV1 :: ByteString -> PublicKey -> ByteString +getAuthoritySignaturePayloadV1 p nextPk = + "\0BLOCK\0" <> + "\0VERSION\0" <> (PB.runPut $ PB.putInt32le 1) <> + "\0PAYLOAD\0" <> p <> + serializePublicKeyV1 nextPk + +getBlockSignaturePayloadV1 :: ByteString -> PublicKey -> Maybe (Signature, PublicKey) -> Signature -> ByteString +getBlockSignaturePayloadV1 p nextPk ePk prevSig = + getAuthoritySignaturePayloadV1 p nextPk <> + "\0PREVSIG\0" <> sigBytes prevSig <> + foldMap serializeExternalSignatureV1 ePk + +getExternalSignaturePayloadV1 :: ByteString -> Signature -> ByteString +getExternalSignaturePayloadV1 payload prevSig = + "\0EXTERNAL\0" <> + "\0VERSION\0" <> (PB.runPut $ PB.putInt32le 1) <> + "\0PAYLOAD\0" <> payload <> + "\0PREVSIG\0" <> sigBytes prevSig + +serializePublicKeyV1 :: PublicKey -> ByteString +serializePublicKeyV1 pk = + let keyBytes = pkBytes pk + algId :: Int32 + algId = fromIntegral $ fromEnum PB.Ed25519 + -- The spec mandates that we serialize the algorithm id as a little-endian int32 + algBytes = PB.runPut $ PB.putInt32le algId + in "\0ALGORITHM\0" <> algBytes <> + "\0NEXTKEY\0" <> keyBytes + +serializeExternalSignatureV1 :: (Signature, PublicKey) -> ByteString +serializeExternalSignatureV1 (sig, _) = "\0EXTERNALSIG\0" <> sigBytes sig + +getSignature :: SignedBlock -> Signature +getSignature (_, sig, _, _, _) = sig + +getPublicKey :: SignedBlock -> PublicKey +getPublicKey (_, _, pk, _, _) = pk -- | When adding a pre-signed third-party block to a token, we make sure the third-party block is correctly -- signed (pk-signature match, and the third-party block is pinned to the last biscuit block) -verifyExternalSig :: PublicKey -> (ByteString, Signature, PublicKey) -> Bool -verifyExternalSig previousPk (payload, eSig, ePk) = +verifyExternalSigV0 :: PublicKey -> (ByteString, Signature, PublicKey) -> Bool +verifyExternalSigV0 previousPk (payload, eSig, ePk) = verify ePk (payload <> serializePublicKey previousPk) eSig +-- | When adding a pre-signed third-party block to a token, we make sure the third-party block is correctly +-- signed (pk-signature match, and the third-party block is pinned to the last biscuit block) +verifyExternalSigV1 :: Signature -> (ByteString, Signature, PublicKey) -> Bool +verifyExternalSigV1 prevSig (payload, eSig, ePk) = + verify ePk (getExternalSignaturePayloadV1 payload prevSig) eSig + +verifyAuthorityBlock :: SignedBlock -> PublicKey -> Bool +verifyAuthorityBlock b@(payload, sig, nextPk, _, version) rootPk = + case fromMaybe 0 version of + 0 -> verify rootPk (getSignaturePayloadV0 b) sig + 1 -> verify rootPk (getAuthoritySignaturePayloadV1 payload nextPk) sig + _ -> False + +verifyAttenuationBlock :: SignedBlock -> SignedBlock -> Bool +verifyAttenuationBlock block previousBlock = + let (payload, sig, nextPk, eSig', version) = block + (_, prevSig, pk, _, _) = previousBlock + in case (fromMaybe 0 version, eSig') of + (0, Nothing) -> verify pk (getSignaturePayloadV0 block) sig + (0, Just _) -> False -- reject third-party blocks with v0 signatures + (1, Nothing) -> verify pk (getBlockSignaturePayloadV1 payload nextPk eSig' prevSig) sig + (1, Just (eSig, ePk)) -> + let sv = verify pk (getBlockSignaturePayloadV1 payload nextPk eSig' prevSig) sig + ev = verify ePk (getExternalSignaturePayloadV1 payload prevSig) eSig + in sv && ev + _ -> False + verifyBlocks :: Blocks -> PublicKey -> Bool -verifyBlocks blocks rootPk = - let attachKey pk (payload, sig) = (pk, payload, sig) - uncurry3 f (a, b, c) = f a b c - sigs = getSignature <$> blocks - toSigs = getToSig <$> blocks - -- key for block 0 is the root key - -- key for block n is the key from block (n - 1) - keys = pure rootPk <> (getPublicKey <$> blocks) - keysPayloadsSigs = NE.zipWith attachKey keys (NE.zip toSigs sigs) - - -- external_signature(block_n) = sign(external_key_n, payload_n <> public_key_n-1) - -- so we need to pair each block with the public key carried by the previous block - -- (the authority block can't have an external signature) - previousKeys = getPublicKey <$> NE.init blocks - blocksAfterAuthority = NE.tail blocks - eKeysPayloadsESigs = catMaybes $ zipWith getExternalSigPayload previousKeys blocksAfterAuthority - in all (uncurry3 verify) keysPayloadsSigs - && all (uncurry3 verify) eKeysPayloadsESigs +verifyBlocks (authority :| attenuationBlocks) rootPk = + let attenuationBlocks' = zip attenuationBlocks (authority : attenuationBlocks) + in verifyAuthorityBlock authority rootPk + && all (uncurry verifyAttenuationBlock) attenuationBlocks' verifySecretProof :: SecretKey -> SignedBlock -> Bool -verifySecretProof nextSecret (_, _, lastPk, _) = +verifySecretProof nextSecret (_, _, lastPk, _, _) = lastPk == toPublic nextSecret + +-- TODO decide how to handle that in biscuit 3.3 verifySignatureProof :: Signature -> SignedBlock -> Bool -verifySignatureProof extraSig (lastPayload, Signature lastSig, lastPk, _) = +verifySignatureProof extraSig (lastPayload, Signature lastSig, lastPk, _, _) = let toSign = lastPayload <> serializePublicKey lastPk <> lastSig in verify lastPk toSign extraSig + +signAuthorityBlockV1 :: SecretKey -> ByteString -> IO (SignedBlock, SecretKey) +signAuthorityBlockV1 sk payload = do + let pk = toPublic sk + (nextPk, nextSk) <- (toPublic &&& id) <$> generateSecretKey + let toSign = getAuthoritySignaturePayloadV1 payload nextPk + sig = sign sk pk toSign + pure ((payload, sig, nextPk, Nothing, Just 1), nextSk) + +signAttenuationBlockV1 :: SecretKey -> Signature -> ByteString -> Maybe (Signature, PublicKey) -> IO (SignedBlock, SecretKey) +signAttenuationBlockV1 sk prevSig payload ePk = do + let pk = toPublic sk + (nextPk, nextSk) <- (toPublic &&& id) <$> generateSecretKey + let toSign = getBlockSignaturePayloadV1 payload nextPk ePk prevSig + sig = sign sk pk toSign + pure ((payload, sig, nextPk, ePk, Just 1), nextSk) + +sign3rdPartyBlockV1 :: SecretKey + -> Signature + -> ByteString + -> (Signature, PublicKey) +sign3rdPartyBlockV1 eSk prevSig payload = + let toSign = getExternalSignaturePayloadV1 payload prevSig + ePk = toPublic eSk + eSig = sign eSk ePk toSign + in (eSig, ePk) + +signAuthority :: SecretKey + -> (ByteString, Int) + -> IO (SignedBlock, SecretKey) +signAuthority secretKey (payload, blockVersion) + | blockVersion >= 6 = signAuthorityBlockV1 secretKey payload + | otherwise = signBlockV0 secretKey payload Nothing + +signAttenuationBlock :: SecretKey + -> Signature + -> (ByteString, Int) + -> Maybe (Signature, PublicKey) + -> IO (SignedBlock, SecretKey) +signAttenuationBlock secretKey prevSig (payload, blockVersion) ePk + | blockVersion >= 6 || isJust ePk = signAttenuationBlockV1 secretKey prevSig payload ePk + | otherwise = signBlockV0 secretKey payload ePk + +signExternalBlock :: SecretKey + -> Signature + -> (ByteString, Int) + -> SecretKey + -> IO (SignedBlock, SecretKey) +signExternalBlock secretKey prevSig (payload, blockVersion) eSk = + let ePk = sign3rdPartyBlockV1 eSk prevSig payload + in signAttenuationBlock secretKey prevSig (payload, blockVersion) (Just ePk) diff --git a/biscuit/src/Auth/Biscuit/Proto.hs b/biscuit/src/Auth/Biscuit/Proto.hs index 95aa529..0d044b1 100644 --- a/biscuit/src/Auth/Biscuit/Proto.hs +++ b/biscuit/src/Auth/Biscuit/Proto.hs @@ -83,6 +83,7 @@ data SignedBlock = SignedBlock , nextKey :: Required 2 (Message PublicKey) , signature :: Required 3 (Value ByteString) , externalSig :: Optional 4 (Message ExternalSig) + , version :: Optional 5 (Value Int32) } deriving (Generic, Show) deriving anyclass (Decode, Encode) @@ -253,8 +254,9 @@ decodeThirdPartyBlockContents = runGet decodeMessage data ThirdPartyBlockRequest = ThirdPartyBlockRequest - { previousPk :: Required 1 (Message PublicKey) - , pkTable :: Repeated 2 (Message PublicKey) + { legacyPk :: Optional 1 (Message PublicKey) + , pkTable :: Repeated 2 (Message PublicKey) + , prevSig :: Required 3 (Value ByteString) } deriving stock (Generic, Show) deriving anyclass (Decode, Encode) diff --git a/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs b/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs index e652292..e3cb7f7 100644 --- a/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs +++ b/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs @@ -72,10 +72,12 @@ pbToSignedBlock PB.SignedBlock{..} = do let sig = Crypto.signature $ PB.getField signature mSig <- traverse pbToOptionalSignature $ PB.getField externalSig pk <- pbToPublicKey $ PB.getField nextKey + let sigVersion = fromIntegral <$> PB.getField version pure ( PB.getField block , sig , pk , mSig + , sigVersion ) publicKeyToPb :: Crypto.PublicKey -> PB.PublicKey @@ -91,11 +93,12 @@ externalSigToPb (sig, pk) = PB.ExternalSig } signedBlockToPb :: Crypto.SignedBlock -> PB.SignedBlock -signedBlockToPb (block, sig, pk, eSig) = PB.SignedBlock +signedBlockToPb (block, sig, pk, eSig, sigVersion) = PB.SignedBlock { block = PB.putField block , signature = PB.putField $ Crypto.sigBytes sig , nextKey = PB.putField $ publicKeyToPb pk , externalSig = PB.putField $ externalSigToPb <$> eSig + , version = PB.putField $ fromIntegral <$> sigVersion } pbToProof :: PB.Proof -> Either String (Either Crypto.Signature Crypto.SecretKey) @@ -153,7 +156,7 @@ pbToBlock ePk PB.Block{..} = do -- | Turn a biscuit block into a protobuf block, for serialization, -- along with the newly defined symbols -blockToPb :: Bool -> Symbols -> Block -> (BlockSymbols, PB.Block) +blockToPb :: Bool -> Symbols -> Block -> ((BlockSymbols, Int), PB.Block) blockToPb hasExternalPk existingSymbols b@Block{..} = let v4Plus = not $ and [Set.null bScope @@ -173,10 +176,10 @@ blockToPb hasExternalPk existingSymbols b@Block{..} = checks_v2 = PB.putField $ checkToPb s <$> bChecks scope = PB.putField $ scopeToPb s <$> Set.toList bScope pksTable = PB.putField $ publicKeyToPb <$> getPkList bSymbols - version = PB.putField $ if | v5Plus -> Just 5 - | v4Plus -> Just 4 - | otherwise -> Just 3 - in (bSymbols, PB.Block {..}) + version = if | v5Plus -> 5 + | v4Plus -> 4 + | otherwise -> 3 + in ((bSymbols, version), PB.Block {version = PB.putField $ Just $ fromIntegral version, ..}) pbToFact :: Symbols -> PB.FactV2 -> Either String Fact pbToFact s PB.FactV2{predicate} = do @@ -425,15 +428,17 @@ binaryToPb = PB.OpBinary . PB.putField . \case BitwiseXor -> PB.BitwiseXor NotEqual -> PB.NotEqual -pbToThirdPartyBlockRequest :: PB.ThirdPartyBlockRequest -> Either String Crypto.PublicKey -pbToThirdPartyBlockRequest PB.ThirdPartyBlockRequest{previousPk, pkTable} = do +pbToThirdPartyBlockRequest :: PB.ThirdPartyBlockRequest -> Either String Crypto.Signature +pbToThirdPartyBlockRequest PB.ThirdPartyBlockRequest{legacyPk, pkTable, prevSig} = do + unless (isNothing $ PB.getField legacyPk) $ Left "Public key provided in third-party block request" unless (null $ PB.getField pkTable) $ Left "Public key table provided in third-party block request" - pbToPublicKey $ PB.getField previousPk + pure . Crypto.signature $ PB.getField prevSig -thirdPartyBlockRequestToPb :: Crypto.PublicKey -> PB.ThirdPartyBlockRequest -thirdPartyBlockRequestToPb previousPk = PB.ThirdPartyBlockRequest - { previousPk = PB.putField $ publicKeyToPb previousPk +thirdPartyBlockRequestToPb :: Crypto.Signature -> PB.ThirdPartyBlockRequest +thirdPartyBlockRequestToPb prevSig = PB.ThirdPartyBlockRequest + { legacyPk = PB.putField Nothing , pkTable = PB.putField [] + , prevSig = PB.putField $ Crypto.sigBytes prevSig } pbToThirdPartyBlockContents :: PB.ThirdPartyBlockContents -> Either String (ByteString, Crypto.Signature, Crypto.PublicKey) diff --git a/biscuit/src/Auth/Biscuit/Token.hs b/biscuit/src/Auth/Biscuit/Token.hs index ec47402..fc3b0a1 100644 --- a/biscuit/src/Auth/Biscuit/Token.hs +++ b/biscuit/src/Auth/Biscuit/Token.hs @@ -75,12 +75,13 @@ import Auth.Biscuit.Crypto (PublicKey, SecretKey, Signature, SignedBlock, getSignatureProof, sigBytes, - sign3rdPartyBlock, - signBlock, + sign3rdPartyBlockV1, + signAttenuationBlock, + signAuthority, signExternalBlock, skBytes, toPublic, verifyBlocks, - verifyExternalSig, + verifyExternalSigV1, verifySecretProof, verifySignatureProof) import Auth.Biscuit.Datalog.AST (Authorizer, Block, Query, @@ -107,7 +108,7 @@ import Auth.Biscuit.Symbols -- so we need to keep the initial serialized payload around in order to compute -- a new signature when adding a block. type ExistingBlock = (ByteString, Block) -type ParsedSignedBlock = (ExistingBlock, Signature, PublicKey, Maybe (Signature, PublicKey)) +type ParsedSignedBlock = (ExistingBlock, Signature, PublicKey, Maybe (Signature, PublicKey), Maybe Int) -- $openOrSealed -- @@ -218,7 +219,7 @@ queryRawBiscuitFactsWithLimits :: Biscuit openOrSealed check -> Limits -> Query -> Either String (Set Bindings) queryRawBiscuitFactsWithLimits b@Biscuit{authority,blocks} = let ePks = externalKeys b - getBlock ((_, block), _, _, _) = block + getBlock ((_, block), _, _, _, _) = block allBlocks = zip [0..] $ getBlock <$> authority : blocks (_, sFacts) = foldMap (uncurry collectWorld . fmap (toEvaluation ePks)) allBlocks in queryAvailableFacts ePks sFacts @@ -263,7 +264,7 @@ asOpen b@Biscuit{proof} = case proof of _ -> Nothing toParsedSignedBlock :: Block -> SignedBlock -> ParsedSignedBlock -toParsedSignedBlock block (serializedBlock, sig, pk, eSig) = ((serializedBlock, block), sig, pk, eSig) +toParsedSignedBlock block (serializedBlock, sig, pk, eSig, sigVersion) = ((serializedBlock, block), sig, pk, eSig, sigVersion) -- | Create a new biscuit with the provided authority block. Such a biscuit is 'Open' to -- further attenuation. @@ -274,8 +275,8 @@ mkBiscuit = mkBiscuitWith Nothing -- further attenuation. mkBiscuitWith :: Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified) mkBiscuitWith rootKeyId sk authority = do - let (authoritySymbols, authoritySerialized) = PB.encodeBlock <$> blockToPb False newSymbolTable authority - (signedBlock, nextSk) <- signBlock sk authoritySerialized Nothing + let ((authoritySymbols, authorityVersion), authoritySerialized) = PB.encodeBlock <$> blockToPb False newSymbolTable authority + (signedBlock, nextSk) <- signAuthority sk (authoritySerialized, authorityVersion) pure Biscuit { rootKeyId , authority = toParsedSignedBlock authority signedBlock , blocks = [] @@ -290,9 +291,10 @@ addBlock :: Block -> Biscuit Open check -> IO (Biscuit Open check) addBlock block b@Biscuit{..} = do - let (blockSymbols, blockSerialized) = PB.encodeBlock <$> blockToPb False symbols block - Open p = proof - (signedBlock, nextSk) <- signBlock p blockSerialized Nothing + let ((blockSymbols, version), blockSerialized) = PB.encodeBlock <$> blockToPb False symbols block + Open sk = proof + (_, prevSig, _, _,_) = NE.last $ authority :| blocks + (signedBlock, nextSk) <- signAttenuationBlock sk prevSig (blockSerialized, version) Nothing pure $ b { blocks = blocks <> [toParsedSignedBlock block signedBlock] , symbols = addFromBlock symbols blockSymbols , proof = Open nextSk @@ -306,22 +308,22 @@ addSignedBlock :: SecretKey -> Biscuit Open check -> IO (Biscuit Open check) addSignedBlock eSk block b@Biscuit{..} = do - let (_, blockSerialized) = PB.encodeBlock <$> blockToPb True newSymbolTable block + let ((_, version), blockSerialized) = PB.encodeBlock <$> blockToPb True newSymbolTable block lastBlock = NE.last (authority :| blocks) - (_, _, lastPublicKey, _) = lastBlock - Open p = proof - (signedBlock, nextSk) <- signExternalBlock p eSk lastPublicKey blockSerialized + (_, prevSig, _, _, _) = lastBlock + Open sk = proof + (signedBlock, nextSk) <- signExternalBlock sk prevSig (blockSerialized, version) eSk pure $ b { blocks = blocks <> [toParsedSignedBlock block signedBlock] , proof = Open nextSk } mkThirdPartyBlock' :: SecretKey - -> PublicKey + -> Signature -> Block -> (ByteString, Signature, PublicKey) -mkThirdPartyBlock' eSk lastPublicKey block = +mkThirdPartyBlock' eSk prevSig block = let (_, payload) = PB.encodeBlock <$> blockToPb True newSymbolTable block - (eSig, ePk) = sign3rdPartyBlock eSk lastPublicKey payload + (eSig, ePk) = sign3rdPartyBlockV1 eSk prevSig payload in (payload, eSig, ePk) -- | Given a third-party block request, generate a third-party block, @@ -331,8 +333,8 @@ mkThirdPartyBlock :: SecretKey -> Block -> Either String ByteString mkThirdPartyBlock eSk req block = do - previousPk<- pbToThirdPartyBlockRequest =<< PB.decodeThirdPartyBlockRequest req - pure $ PB.encodeThirdPartyBlockContents . thirdPartyBlockContentsToPb $ mkThirdPartyBlock' eSk previousPk block + prevSig <- pbToThirdPartyBlockRequest =<< PB.decodeThirdPartyBlockRequest req + pure $ PB.encodeThirdPartyBlockContents . thirdPartyBlockContentsToPb $ mkThirdPartyBlock' eSk prevSig block -- | Generate a third-party block request. It can be used in -- conjunction with 'mkThirdPartyBlock' to generate a @@ -340,22 +342,22 @@ mkThirdPartyBlock eSk req block = do -- 'applyThirdPartyBlock'. mkThirdPartyBlockReq :: Biscuit proof check -> ByteString mkThirdPartyBlockReq Biscuit{authority,blocks} = - let (_, _ , lastPk, _) = NE.last $ authority :| blocks - in PB.encodeThirdPartyBlockRequest $ thirdPartyBlockRequestToPb lastPk + let (_, prevSig , _, _, _) = NE.last $ authority :| blocks + in PB.encodeThirdPartyBlockRequest $ thirdPartyBlockRequestToPb prevSig -- | Given a base64-encoded third-party block, append it to a token. applyThirdPartyBlock :: Biscuit Open check -> ByteString -> Either String (IO (Biscuit Open check)) applyThirdPartyBlock b@Biscuit{..} contents = do (payload, eSig, ePk) <- pbToThirdPartyBlockContents =<< PB.decodeThirdPartyBlockContents contents - let Open p = proof - addESig (a,b',c,_) = (a,b',c, Just (eSig, ePk)) - (_, _, lastPk, _) = NE.last $ authority :| blocks + let Open sk = proof + addESig (a,b',c,_, d) = (a,b',c, Just (eSig, ePk), d) + (_, prevSig, _, _, _) = NE.last $ authority :| blocks pbBlock <- PB.decodeBlock payload (block, newSymbols) <- (`runStateT` symbols) $ pbToBlock (Just ePk) pbBlock - unless (verifyExternalSig lastPk (payload, eSig, ePk)) $ + unless (verifyExternalSigV1 prevSig (payload, eSig, ePk)) $ Left "Invalid 3rd party signature" pure $ do - (signedBlock, nextSk) <- signBlock p payload (Just (eSig, ePk)) + (signedBlock, nextSk) <- signAttenuationBlock sk prevSig (payload, 3) (Just (eSig, ePk)) pure $ b { blocks = blocks <> [toParsedSignedBlock block (addESig signedBlock)] , proof = Open nextSk , symbols = newSymbols @@ -363,8 +365,8 @@ applyThirdPartyBlock b@Biscuit{..} contents = do externalKeys :: Biscuit openOrSealed check -> [Maybe PublicKey] externalKeys Biscuit{blocks} = - let getEpk (_, _, _, Just (_, ePk)) = Just ePk - getEpk _ = Nothing + let getEpk (_, _, _, Just (_, ePk), _) = Just ePk + getEpk _ = Nothing in Nothing : (getEpk <$> blocks) -- | Turn an 'Open' biscuit into a 'Sealed' one, preventing it from being attenuated @@ -372,8 +374,8 @@ externalKeys Biscuit{blocks} = seal :: Biscuit Open check -> Biscuit Sealed check seal b@Biscuit{..} = let Open sk = proof - ((lastPayload, _), lastSig, lastPk, eSig) = NE.last $ authority :| blocks - newProof = Sealed $ getSignatureProof (lastPayload, lastSig, lastPk, eSig) sk + ((lastPayload, _), lastSig, lastPk, eSig, _) = NE.last $ authority :| blocks + newProof = Sealed $ getSignatureProof (lastPayload, lastSig, lastPk, eSig, Nothing) sk -- TODO in b { proof = newProof } -- | Serialize a biscuit to a raw bytestring @@ -390,7 +392,7 @@ serializeBiscuit Biscuit{..} = } toPBSignedBlock :: ParsedSignedBlock -> PB.SignedBlock -toPBSignedBlock ((block, _), sig, pk, eSig) = signedBlockToPb (block, sig, pk, eSig) +toPBSignedBlock ((block, _), sig, pk, eSig, sigVersion) = signedBlockToPb (block, sig, pk, eSig, sigVersion) -- | Errors that can happen when parsing a biscuit. Since complete parsing of a biscuit -- requires a signature check, an invalid signature check is a parsing error @@ -444,7 +446,7 @@ checkRevocation :: Applicative m -> BiscuitWrapper -> m (Either ParseError BiscuitWrapper) checkRevocation isRevoked bw@BiscuitWrapper{wAuthority,wBlocks} = - let getRevocationId (_, sig, _, _) = sigBytes sig + let getRevocationId (_, sig, _, _, _) = sigBytes sig revocationIds = getRevocationId <$> wAuthority :| wBlocks keepIfNotRevoked True = Left RevokedBiscuit keepIfNotRevoked False = Right bw @@ -452,10 +454,10 @@ checkRevocation isRevoked bw@BiscuitWrapper{wAuthority,wBlocks} = parseBlocks :: BiscuitWrapper -> Either ParseError (Symbols, NonEmpty ParsedSignedBlock) parseBlocks BiscuitWrapper{..} = do - let parseBlock (payload, sig, pk, eSig) = do + let parseBlock (payload, sig, pk, eSig, sigVersion) = do pbBlock <- lift $ first (InvalidProtobufSer False) $ PB.decodeBlock payload block <- mapStateT (first (InvalidProtobuf False)) $ pbToBlock (snd <$> eSig) pbBlock - pure ((payload, block), sig, pk, eSig) + pure ((payload, block), sig, pk, eSig,sigVersion) (allBlocks, symbols) <- (`runStateT` newSymbolTable) $ do traverse parseBlock (wAuthority :| wBlocks) @@ -502,7 +504,7 @@ checkBiscuitSignatures :: BiscuitProof proof -> Either ParseError (Biscuit proof Verified) checkBiscuitSignatures getPublicKey b@Biscuit{..} = do let pk = getPublicKey rootKeyId - toSignedBlock ((payload, _), sig, nextPk, eSig) = (payload, sig, nextPk, eSig) + toSignedBlock ((payload, _), sig, nextPk, eSig, sigVersion) = (payload, sig, nextPk, eSig, sigVersion) allBlocks = toSignedBlock <$> (authority :| blocks) blocksResult = verifyBlocks allBlocks pk proofResult = case toPossibleProofs proof of @@ -550,13 +552,13 @@ parseBiscuitWith ParserConfig{..} bs = getRevocationIds :: Biscuit proof check -> NonEmpty ByteString getRevocationIds Biscuit{authority, blocks} = let allBlocks = authority :| blocks - getRevocationId (_, sig, _, _) = sigBytes sig + getRevocationId (_, sig, _, _, _) = sigBytes sig in getRevocationId <$> allBlocks -- | Generic version of 'authorizeBiscuitWithLimits' which takes custom 'Limits'. authorizeBiscuitWithLimits :: Limits -> Biscuit proof Verified -> Authorizer -> IO (Either ExecutionError (AuthorizedBiscuit proof)) authorizeBiscuitWithLimits l biscuit@Biscuit{..} authorizer = - let toBlockWithRevocationId ((_, block), sig, _, eSig) = (block, sigBytes sig, snd <$> eSig) + let toBlockWithRevocationId ((_, block), sig, _, eSig, _) = (block, sigBytes sig, snd <$> eSig) -- the authority block can't be externally signed. If it carries a signature, it won't be -- verified. So we need to make sure there is none, to avoid having facts trusted without -- a proper signature check diff --git a/biscuit/test/Spec/NewCrypto.hs b/biscuit/test/Spec/NewCrypto.hs index e7bff16..6ff4f80 100644 --- a/biscuit/test/Spec/NewCrypto.hs +++ b/biscuit/test/Spec/NewCrypto.hs @@ -29,7 +29,7 @@ data SealedToken = SealedToken signToken :: ByteString -> SecretKey -> IO Token signToken p sk = do - (signedBlock, privKey) <- signBlock sk p Nothing + (signedBlock, privKey) <- signAuthority sk (p, 3) pure Token { payload = pure signedBlock , privKey @@ -40,7 +40,8 @@ snocNE (h :| t) e = h :| (t <> [e]) append :: Token -> ByteString -> IO Token append t@Token{payload} p = do - (signedBlock, privKey) <- signBlock (privKey t) p Nothing + let (_, lastSig, _, _, _) = NE.last payload + (signedBlock, privKey) <- signAttenuationBlock (privKey t) lastSig (p, 3) Nothing pure Token { payload = snocNE payload signedBlock , privKey @@ -48,8 +49,8 @@ append t@Token{payload} p = do appendSigned :: Token -> SecretKey -> ByteString -> IO Token appendSigned t@Token{payload} eSk p = do - let (_, _, lastPk, _) = NE.last payload - (signedBlock, privKey) <- signExternalBlock (privKey t) eSk lastPk p + let (_, lastSig, lastPk, _, _) = NE.last payload + (signedBlock, privKey) <- signExternalBlock (privKey t) lastSig (p, 3) eSk pure Token { payload = snocNE payload signedBlock , privKey @@ -144,7 +145,7 @@ invalidExternalSig = testCase "Invalid external signature" $ do attenuated <- appendSigned token eSk "block1" let bogusSignature = sign eSk ePk ("yolo yolo" :: ByteString) replaceExternalSig :: SignedBlock -> SignedBlock - replaceExternalSig (p, s, pk, Just (_, ePk)) = (p, s, pk, Just (bogusSignature, ePk)) + replaceExternalSig (p, s, pk, Just (_, ePk), v) = (p, s, pk, Just (bogusSignature, ePk), v) replaceExternalSig sb = sb tamper :: Blocks -> Blocks tamper = fmap replaceExternalSig @@ -164,7 +165,7 @@ tamperedAuthority = testCase "Tampered authority" $ do content = "content" token <- signToken content sk attenuated <- append token "block1" - let tamper ((_, s, pk, eS) :| o) = ("tampered", s, pk, eS) :| o + let tamper ((_, s, pk, eS, v) :| o) = ("tampered", s, pk, eS, v) :| o tampered = alterPayload tamper attenuated let res = verifyToken tampered pk res @?= False @@ -176,7 +177,7 @@ tamperedBlock = testCase "Tampered block" $ do content = "content" token <- signToken content sk attenuated <- append token "block1" - let tamper (h :| ((_, s, pk, eS): t)) = h :| (("tampered", s, pk, eS) : t) + let tamper (h :| ((_, s, pk, eS, v): t)) = h :| (("tampered", s, pk, eS, v) : t) tampered = alterPayload tamper attenuated let res = verifyToken tampered pk res @?= False @@ -224,7 +225,7 @@ tamperedAuthoritySealed = testCase "Tampered authority" $ do content = "content" token <- signToken content sk attenuated <- seal <$> append token "block1" - let tamper ((_, s, pk, eS) :| o) = ("tampered", s, pk, eS) :| o + let tamper ((_, s, pk, eS, v) :| o) = ("tampered", s, pk, eS, v) :| o tampered = alterPayloadSealed tamper attenuated let res = verifySealedToken tampered pk res @?= False @@ -236,7 +237,7 @@ tamperedBlockSealed = testCase "Tampered block" $ do content = "content" token <- signToken content sk attenuated <- seal <$> append token "block1" - let tamper (h :| ((_, s, pk, eS): t)) = h :| (("tampered", s, pk, eS) : t) + let tamper (h :| ((_, s, pk, eS, v): t)) = h :| (("tampered", s, pk, eS, v) : t) tampered = alterPayloadSealed tamper attenuated let res = verifySealedToken tampered pk res @?= False diff --git a/biscuit/test/Spec/Roundtrip.hs b/biscuit/test/Spec/Roundtrip.hs index 4b4daec..24a4fbb 100644 --- a/biscuit/test/Spec/Roundtrip.hs +++ b/biscuit/test/Spec/Roundtrip.hs @@ -58,7 +58,7 @@ roundtrip' (s,p) i@(authority' :| blocks') = do final <- addBlocks blocks' init' let serialized = s final parsed = p pk serialized - getBlock ((_, b), _, _, _) = b + getBlock ((_, b), _, _, _, _) = b getBlocks b = getBlock <$> authority b :| blocks b getBlocks <$> parsed @?= Right (snd <$> i) rootKeyId <$> parsed @?= Right (Just 1) @@ -87,7 +87,7 @@ roundtrip'' direct (s,p) i@(authority' :| blocks') = do final <- addBlocks blocks' init' let serialized = s final parsed = p pk serialized - getBlock ((_, b), _, _, _) = b + getBlock ((_, b), _, _, _, _) = b getBlocks b = getBlock <$> authority b :| blocks b getBlocks <$> parsed @?= Right (snd <$> i) rootKeyId <$> parsed @?= Right (Just 1) diff --git a/biscuit/test/Spec/SampleReader.hs b/biscuit/test/Spec/SampleReader.hs index 7a23d4d..c560901 100644 --- a/biscuit/test/Spec/SampleReader.hs +++ b/biscuit/test/Spec/SampleReader.hs @@ -48,7 +48,7 @@ import Auth.Biscuit.Utils (encodeHex) import Spec.Parser (parseAuthorizer, parseBlock) getB :: ParsedSignedBlock -> Block -getB ((_, b), _, _, _) = b +getB ((_, b), _, _, _, _) = b getAuthority :: Biscuit p Verified -> Block getAuthority = getB . authority