diff --git a/biscuit-servant/biscuit-servant.cabal b/biscuit-servant/biscuit-servant.cabal index 922ba91..45b83e6 100644 --- a/biscuit-servant/biscuit-servant.cabal +++ b/biscuit-servant/biscuit-servant.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: biscuit-servant -version: 0.2.1.0 +version: 0.3.0.0 category: Security synopsis: Servant support for the Biscuit security token description: Please see the README on GitHub at @@ -33,7 +33,7 @@ library ghc-options: -Wall build-depends: base >= 4.7 && <5, - biscuit-haskell >= 0.2.1.0 && < 0.3, + biscuit-haskell >= 0.3.0.0 && < 0.4, bytestring ^>= 0.10, mtl ^>= 2.2, text ^>= 1.2, diff --git a/biscuit/biscuit-haskell.cabal b/biscuit/biscuit-haskell.cabal index ed2364d..27ce1ae 100644 --- a/biscuit/biscuit-haskell.cabal +++ b/biscuit/biscuit-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: biscuit-haskell -version: 0.2.1.0 +version: 0.3.0.0 category: Security synopsis: Library support for the Biscuit security token description: Please see the README on GitHub at diff --git a/biscuit/src/Auth/Biscuit.hs b/biscuit/src/Auth/Biscuit.hs index 19056b4..09a3d96 100644 --- a/biscuit/src/Auth/Biscuit.hs +++ b/biscuit/src/Auth/Biscuit.hs @@ -58,19 +58,20 @@ module Auth.Biscuit -- ** Attenuating biscuits -- $attenuatingBiscuits , addBlock + -- $sealedBiscuits + , seal + , fromOpen + , fromSealed + , asOpen + , asSealed -- ** Third-party blocks + -- $thirdPartyBlocks , mkThirdPartyBlockReq , mkThirdPartyBlockReqB64 , mkThirdPartyBlock , mkThirdPartyBlockB64 , applyThirdPartyBlock , applyThirdPartyBlockB64 - -- $sealedBiscuits - , seal - , fromOpen - , fromSealed - , asOpen - , asSealed -- * Verifying a biscuit -- $verifying @@ -101,6 +102,8 @@ module Auth.Biscuit ) where import Control.Monad ((<=<)) +import Control.Monad.Except (ExceptT (..), liftEither, + runExceptT) import Control.Monad.Identity (runIdentity) import Data.Bifunctor (first) import Data.ByteString (ByteString) @@ -349,15 +352,22 @@ serialize = serializeBiscuit serializeB64 :: BiscuitProof p => Biscuit p Verified -> ByteString serializeB64 = B64.encodeBase64' . serialize +-- | Create a third-party block request from an 'Open' biscuit. This request contains +-- information needed to properly serialize a block without access to the original +-- token. See 'mkThirdPartyBlockReq' if you need the request to be raw bytes. mkThirdPartyBlockReqB64 :: Biscuit Open c -> ByteString mkThirdPartyBlockReqB64 = B64.encodeBase64' . mkThirdPartyBlockReq -mkThirdPartyBlockB64 :: SecretKey -> ByteString -> Block -> Either String ByteString -mkThirdPartyBlockB64 sk reqB64 b = do - req <- first unpack $ B64.decodeBase64 reqB64 - contents <- mkThirdPartyBlock sk req b +-- | Create a third-party block from a block request and a parsed datalog block. +-- See 'mkThirdPartyBlock' if you need raw bytes for requests and contents. +mkThirdPartyBlockB64 :: SecretKey -> ByteString -> Block -> IO (Either String ByteString) +mkThirdPartyBlockB64 sk reqB64 b = runExceptT $ do + req <- liftEither $ first unpack $ B64.decodeBase64 reqB64 + contents <- ExceptT $ mkThirdPartyBlock sk req b pure $ B64.encodeBase64' contents +-- | Append a signed third-party block to an 'Open' 'Biscuit'. +-- See 'applyThirdPartyBlock' if you have raw bytes contents. applyThirdPartyBlockB64 :: Biscuit Open check -> ByteString -> Either String (IO (Biscuit Open check)) applyThirdPartyBlockB64 b contentsB64 = do contents <- first unpack $ B64.decodeBase64 contentsB64 @@ -390,6 +400,25 @@ applyThirdPartyBlockB64 b contentsB64 = do -- or not). 'authorizeBiscuit' does not care whether a biscuit is 'Open' or 'Sealed' and can be -- used with both. 'addBlock' and 'seal' only work with 'Open' biscuits. +-- $thirdPartyBlocks +-- +-- Biscuits can be /attenuated/ by adding blocks. Such blocks can only restrict what a biscuit +-- token can do, because they cannot be trusted: they are not signed by a trusted keypair. +-- Third-party blocks are like regular blocks, but they can be signed by a trusted keypair, and +-- as such their contents can be used for more than attenuation. They can carry proofs from +-- third parties (hence their name). +-- +-- In practice, a third-party block can be created for a given bisuit token by first creating a +-- third-party block request from a 'Biscuit', with 'mkThirdPartyBlockReq'. This request +-- provides the third party with enough information to serialize and sign a third party block, +-- with 'mkThirdPartyBlock', and the resulting block can then be appended to a token with +-- 'applyThirdPartyBlock'. All these functions have @B64@ variants that deal with base64-encoded +-- payloads suitable for transfer over textual channels. +-- +-- Facts originating from third-party blocks signed by trusted keypairs can be accessed from +-- within datalog with the special scoping syntax @ trusting {keypair}@, available on /rules/, +-- /checks/ and /policies/. + -- $verifying -- -- Verifying a biscuit requires providing a list of policies (/allow/ or /deny/), which will diff --git a/biscuit/src/Auth/Biscuit/Crypto.hs b/biscuit/src/Auth/Biscuit/Crypto.hs index 808f37f..76d8e89 100644 --- a/biscuit/src/Auth/Biscuit/Crypto.hs +++ b/biscuit/src/Auth/Biscuit/Crypto.hs @@ -16,12 +16,14 @@ module Auth.Biscuit.Crypto , verifySignatureProof , getSignatureProof , verifyExternalSig - , PublicKey + , PublicKey (..) , pkBytes , readEd25519PublicKey - , SecretKey + , readECDSAP256PublicKey + , SecretKey (..) , skBytes , readEd25519SecretKey + , readECDSAP256SecretKey , Signature , sigBytes , signature @@ -30,8 +32,12 @@ module Auth.Biscuit.Crypto , sign ) where +import Auth.Biscuit.Utils (rightToMaybe) import Control.Arrow ((&&&)) +import Crypto.ECC (Curve_P256R1) import Crypto.Error (maybeCryptoError) +import Crypto.Hash.Algorithms (SHA256 (..)) +import qualified Crypto.PubKey.ECDSA as ECDSA import qualified Crypto.PubKey.Ed25519 as Ed25519 import Data.ByteArray (convert) import Data.ByteString (ByteString) @@ -40,14 +46,17 @@ import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes, fromJust) +import Data.Proxy (Proxy (..)) import Instances.TH.Lift () import Language.Haskell.TH.Syntax import qualified Auth.Biscuit.Proto as PB import qualified Data.Serialize as PB -newtype PublicKey = PublicKey Ed25519.PublicKey - deriving newtype (Eq, Show) +data PublicKey + = Ed25519PublicKey Ed25519.PublicKey + | ECDSAP256PublicKey (ECDSA.PublicKey Curve_P256R1) + deriving stock (Eq, Show) instance Ord PublicKey where compare = compare `on` serializePublicKey @@ -60,8 +69,10 @@ instance Lift PublicKey where liftTyped = unsafeTExpCoerce . lift #endif -newtype SecretKey = SecretKey Ed25519.SecretKey - deriving newtype (Eq, Show) +data SecretKey + = Ed25519SecretKey Ed25519.SecretKey + | ECDSAP256SecretKey (ECDSA.PrivateKey Curve_P256R1) + deriving stock (Eq, Show) newtype Signature = Signature ByteString deriving newtype (Eq, Show) @@ -72,35 +83,64 @@ sigBytes :: Signature -> ByteString sigBytes (Signature b) = b readEd25519PublicKey :: ByteString -> Maybe PublicKey -readEd25519PublicKey bs = PublicKey <$> maybeCryptoError (Ed25519.publicKey bs) +readEd25519PublicKey bs = Ed25519PublicKey <$> maybeCryptoError (Ed25519.publicKey bs) readEd25519SecretKey :: ByteString -> Maybe SecretKey -readEd25519SecretKey bs = SecretKey <$> maybeCryptoError (Ed25519.secretKey bs) +readEd25519SecretKey bs = Ed25519SecretKey <$> maybeCryptoError (Ed25519.secretKey bs) readEd25519Signature :: Signature -> Maybe Ed25519.Signature readEd25519Signature (Signature bs) = maybeCryptoError (Ed25519.signature bs) +readECDSAP256PublicKey :: ByteString -> Maybe PublicKey +readECDSAP256PublicKey bs = ECDSAP256PublicKey <$> error "todo" bs + +readECDSAP256SecretKey :: ByteString -> Maybe SecretKey +readECDSAP256SecretKey bs = ECDSAP256SecretKey <$> error "todo" bs + toPublic :: SecretKey -> PublicKey -toPublic (SecretKey sk) = PublicKey $ Ed25519.toPublic sk +toPublic (Ed25519SecretKey sk) = Ed25519PublicKey $ Ed25519.toPublic sk +toPublic (ECDSAP256SecretKey sk) = ECDSAP256PublicKey $ ECDSA.toPublic @Curve_P256R1 Proxy sk generateSecretKey :: IO SecretKey -generateSecretKey = SecretKey <$> Ed25519.generateSecretKey - -sign :: SecretKey -> PublicKey -> ByteString -> Signature -sign (SecretKey sk) (PublicKey pk) payload = - Signature . convert $ Ed25519.sign sk pk payload +generateSecretKey = Ed25519SecretKey <$> Ed25519.generateSecretKey + +readECDSAP256Signature :: Signature -> Maybe (ECDSA.Signature Curve_P256R1) +readECDSAP256Signature (Signature bs) = do + let parser = (,) <$> PB.getInt32be <*> PB.getInt32be + (r,s) <- rightToMaybe $ PB.runGet parser bs + maybeCryptoError $ ECDSA.signatureFromIntegers Proxy (fromIntegral r, fromIntegral s) + +writeECDSAP256Signature :: ECDSA.Signature Curve_P256R1 -> Signature +writeECDSAP256Signature sig = + let (r, s) = ECDSA.signatureToIntegers Proxy sig + in Signature $ + PB.runPut (PB.putInt32be $ fromInteger r) <> + PB.runPut (PB.putInt32be $ fromInteger s) + +sign :: SecretKey -> ByteString -> IO Signature +sign (Ed25519SecretKey sk) payload = + let pk = Ed25519.toPublic sk + in pure . Signature . convert $ Ed25519.sign sk pk payload +sign (ECDSAP256SecretKey sk) payload = + writeECDSAP256Signature <$> ECDSA.sign @Curve_P256R1 Proxy sk SHA256 payload verify :: PublicKey -> ByteString -> Signature -> Bool -verify (PublicKey pk) payload sig = +verify (Ed25519PublicKey pk) payload sig = case readEd25519Signature sig of Just sig' -> Ed25519.verify pk payload sig' Nothing -> False +verify (ECDSAP256PublicKey pk) payload sig = + case readECDSAP256Signature sig of + Just sig' -> ECDSA.verify @Curve_P256R1 Proxy SHA256 pk sig' payload + Nothing -> False pkBytes :: PublicKey -> ByteString -pkBytes (PublicKey pk) = convert pk +pkBytes (Ed25519PublicKey pk) = convert pk +pkBytes (ECDSAP256PublicKey pk) = error "todo" pk skBytes :: SecretKey -> ByteString -skBytes (SecretKey sk) = convert sk +skBytes (Ed25519SecretKey sk) = convert sk +skBytes (ECDSAP256SecretKey sk) = error "todo" sk type SignedBlock = (ByteString, Signature, PublicKey, Maybe (Signature, PublicKey)) type Blocks = NonEmpty SignedBlock @@ -125,10 +165,9 @@ signBlock :: SecretKey -> Maybe (Signature, PublicKey) -> IO (SignedBlock, SecretKey) signBlock sk payload eSig = do - let pk = toPublic sk (nextPk, nextSk) <- (toPublic &&& id) <$> generateSecretKey let toSign = getToSig (payload, (), nextPk, eSig) - sig = sign sk pk toSign + sig <- sign sk toSign pure ((payload, sig, nextPk, eSig), nextSk) signExternalBlock :: SecretKey @@ -136,26 +175,25 @@ signExternalBlock :: SecretKey -> PublicKey -> ByteString -> IO (SignedBlock, SecretKey) -signExternalBlock sk eSk pk payload = - let eSig = sign3rdPartyBlock eSk pk payload - in signBlock sk payload (Just eSig) +signExternalBlock sk eSk pk payload = do + eSig <- sign3rdPartyBlock eSk pk payload + signBlock sk payload (Just eSig) sign3rdPartyBlock :: SecretKey -> PublicKey -> ByteString - -> (Signature, PublicKey) -sign3rdPartyBlock eSk nextPk payload = + -> IO (Signature, PublicKey) +sign3rdPartyBlock eSk nextPk payload = do let toSign = payload <> serializePublicKey nextPk ePk = toPublic eSk - eSig = sign eSk ePk toSign - in (eSig, ePk) + eSig <- sign eSk toSign + pure (eSig, ePk) -getSignatureProof :: SignedBlock -> SecretKey -> Signature +getSignatureProof :: SignedBlock -> SecretKey -> IO Signature getSignatureProof (lastPayload, Signature lastSig, lastPk, _todo) nextSecret = let sk = nextSecret - pk = toPublic nextSecret toSign = lastPayload <> serializePublicKey lastPk <> lastSig - in sign sk pk toSign + in sign sk toSign getToSig :: (ByteString, a, PublicKey, Maybe (Signature, PublicKey)) -> ByteString getToSig (p, _, nextPk, ePk) = diff --git a/biscuit/src/Auth/Biscuit/Proto.hs b/biscuit/src/Auth/Biscuit/Proto.hs index f053b16..06c34c4 100644 --- a/biscuit/src/Auth/Biscuit/Proto.hs +++ b/biscuit/src/Auth/Biscuit/Proto.hs @@ -86,7 +86,9 @@ data SignedBlock = SignedBlock deriving (Generic, Show) deriving anyclass (Decode, Encode) -data Algorithm = Ed25519 +data Algorithm + = Ed25519 + | P256 deriving stock (Show, Enum, Bounded) data PublicKey = PublicKey diff --git a/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs b/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs index f76b3bf..a9a100a 100644 --- a/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs +++ b/biscuit/src/Auth/Biscuit/ProtoBufAdapter.hs @@ -53,9 +53,9 @@ buildSymbolTable existingSymbols block = pbToPublicKey :: PB.PublicKey -> Either String Crypto.PublicKey pbToPublicKey PB.PublicKey{..} = let keyBytes = PB.getField key - parseKey = Crypto.readEd25519PublicKey in case PB.getField algorithm of - PB.Ed25519 -> maybeToRight "Invalid ed25519 public key" $ parseKey keyBytes + PB.Ed25519 -> maybeToRight "Invalid ed25519 public key" $ Crypto.readEd25519PublicKey keyBytes + PB.P256 -> maybeToRight "Invalid P256 public key" $ Crypto.readECDSAP256PublicKey keyBytes pbToOptionalSignature :: PB.ExternalSig -> Either String (Crypto.Signature, Crypto.PublicKey) pbToOptionalSignature PB.ExternalSig{..} = do @@ -76,10 +76,14 @@ pbToSignedBlock PB.SignedBlock{..} = do ) publicKeyToPb :: Crypto.PublicKey -> PB.PublicKey -publicKeyToPb pk = PB.PublicKey +publicKeyToPb pk@(Crypto.Ed25519PublicKey _) = PB.PublicKey { algorithm = PB.putField PB.Ed25519 , key = PB.putField $ Crypto.pkBytes pk } +publicKeyToPb pk@(Crypto.ECDSAP256PublicKey _) = PB.PublicKey + { algorithm = PB.putField PB.P256 + , key = PB.putField $ Crypto.pkBytes pk + } externalSigToPb :: (Crypto.Signature, Crypto.PublicKey) -> PB.ExternalSig externalSigToPb (sig, pk) = PB.ExternalSig @@ -95,9 +99,13 @@ signedBlockToPb (block, sig, pk, eSig) = PB.SignedBlock , externalSig = PB.putField $ externalSigToPb <$> eSig } -pbToProof :: PB.Proof -> Either String (Either Crypto.Signature Crypto.SecretKey) -pbToProof (PB.ProofSignature rawSig) = Left <$> Right (Crypto.signature $ PB.getField rawSig) -pbToProof (PB.ProofSecret rawPk) = Right <$> maybeToRight "Invalid public key proof" (Crypto.readEd25519SecretKey $ PB.getField rawPk) +pbToProof :: Crypto.PublicKey -> PB.Proof -> Either String (Either Crypto.Signature Crypto.SecretKey) +pbToProof _ (PB.ProofSignature rawSig) = Left <$> Right (Crypto.signature $ PB.getField rawSig) +pbToProof lastPublic (PB.ProofSecret rawPk) = + let readSk = case lastPublic of + Crypto.Ed25519PublicKey _ -> Crypto.readEd25519SecretKey + Crypto.ECDSAP256PublicKey _ -> Crypto.readECDSAP256SecretKey + in Right <$> maybeToRight "Invalid secret key proof" (readSk $ PB.getField rawPk) pbToBlock :: Maybe Crypto.PublicKey -> PB.Block -> StateT Symbols (Either String) Block pbToBlock ePk PB.Block{..} = do diff --git a/biscuit/src/Auth/Biscuit/Token.hs b/biscuit/src/Auth/Biscuit/Token.hs index b15755d..426ee83 100644 --- a/biscuit/src/Auth/Biscuit/Token.hs +++ b/biscuit/src/Auth/Biscuit/Token.hs @@ -256,6 +256,11 @@ addBlock block b@Biscuit{..} = do , proof = Open nextSk } +-- | Add a block to an existing biscuit, with an external signature attached. +-- Only 'Open' biscuits can be attenuated; the newly created biscuit is 'Open' as well. +-- Only trusted third parties should be given direct access to the token. +-- 'mkThirdPartyBlockReq', 'mkThirdPartyBlock' and 'applyThirdPartyBlock' are available +-- for letting a non-trusted third party create a signed block. addSignedBlock :: SecretKey -> Block -> Biscuit Open check @@ -272,31 +277,38 @@ addSignedBlock eSk block b@Biscuit{..} = do , proof = Open nextSk } +-- | Create a third-party block request from an 'Open' biscuit. This request contains +-- information needed to properly serialize a block without access to the original +-- token. See 'mkThirdPartyBlockReqB64' if you need the request to be base64-encoded. +mkThirdPartyBlockReq :: Biscuit Open check -> ByteString +mkThirdPartyBlockReq Biscuit{authority,blocks,symbols} = + let (_, _ , lastPk, _) = NE.last $ authority :| blocks + in PB.encodeThirdPartyBlockRequest $ thirdPartyBlockRequestToPb (lastPk, getPkTable symbols) + mkThirdPartyBlock' :: SecretKey -> [PublicKey] -> PublicKey -> Block - -> (ByteString, Signature, PublicKey) -mkThirdPartyBlock' eSk pkTable lastPublicKey block = + -> IO (ByteString, Signature, PublicKey) +mkThirdPartyBlock' eSk pkTable lastPublicKey block = do let symbolsForCurrentBlock = registerNewPublicKeys [toPublic eSk] $ registerNewPublicKeys pkTable newSymbolTable (_, payload) = PB.encodeBlock <$> blockToPb True symbolsForCurrentBlock block - (eSig, ePk) = sign3rdPartyBlock eSk lastPublicKey payload - in (payload, eSig, ePk) + (eSig, ePk) <- sign3rdPartyBlock eSk lastPublicKey payload + pure (payload, eSig, ePk) +-- | Create a third-party block from a block request and a parsed datalog block. +-- See 'mkThirdPartyBlockB64' if you need base64-encoded requests and contents. mkThirdPartyBlock :: SecretKey -> ByteString -> Block - -> Either String ByteString -mkThirdPartyBlock eSk req block = do + -> IO (Either String ByteString) +mkThirdPartyBlock eSk req block = sequenceA $ do (previousPk, pkTable) <- pbToThirdPartyBlockRequest =<< PB.decodeThirdPartyBlockRequest req - pure $ PB.encodeThirdPartyBlockContents . thirdPartyBlockContentsToPb $ mkThirdPartyBlock' eSk pkTable previousPk block - -mkThirdPartyBlockReq :: Biscuit proof check -> ByteString -mkThirdPartyBlockReq Biscuit{authority,blocks,symbols} = - let (_, _ , lastPk, _) = NE.last $ authority :| blocks - in PB.encodeThirdPartyBlockRequest $ thirdPartyBlockRequestToPb (lastPk, getPkTable symbols) + pure (PB.encodeThirdPartyBlockContents . thirdPartyBlockContentsToPb <$> mkThirdPartyBlock' eSk pkTable previousPk block) +-- | Append a signed third-party block to an 'Open' 'Biscuit'. +-- See 'applyThirdPartyBlockB64' if you have base64-encoded contents. applyThirdPartyBlock :: Biscuit Open check -> ByteString -> Either String (IO (Biscuit Open check)) applyThirdPartyBlock b@Biscuit{..} contents = do (payload, eSig, ePk) <- pbToThirdPartyBlockContents =<< PB.decodeThirdPartyBlockContents contents @@ -316,12 +328,12 @@ applyThirdPartyBlock b@Biscuit{..} contents = do -- | Turn an 'Open' biscuit into a 'Sealed' one, preventing it from being attenuated -- further. A 'Sealed' biscuit cannot be turned into an 'Open' one. -seal :: Biscuit Open check -> Biscuit Sealed check -seal b@Biscuit{..} = +seal :: Biscuit Open check -> IO (Biscuit Sealed check) +seal b@Biscuit{..} = do let Open sk = proof ((lastPayload, _), lastSig, lastPk, eSig) = NE.last $ authority :| blocks - newProof = Sealed $ getSignatureProof (lastPayload, lastSig, lastPk, eSig) sk - in b { proof = newProof } + newProof <- Sealed <$> getSignatureProof (lastPayload, lastSig, lastPk, eSig) sk + pure $ b { proof = newProof } -- | Serialize a biscuit to a raw bytestring serializeBiscuit :: BiscuitProof p => Biscuit p Verified -> ByteString @@ -374,7 +386,8 @@ parseBiscuitWrapper bs = do let rootKeyId = fromEnum <$> PB.getField (PB.rootKeyId blockList) signedAuthority <- first (InvalidProtobuf True) $ pbToSignedBlock $ PB.getField $ PB.authority blockList signedBlocks <- first (InvalidProtobuf True) $ traverse pbToSignedBlock $ PB.getField $ PB.blocks blockList - proof <- first (InvalidProtobuf True) $ pbToProof $ PB.getField $ PB.proof blockList + let (_, _, lastPublicKey, _) = NE.last $ signedAuthority :| signedBlocks + proof <- first (InvalidProtobuf True) $ pbToProof lastPublicKey $ PB.getField $ PB.proof blockList pure $ BiscuitWrapper { wAuthority = signedAuthority diff --git a/biscuit/test/Spec/NewCrypto.hs b/biscuit/test/Spec/NewCrypto.hs index e7bff16..b760423 100644 --- a/biscuit/test/Spec/NewCrypto.hs +++ b/biscuit/test/Spec/NewCrypto.hs @@ -55,11 +55,12 @@ appendSigned t@Token{payload} eSk p = do , privKey } -seal :: Token -> SealedToken -seal Token{payload,privKey} = +seal :: Token -> IO SealedToken +seal Token{payload,privKey} = do let lastBlock = NE.last payload - in SealedToken - { sig = getSignatureProof lastBlock privKey + sig <- getSignatureProof lastBlock privKey + pure SealedToken + { sig = sig , payload } @@ -142,8 +143,8 @@ invalidExternalSig = testCase "Invalid external signature" $ do content = "content" token <- signToken content sk attenuated <- appendSigned token eSk "block1" - let bogusSignature = sign eSk ePk ("yolo yolo" :: ByteString) - replaceExternalSig :: SignedBlock -> SignedBlock + bogusSignature <- sign eSk ("yolo yolo" :: ByteString) + let replaceExternalSig :: SignedBlock -> SignedBlock replaceExternalSig (p, s, pk, Just (_, ePk)) = (p, s, pk, Just (bogusSignature, ePk)) replaceExternalSig sb = sb tamper :: Blocks -> Blocks @@ -198,7 +199,7 @@ singleBlockRoundtripSealed = testCase "Single block roundtrip" $ do sk <- generateSecretKey let pk = toPublic sk content = "content" - token <- seal <$> signToken content sk + token <- seal =<< signToken content sk let res = verifySealedToken token pk res @?= True @@ -208,7 +209,7 @@ multiBlockRoundtripSealed = testCase "Multi block roundtrip" $ do let pk = toPublic sk content = "content" token <- signToken content sk - attenuated <- seal <$> append token "block1" + attenuated <- seal =<< append token "block1" let res = verifySealedToken attenuated pk res @?= True @@ -223,7 +224,7 @@ tamperedAuthoritySealed = testCase "Tampered authority" $ do let pk = toPublic sk content = "content" token <- signToken content sk - attenuated <- seal <$> append token "block1" + attenuated <- seal =<< append token "block1" let tamper ((_, s, pk, eS) :| o) = ("tampered", s, pk, eS) :| o tampered = alterPayloadSealed tamper attenuated let res = verifySealedToken tampered pk @@ -235,7 +236,7 @@ tamperedBlockSealed = testCase "Tampered block" $ do let pk = toPublic sk content = "content" token <- signToken content sk - attenuated <- seal <$> append token "block1" + attenuated <- seal =<< append token "block1" let tamper (h :| ((_, s, pk, eS): t)) = h :| (("tampered", s, pk, eS) : t) tampered = alterPayloadSealed tamper attenuated let res = verifySealedToken tampered pk @@ -247,7 +248,7 @@ removedBlockSealed = testCase "Removed block" $ do let pk = toPublic sk content = "content" token <- signToken content sk - attenuated <- seal <$> append token "block1" + attenuated <- seal =<< append token "block1" let tamper (h :| _) = h :| [] tampered = alterPayloadSealed tamper attenuated let res = verifySealedToken tampered pk diff --git a/biscuit/test/Spec/Roundtrip.hs b/biscuit/test/Spec/Roundtrip.hs index f5cbc1c..dc28c13 100644 --- a/biscuit/test/Spec/Roundtrip.hs +++ b/biscuit/test/Spec/Roundtrip.hs @@ -75,7 +75,7 @@ roundtrip'' direct (s,p) i@(authority' :| blocks') = do addSignedBlock sk block biscuit else do let req = mkThirdPartyBlockReq biscuit - thirdPartyBlock <- either (fail . ("req " <>)) pure $ mkThirdPartyBlock sk req block + thirdPartyBlock <- either (fail . ("req " <>)) pure =<< mkThirdPartyBlock sk req block either (fail . ("apply " <>)) id $ applyThirdPartyBlock biscuit thirdPartyBlock addBlocks bs biscuit = case bs of ((Just sk, b):rest) -> addBlocks rest =<< addSignedBlock' sk b biscuit