{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
module Auth.Biscuit.Crypto
  ( SignedBlock
  , Blocks
  , signBlock
  , signExternalBlock
  , sign3rdPartyBlock
  , verifyBlocks
  , verifySecretProof
  , verifySignatureProof
  , getSignatureProof
  , verifyExternalSig
  , 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 qualified Data.List.NonEmpty         as NE
import           Data.Maybe                 (catMaybes, fromJust)
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 $(ByteString -> m Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => ByteString -> m Exp
lift (ByteString -> m Exp) -> ByteString -> m Exp
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
pkBytes PublicKey
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, Signature, PublicKey, Maybe (Signature, PublicKey))
type Blocks = NonEmpty SignedBlock

-- | 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

signBlock :: SecretKey
          -> ByteString
          -> Maybe (Signature, PublicKey)
          -> IO (SignedBlock, SecretKey)
signBlock :: SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlock 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 = (ByteString, (), PublicKey, Maybe (Signature, PublicKey))
-> ByteString
forall a.
(ByteString, a, PublicKey, Maybe (Signature, PublicKey))
-> ByteString
getToSig (ByteString
payload, (), PublicKey
nextPk, Maybe (Signature, PublicKey)
eSig)
      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), SecretKey
nextSk)

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

sign3rdPartyBlock :: SecretKey
                  -> PublicKey
                  -> ByteString
                  -> (Signature, PublicKey)
sign3rdPartyBlock :: SecretKey -> PublicKey -> ByteString -> (Signature, PublicKey)
sign3rdPartyBlock 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)
_todo) 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

getToSig :: (ByteString, a, PublicKey, Maybe (Signature, PublicKey)) -> ByteString
getToSig :: forall a.
(ByteString, a, PublicKey, Maybe (Signature, PublicKey))
-> ByteString
getToSig (ByteString
p, a
_, PublicKey
nextPk, Maybe (Signature, PublicKey)
ePk) =
  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

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

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

-- | 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 :: PublicKey -> (ByteString, Signature, PublicKey) -> Bool
verifyExternalSig 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

verifyBlocks :: Blocks
             -> PublicKey
             -> Bool
verifyBlocks :: Blocks -> PublicKey -> Bool
verifyBlocks Blocks
blocks PublicKey
rootPk =
  let attachKey :: a -> (b, c) -> (a, b, c)
attachKey a
pk (b
payload, c
sig) = (a
pk, b
payload, c
sig)
      uncurry3 :: (t -> t -> t -> t) -> (t, t, t) -> t
uncurry3 t -> t -> t -> t
f (t
a, t
b, t
c) = t -> t -> t -> t
f t
a t
b t
c
      sigs :: NonEmpty Signature
sigs = SignedBlock -> Signature
getSignature (SignedBlock -> Signature) -> Blocks -> NonEmpty Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks
blocks
      toSigs :: NonEmpty ByteString
toSigs = SignedBlock -> ByteString
forall a.
(ByteString, a, PublicKey, Maybe (Signature, PublicKey))
-> ByteString
getToSig (SignedBlock -> ByteString) -> Blocks -> NonEmpty ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks
blocks
      -- key for block 0 is the root key
      -- key for block n is the key from block (n - 1)
      keys :: NonEmpty PublicKey
keys = PublicKey -> NonEmpty PublicKey
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PublicKey
rootPk NonEmpty PublicKey -> NonEmpty PublicKey -> NonEmpty PublicKey
forall a. Semigroup a => a -> a -> a
<> (SignedBlock -> PublicKey
getPublicKey (SignedBlock -> PublicKey) -> Blocks -> NonEmpty PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks
blocks)
      keysPayloadsSigs :: NonEmpty (PublicKey, ByteString, Signature)
keysPayloadsSigs = (PublicKey
 -> (ByteString, Signature) -> (PublicKey, ByteString, Signature))
-> NonEmpty PublicKey
-> NonEmpty (ByteString, Signature)
-> NonEmpty (PublicKey, ByteString, Signature)
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith PublicKey
-> (ByteString, Signature) -> (PublicKey, ByteString, Signature)
forall {a} {b} {c}. a -> (b, c) -> (a, b, c)
attachKey NonEmpty PublicKey
keys (NonEmpty ByteString
-> NonEmpty Signature -> NonEmpty (ByteString, Signature)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty ByteString
toSigs NonEmpty Signature
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 :: [PublicKey]
previousKeys = SignedBlock -> PublicKey
getPublicKey (SignedBlock -> PublicKey) -> [SignedBlock] -> [PublicKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Blocks -> [SignedBlock]
forall a. NonEmpty a -> [a]
NE.init Blocks
blocks
      blocksAfterAuthority :: [SignedBlock]
blocksAfterAuthority = Blocks -> [SignedBlock]
forall a. NonEmpty a -> [a]
NE.tail Blocks
blocks
      eKeysPayloadsESigs :: [(PublicKey, ByteString, Signature)]
eKeysPayloadsESigs = [Maybe (PublicKey, ByteString, Signature)]
-> [(PublicKey, ByteString, Signature)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PublicKey, ByteString, Signature)]
 -> [(PublicKey, ByteString, Signature)])
-> [Maybe (PublicKey, ByteString, Signature)]
-> [(PublicKey, ByteString, Signature)]
forall a b. (a -> b) -> a -> b
$ (PublicKey
 -> SignedBlock -> Maybe (PublicKey, ByteString, Signature))
-> [PublicKey]
-> [SignedBlock]
-> [Maybe (PublicKey, ByteString, Signature)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith PublicKey
-> SignedBlock -> Maybe (PublicKey, ByteString, Signature)
getExternalSigPayload [PublicKey]
previousKeys [SignedBlock]
blocksAfterAuthority
   in  ((PublicKey, ByteString, Signature) -> Bool)
-> NonEmpty (PublicKey, ByteString, Signature) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((PublicKey -> ByteString -> Signature -> Bool)
-> (PublicKey, ByteString, Signature) -> Bool
forall {t} {t} {t} {t}. (t -> t -> t -> t) -> (t, t, t) -> t
uncurry3 PublicKey -> ByteString -> Signature -> Bool
verify) NonEmpty (PublicKey, ByteString, Signature)
keysPayloadsSigs
    Bool -> Bool -> Bool
&& ((PublicKey, ByteString, Signature) -> Bool)
-> [(PublicKey, ByteString, Signature)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((PublicKey -> ByteString -> Signature -> Bool)
-> (PublicKey, ByteString, Signature) -> Bool
forall {t} {t} {t} {t}. (t -> t -> t -> t) -> (t, t, t) -> t
uncurry3 PublicKey -> ByteString -> Signature -> Bool
verify) [(PublicKey, ByteString, Signature)]
eKeysPayloadsESigs

verifySecretProof :: SecretKey
                  -> SignedBlock
                  -> Bool
verifySecretProof :: SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
nextSecret (ByteString
_, Signature
_, PublicKey
lastPk, Maybe (Signature, PublicKey)
_) =
  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)
_) =
  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