{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
{-|
  Module      : Auth.Biscuit.Crypto
  Copyright   : © Clément Delafargue, 2021
  License     : BSD-3-Clause
  Maintainer  : clement@delafargue.name
  Cryptographic helpers for biscuit signatures
-}
module Auth.Biscuit.Crypto
  ( SignedBlock
  , Blocks
  , signAuthority
  , signAttenuationBlock
  , signExternalBlock
  , sign3rdPartyBlockV1
  , verifyBlocks
  , verifySecretProof
  , verifySignatureProof
  , getSignatureProof
  , verifyExternalSigV1
  , PublicKey
  , pkBytes
  , readEd25519PublicKey
  , SecretKey
  , skBytes
  , readEd25519SecretKey
  , Signature
  , sigBytes
  , signature
  , generateSecretKey
  , toPublic
  , sign
  ) where

import           Control.Arrow              ((&&&))
import           Crypto.Error               (maybeCryptoError)
import qualified Crypto.PubKey.Ed25519      as Ed25519
import           Data.ByteArray             (convert)
import           Data.ByteString            (ByteString)
import           Data.Function              (on)
import           Data.Int                   (Int32)
import           Data.List.NonEmpty         (NonEmpty (..))
import           Data.Maybe                 (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

newtype PublicKey = PublicKey Ed25519.PublicKey
  deriving newtype (PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show)

instance Ord PublicKey where
  compare :: PublicKey -> PublicKey -> Ordering
compare = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> ByteString -> Ordering)
-> (PublicKey -> ByteString) -> PublicKey -> PublicKey -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` PublicKey -> ByteString
serializePublicKey

instance Lift PublicKey where
  lift :: forall (m :: * -> *). Quote m => PublicKey -> m Exp
lift PublicKey
pk = [| fromJust $ readEd25519PublicKey $(lift $ pkBytes pk) |]
#if MIN_VERSION_template_haskell(2,17,0)
  liftTyped :: forall (m :: * -> *). Quote m => PublicKey -> Code m PublicKey
liftTyped = m (TExp PublicKey) -> Code m PublicKey
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m (TExp PublicKey) -> Code m PublicKey)
-> (PublicKey -> m (TExp PublicKey))
-> PublicKey
-> Code m PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m Exp -> m (TExp PublicKey)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce (m Exp -> m (TExp PublicKey))
-> (PublicKey -> m Exp) -> PublicKey -> m (TExp PublicKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => PublicKey -> m Exp
lift
#else
  liftTyped = unsafeTExpCoerce . lift
#endif

newtype SecretKey = SecretKey Ed25519.SecretKey
  deriving newtype (SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> String
show :: SecretKey -> String
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show)
newtype Signature = Signature ByteString
  deriving newtype (Signature -> Signature -> Bool
(Signature -> Signature -> Bool)
-> (Signature -> Signature -> Bool) -> Eq Signature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Signature -> Signature -> Bool
== :: Signature -> Signature -> Bool
$c/= :: Signature -> Signature -> Bool
/= :: Signature -> Signature -> Bool
Eq, Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show)

signature :: ByteString -> Signature
signature :: ByteString -> Signature
signature = ByteString -> Signature
Signature

sigBytes :: Signature -> ByteString
sigBytes :: Signature -> ByteString
sigBytes (Signature ByteString
b) = ByteString
b

readEd25519PublicKey :: ByteString -> Maybe PublicKey
readEd25519PublicKey :: ByteString -> Maybe PublicKey
readEd25519PublicKey ByteString
bs = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey) -> Maybe PublicKey -> Maybe PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CryptoFailable PublicKey -> Maybe PublicKey
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (ByteString -> CryptoFailable PublicKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable PublicKey
Ed25519.publicKey ByteString
bs)

readEd25519SecretKey :: ByteString -> Maybe SecretKey
readEd25519SecretKey :: ByteString -> Maybe SecretKey
readEd25519SecretKey ByteString
bs = SecretKey -> SecretKey
SecretKey (SecretKey -> SecretKey) -> Maybe SecretKey -> Maybe SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CryptoFailable SecretKey -> Maybe SecretKey
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey ByteString
bs)

readEd25519Signature :: Signature -> Maybe Ed25519.Signature
readEd25519Signature :: Signature -> Maybe Signature
readEd25519Signature (Signature ByteString
bs) = CryptoFailable Signature -> Maybe Signature
forall a. CryptoFailable a -> Maybe a
maybeCryptoError (ByteString -> CryptoFailable Signature
forall ba. ByteArrayAccess ba => ba -> CryptoFailable Signature
Ed25519.signature ByteString
bs)

-- | Generate a public key from a secret key
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic (SecretKey SecretKey
sk) = PublicKey -> PublicKey
PublicKey (PublicKey -> PublicKey) -> PublicKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
Ed25519.toPublic SecretKey
sk

generateSecretKey :: IO SecretKey
generateSecretKey :: IO SecretKey
generateSecretKey = SecretKey -> SecretKey
SecretKey (SecretKey -> SecretKey) -> IO SecretKey -> IO SecretKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SecretKey
forall (m :: * -> *). MonadRandom m => m SecretKey
Ed25519.generateSecretKey

sign :: SecretKey -> PublicKey -> ByteString -> Signature
sign :: SecretKey -> PublicKey -> ByteString -> Signature
sign (SecretKey SecretKey
sk) (PublicKey PublicKey
pk) ByteString
payload =
  ByteString -> Signature
Signature (ByteString -> Signature)
-> (Signature -> ByteString) -> Signature -> Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (Signature -> Signature) -> Signature -> Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
Ed25519.sign SecretKey
sk PublicKey
pk ByteString
payload

verify :: PublicKey -> ByteString -> Signature -> Bool
verify :: PublicKey -> ByteString -> Signature -> Bool
verify (PublicKey PublicKey
pk) ByteString
payload Signature
sig =
  case Signature -> Maybe Signature
readEd25519Signature Signature
sig of
    Just Signature
sig' -> PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
Ed25519.verify PublicKey
pk ByteString
payload Signature
sig'
    Maybe Signature
Nothing   -> Bool
False

pkBytes :: PublicKey -> ByteString
pkBytes :: PublicKey -> ByteString
pkBytes (PublicKey PublicKey
pk) = PublicKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert PublicKey
pk

skBytes :: SecretKey -> ByteString
skBytes :: SecretKey -> ByteString
skBytes (SecretKey SecretKey
sk) = SecretKey -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert SecretKey
sk

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
-- serializing itself is handled by protobuf, but we still need to manually
-- serialize keys when we include them in something we want sign (block
-- signatures, and the final signature for sealed tokens).
serializePublicKey :: PublicKey -> ByteString
serializePublicKey :: PublicKey -> ByteString
serializePublicKey PublicKey
pk =
  let keyBytes :: ByteString
keyBytes = PublicKey -> ByteString
pkBytes PublicKey
pk
      algId :: Int32
      algId :: Int32
algId = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Algorithm -> Int
forall a. Enum a => a -> Int
fromEnum Algorithm
PB.Ed25519
      -- The spec mandates that we serialize the algorithm id as a little-endian int32
      algBytes :: ByteString
algBytes = Put -> ByteString
PB.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Int32
PB.putInt32le Int32
algId
   in ByteString
algBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
keyBytes

signBlockV0 :: SecretKey
            -> ByteString
            -> Maybe (Signature, PublicKey)
            -> IO (SignedBlock, SecretKey)
signBlockV0 :: SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlockV0 SecretKey
sk ByteString
payload Maybe (Signature, PublicKey)
eSig = do
  let pk :: PublicKey
pk = SecretKey -> PublicKey
toPublic SecretKey
sk
  (PublicKey
nextPk, SecretKey
nextSk) <- (SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey)
-> (SecretKey -> SecretKey) -> SecretKey -> (PublicKey, SecretKey)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SecretKey -> SecretKey
forall a. a -> a
id) (SecretKey -> (PublicKey, SecretKey))
-> IO SecretKey -> IO (PublicKey, SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SecretKey
generateSecretKey
  let toSign :: ByteString
toSign = AnySignedBlock () -> ByteString
forall a. AnySignedBlock a -> ByteString
getSignaturePayloadV0 (ByteString
payload, (), PublicKey
nextPk, Maybe (Signature, PublicKey)
eSig, Maybe Int
forall a. Maybe a
Nothing)
      sig :: Signature
sig = SecretKey -> PublicKey -> ByteString -> Signature
sign SecretKey
sk PublicKey
pk ByteString
toSign
  (SignedBlock, SecretKey) -> IO (SignedBlock, SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString
payload, Signature
sig, PublicKey
nextPk, Maybe (Signature, PublicKey)
eSig, Maybe Int
forall a. Maybe a
Nothing), SecretKey
nextSk)

signExternalBlockV0 :: SecretKey
                    -> SecretKey
                    -> PublicKey
                    -> ByteString
                    -> IO (SignedBlock, SecretKey)
signExternalBlockV0 :: SecretKey
-> SecretKey
-> PublicKey
-> ByteString
-> IO (SignedBlock, SecretKey)
signExternalBlockV0 SecretKey
sk SecretKey
eSk PublicKey
pk ByteString
payload =
  let eSig :: (Signature, PublicKey)
eSig = SecretKey -> PublicKey -> ByteString -> (Signature, PublicKey)
sign3rdPartyBlockV0 SecretKey
eSk PublicKey
pk ByteString
payload
   in SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlockV0 SecretKey
sk ByteString
payload ((Signature, PublicKey) -> Maybe (Signature, PublicKey)
forall a. a -> Maybe a
Just (Signature, PublicKey)
eSig)

sign3rdPartyBlockV0 :: SecretKey
                    -> PublicKey
                    -> ByteString
                    -> (Signature, PublicKey)
sign3rdPartyBlockV0 :: SecretKey -> PublicKey -> ByteString -> (Signature, PublicKey)
sign3rdPartyBlockV0 SecretKey
eSk PublicKey
nextPk ByteString
payload =
  let toSign :: ByteString
toSign = ByteString
payload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
nextPk
      ePk :: PublicKey
ePk = SecretKey -> PublicKey
toPublic SecretKey
eSk
      eSig :: Signature
eSig = SecretKey -> PublicKey -> ByteString -> Signature
sign SecretKey
eSk PublicKey
ePk ByteString
toSign
   in (Signature
eSig, PublicKey
ePk)

getSignatureProof :: SignedBlock -> SecretKey -> Signature
getSignatureProof :: SignedBlock -> SecretKey -> Signature
getSignatureProof (ByteString
lastPayload, Signature ByteString
lastSig, PublicKey
lastPk, Maybe (Signature, PublicKey)
_, Maybe Int
_) SecretKey
nextSecret =
  let sk :: SecretKey
sk = SecretKey
nextSecret
      pk :: PublicKey
pk = SecretKey -> PublicKey
toPublic SecretKey
nextSecret
      toSign :: ByteString
toSign = ByteString
lastPayload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
lastPk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lastSig
   in SecretKey -> PublicKey -> ByteString -> Signature
sign SecretKey
sk PublicKey
pk ByteString
toSign

getSignaturePayloadV0 :: AnySignedBlock a -> ByteString
getSignaturePayloadV0 :: forall a. AnySignedBlock a -> ByteString
getSignaturePayloadV0 (ByteString
p, a
_, PublicKey
nextPk, Maybe (Signature, PublicKey)
ePk, Maybe Int
_) =
  ByteString
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ((Signature, PublicKey) -> ByteString)
-> Maybe (Signature, PublicKey) -> ByteString
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Signature -> ByteString
sigBytes (Signature -> ByteString)
-> ((Signature, PublicKey) -> Signature)
-> (Signature, PublicKey)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Signature, PublicKey) -> Signature
forall a b. (a, b) -> a
fst) Maybe (Signature, PublicKey)
ePk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
nextPk

-- | 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)
getExternalSignaturePayloadV0 :: PublicKey -> SignedBlock -> Maybe (PublicKey, ByteString, Signature)
getExternalSignaturePayloadV0 :: PublicKey
-> SignedBlock -> Maybe (PublicKey, ByteString, Signature)
getExternalSignaturePayloadV0 PublicKey
pkN (ByteString
payload, Signature
_, PublicKey
_, Just (Signature
eSig, PublicKey
ePk), Maybe Int
_) = (PublicKey, ByteString, Signature)
-> Maybe (PublicKey, ByteString, Signature)
forall a. a -> Maybe a
Just (PublicKey
ePk, ByteString
payload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
pkN, Signature
eSig)
getExternalSignaturePayloadV0 PublicKey
_ SignedBlock
_ = Maybe (PublicKey, ByteString, Signature)
forall a. Maybe a
Nothing

getAuthoritySignaturePayloadV1 :: ByteString -> PublicKey -> ByteString
getAuthoritySignaturePayloadV1 :: ByteString -> PublicKey -> ByteString
getAuthoritySignaturePayloadV1 ByteString
p PublicKey
nextPk =
  ByteString
"\0BLOCK\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  ByteString
"\0VERSION\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Put -> ByteString
PB.runPut (Putter Int32
PB.putInt32le Int32
1) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  ByteString
"\0PAYLOAD\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  PublicKey -> ByteString
serializePublicKeyV1 PublicKey
nextPk

getBlockSignaturePayloadV1 :: ByteString -> PublicKey -> Maybe (Signature, PublicKey) -> Signature -> ByteString
getBlockSignaturePayloadV1 :: ByteString
-> PublicKey
-> Maybe (Signature, PublicKey)
-> Signature
-> ByteString
getBlockSignaturePayloadV1 ByteString
p PublicKey
nextPk Maybe (Signature, PublicKey)
ePk Signature
prevSig =
  ByteString -> PublicKey -> ByteString
getAuthoritySignaturePayloadV1 ByteString
p PublicKey
nextPk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
    ByteString
"\0PREVSIG\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Signature -> ByteString
sigBytes Signature
prevSig ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
    ((Signature, PublicKey) -> ByteString)
-> Maybe (Signature, PublicKey) -> ByteString
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Signature, PublicKey) -> ByteString
serializeExternalSignatureV1 Maybe (Signature, PublicKey)
ePk

getExternalSignaturePayloadV1 :: ByteString -> Signature -> ByteString
getExternalSignaturePayloadV1 :: ByteString -> Signature -> ByteString
getExternalSignaturePayloadV1 ByteString
payload Signature
prevSig =
  ByteString
"\0EXTERNAL\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  ByteString
"\0VERSION\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Put -> ByteString
PB.runPut (Putter Int32
PB.putInt32le Int32
1) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  ByteString
"\0PAYLOAD\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
payload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
  ByteString
"\0PREVSIG\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Signature -> ByteString
sigBytes Signature
prevSig

serializePublicKeyV1 :: PublicKey -> ByteString
serializePublicKeyV1 :: PublicKey -> ByteString
serializePublicKeyV1 PublicKey
pk =
  let keyBytes :: ByteString
keyBytes = PublicKey -> ByteString
pkBytes PublicKey
pk
      algId :: Int32
      algId :: Int32
algId = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Algorithm -> Int
forall a. Enum a => a -> Int
fromEnum Algorithm
PB.Ed25519
      -- The spec mandates that we serialize the algorithm id as a little-endian int32
      algBytes :: ByteString
algBytes = Put -> ByteString
PB.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter Int32
PB.putInt32le Int32
algId
   in ByteString
"\0ALGORITHM\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
algBytes ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>
      ByteString
"\0NEXTKEY\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
keyBytes

serializeExternalSignatureV1 :: (Signature, PublicKey) -> ByteString
serializeExternalSignatureV1 :: (Signature, PublicKey) -> ByteString
serializeExternalSignatureV1 (Signature
sig, PublicKey
_) = ByteString
"\0EXTERNALSIG\0" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Signature -> ByteString
sigBytes Signature
sig

getSignature :: SignedBlock -> Signature
getSignature :: SignedBlock -> Signature
getSignature (ByteString
_, Signature
sig, PublicKey
_, Maybe (Signature, PublicKey)
_, Maybe Int
_) = Signature
sig

getPublicKey :: SignedBlock -> PublicKey
getPublicKey :: SignedBlock -> PublicKey
getPublicKey (ByteString
_, Signature
_, PublicKey
pk, Maybe (Signature, PublicKey)
_, Maybe Int
_) = PublicKey
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)
verifyExternalSigV0 :: PublicKey -> (ByteString, Signature, PublicKey) -> Bool
verifyExternalSigV0 :: PublicKey -> (ByteString, Signature, PublicKey) -> Bool
verifyExternalSigV0 PublicKey
previousPk (ByteString
payload, Signature
eSig, PublicKey
ePk) =
  PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
ePk (ByteString
payload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
previousPk) Signature
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 :: Signature -> (ByteString, Signature, PublicKey) -> Bool
verifyExternalSigV1 Signature
prevSig (ByteString
payload, Signature
eSig, PublicKey
ePk) =
  PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
ePk (ByteString -> Signature -> ByteString
getExternalSignaturePayloadV1 ByteString
payload Signature
prevSig) Signature
eSig

verifyAuthorityBlock :: SignedBlock -> PublicKey -> Bool
verifyAuthorityBlock :: SignedBlock -> PublicKey -> Bool
verifyAuthorityBlock b :: SignedBlock
b@(ByteString
payload, Signature
sig, PublicKey
nextPk, Maybe (Signature, PublicKey)
_, Maybe Int
version) PublicKey
rootPk =
  case Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
version of
    Int
0 -> PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
rootPk (SignedBlock -> ByteString
forall a. AnySignedBlock a -> ByteString
getSignaturePayloadV0 SignedBlock
b) Signature
sig
    Int
1 -> PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
rootPk (ByteString -> PublicKey -> ByteString
getAuthoritySignaturePayloadV1 ByteString
payload PublicKey
nextPk) Signature
sig
    Int
_ -> Bool
False

verifyAttenuationBlock :: SignedBlock -> SignedBlock -> Bool
verifyAttenuationBlock :: SignedBlock -> SignedBlock -> Bool
verifyAttenuationBlock SignedBlock
block SignedBlock
previousBlock =
  let (ByteString
payload, Signature
sig, PublicKey
nextPk, Maybe (Signature, PublicKey)
eSig', Maybe Int
version) = SignedBlock
block
      (ByteString
_, Signature
prevSig, PublicKey
pk, Maybe (Signature, PublicKey)
_, Maybe Int
_) = SignedBlock
previousBlock
   in case (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 Maybe Int
version, Maybe (Signature, PublicKey)
eSig') of
        (Int
0, Maybe (Signature, PublicKey)
Nothing) -> PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
pk (SignedBlock -> ByteString
forall a. AnySignedBlock a -> ByteString
getSignaturePayloadV0 SignedBlock
block) Signature
sig
        (Int
0, Just (Signature, PublicKey)
_)  -> Bool
False -- reject third-party blocks with v0 signatures
        (Int
1, Maybe (Signature, PublicKey)
Nothing) -> PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
pk (ByteString
-> PublicKey
-> Maybe (Signature, PublicKey)
-> Signature
-> ByteString
getBlockSignaturePayloadV1 ByteString
payload PublicKey
nextPk Maybe (Signature, PublicKey)
eSig' Signature
prevSig) Signature
sig
        (Int
1, Just (Signature
eSig, PublicKey
ePk)) ->
          let sv :: Bool
sv = PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
pk (ByteString
-> PublicKey
-> Maybe (Signature, PublicKey)
-> Signature
-> ByteString
getBlockSignaturePayloadV1 ByteString
payload PublicKey
nextPk Maybe (Signature, PublicKey)
eSig' Signature
prevSig) Signature
sig
              ev :: Bool
ev = PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
ePk (ByteString -> Signature -> ByteString
getExternalSignaturePayloadV1 ByteString
payload Signature
prevSig) Signature
eSig
           in Bool
sv Bool -> Bool -> Bool
&& Bool
ev
        (Int, Maybe (Signature, PublicKey))
_          -> Bool
False

verifyBlocks :: Blocks
             -> PublicKey
             -> Bool
verifyBlocks :: Blocks -> PublicKey -> Bool
verifyBlocks (SignedBlock
authority :| [SignedBlock]
attenuationBlocks) PublicKey
rootPk =
  let attenuationBlocks' :: [(SignedBlock, SignedBlock)]
attenuationBlocks' = [SignedBlock] -> [SignedBlock] -> [(SignedBlock, SignedBlock)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SignedBlock]
attenuationBlocks (SignedBlock
authority SignedBlock -> [SignedBlock] -> [SignedBlock]
forall a. a -> [a] -> [a]
: [SignedBlock]
attenuationBlocks)
   in SignedBlock -> PublicKey -> Bool
verifyAuthorityBlock SignedBlock
authority PublicKey
rootPk
  Bool -> Bool -> Bool
&& ((SignedBlock, SignedBlock) -> Bool)
-> [(SignedBlock, SignedBlock)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((SignedBlock -> SignedBlock -> Bool)
-> (SignedBlock, SignedBlock) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SignedBlock -> SignedBlock -> Bool
verifyAttenuationBlock) [(SignedBlock, SignedBlock)]
attenuationBlocks'

verifySecretProof :: SecretKey
                  -> SignedBlock
                  -> Bool
verifySecretProof :: SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
nextSecret (ByteString
_, Signature
_, PublicKey
lastPk, Maybe (Signature, PublicKey)
_, Maybe Int
_) =
  PublicKey
lastPk PublicKey -> PublicKey -> Bool
forall a. Eq a => a -> a -> Bool
== SecretKey -> PublicKey
toPublic SecretKey
nextSecret


verifySignatureProof :: Signature
                     -> SignedBlock
                     -> Bool
verifySignatureProof :: Signature -> SignedBlock -> Bool
verifySignatureProof Signature
extraSig (ByteString
lastPayload, Signature ByteString
lastSig, PublicKey
lastPk, Maybe (Signature, PublicKey)
_, Maybe Int
_) =
  let toSign :: ByteString
toSign = ByteString
lastPayload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
lastPk ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
lastSig
   in PublicKey -> ByteString -> Signature -> Bool
verify PublicKey
lastPk ByteString
toSign Signature
extraSig

signAuthorityBlockV1 :: SecretKey -> ByteString -> IO (SignedBlock, SecretKey)
signAuthorityBlockV1 :: SecretKey -> ByteString -> IO (SignedBlock, SecretKey)
signAuthorityBlockV1 SecretKey
sk ByteString
payload = do
  let pk :: PublicKey
pk = SecretKey -> PublicKey
toPublic SecretKey
sk
  (PublicKey
nextPk, SecretKey
nextSk) <- (SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey)
-> (SecretKey -> SecretKey) -> SecretKey -> (PublicKey, SecretKey)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SecretKey -> SecretKey
forall a. a -> a
id) (SecretKey -> (PublicKey, SecretKey))
-> IO SecretKey -> IO (PublicKey, SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SecretKey
generateSecretKey
  let toSign :: ByteString
toSign = ByteString -> PublicKey -> ByteString
getAuthoritySignaturePayloadV1 ByteString
payload PublicKey
nextPk
      sig :: Signature
sig = SecretKey -> PublicKey -> ByteString -> Signature
sign SecretKey
sk PublicKey
pk ByteString
toSign
  (SignedBlock, SecretKey) -> IO (SignedBlock, SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString
payload, Signature
sig, PublicKey
nextPk, Maybe (Signature, PublicKey)
forall a. Maybe a
Nothing, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1), SecretKey
nextSk)

signAttenuationBlockV1 :: SecretKey -> Signature -> ByteString -> Maybe (Signature, PublicKey) -> IO (SignedBlock, SecretKey)
signAttenuationBlockV1 :: SecretKey
-> Signature
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signAttenuationBlockV1 SecretKey
sk Signature
prevSig ByteString
payload Maybe (Signature, PublicKey)
ePk = do
  let pk :: PublicKey
pk = SecretKey -> PublicKey
toPublic SecretKey
sk
  (PublicKey
nextPk, SecretKey
nextSk) <- (SecretKey -> PublicKey
toPublic (SecretKey -> PublicKey)
-> (SecretKey -> SecretKey) -> SecretKey -> (PublicKey, SecretKey)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& SecretKey -> SecretKey
forall a. a -> a
id) (SecretKey -> (PublicKey, SecretKey))
-> IO SecretKey -> IO (PublicKey, SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO SecretKey
generateSecretKey
  let toSign :: ByteString
toSign = ByteString
-> PublicKey
-> Maybe (Signature, PublicKey)
-> Signature
-> ByteString
getBlockSignaturePayloadV1 ByteString
payload PublicKey
nextPk Maybe (Signature, PublicKey)
ePk Signature
prevSig
      sig :: Signature
sig = SecretKey -> PublicKey -> ByteString -> Signature
sign SecretKey
sk PublicKey
pk ByteString
toSign
  (SignedBlock, SecretKey) -> IO (SignedBlock, SecretKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString
payload, Signature
sig, PublicKey
nextPk, Maybe (Signature, PublicKey)
ePk, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1), SecretKey
nextSk)

sign3rdPartyBlockV1 :: SecretKey
                    -> Signature
                    -> ByteString
                    -> (Signature, PublicKey)
sign3rdPartyBlockV1 :: SecretKey -> Signature -> ByteString -> (Signature, PublicKey)
sign3rdPartyBlockV1 SecretKey
eSk Signature
prevSig ByteString
payload =
  let toSign :: ByteString
toSign = ByteString -> Signature -> ByteString
getExternalSignaturePayloadV1 ByteString
payload Signature
prevSig
      ePk :: PublicKey
ePk = SecretKey -> PublicKey
toPublic SecretKey
eSk
      eSig :: Signature
eSig = SecretKey -> PublicKey -> ByteString -> Signature
sign SecretKey
eSk PublicKey
ePk ByteString
toSign
   in (Signature
eSig, PublicKey
ePk)

signAuthority :: SecretKey
              -> (ByteString, Int)
              -> IO (SignedBlock, SecretKey)
signAuthority :: SecretKey -> (ByteString, Int) -> IO (SignedBlock, SecretKey)
signAuthority SecretKey
secretKey (ByteString
payload, Int
blockVersion)
  | Int
blockVersion Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6 = SecretKey -> ByteString -> IO (SignedBlock, SecretKey)
signAuthorityBlockV1 SecretKey
secretKey ByteString
payload
  | Bool
otherwise = SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlockV0 SecretKey
secretKey ByteString
payload Maybe (Signature, PublicKey)
forall a. Maybe a
Nothing

signAttenuationBlock :: SecretKey
                     -> Signature
                     -> (ByteString, Int)
                     -> Maybe (Signature, PublicKey)
                     -> IO (SignedBlock, SecretKey)
signAttenuationBlock :: SecretKey
-> Signature
-> (ByteString, Int)
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signAttenuationBlock SecretKey
secretKey Signature
prevSig (ByteString
payload, Int
blockVersion) Maybe (Signature, PublicKey)
ePk
  | Int
blockVersion Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6 Bool -> Bool -> Bool
|| Maybe (Signature, PublicKey) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Signature, PublicKey)
ePk = SecretKey
-> Signature
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signAttenuationBlockV1 SecretKey
secretKey Signature
prevSig ByteString
payload Maybe (Signature, PublicKey)
ePk
  | Bool
otherwise = SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlockV0 SecretKey
secretKey ByteString
payload Maybe (Signature, PublicKey)
ePk

signExternalBlock :: SecretKey
                  -> Signature
                  -> (ByteString, Int)
                  -> SecretKey
                  -> IO (SignedBlock, SecretKey)
signExternalBlock :: SecretKey
-> Signature
-> (ByteString, Int)
-> SecretKey
-> IO (SignedBlock, SecretKey)
signExternalBlock SecretKey
secretKey Signature
prevSig (ByteString
payload, Int
blockVersion) SecretKey
eSk =
   let ePk :: (Signature, PublicKey)
ePk = SecretKey -> Signature -> ByteString -> (Signature, PublicKey)
sign3rdPartyBlockV1 SecretKey
eSk Signature
prevSig ByteString
payload
    in SecretKey
-> Signature
-> (ByteString, Int)
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signAttenuationBlock SecretKey
secretKey Signature
prevSig (ByteString
payload, Int
blockVersion) ((Signature, PublicKey) -> Maybe (Signature, PublicKey)
forall a. a -> Maybe a
Just (Signature, PublicKey)
ePk)