Ecdsa support

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 <https://github.com/biscuit-auth/biscuit-haskell#readme>
@@ -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,

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 <https://github.com/biscuit-auth/biscuit-haskell#readme>

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

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,37 +165,35 @@ 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
                   -> 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) =

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

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