module Auth.Biscuit.Crypto
  ( SignedBlock
  , Blocks
  , signBlock
  , verifyBlocks
  , verifySecretProof
  , verifySignatureProof
  , getSignatureProof

  -- Ed25519 reexports
  , PublicKey
  , SecretKey
  , Signature
  , convert
  , publicKey
  , secretKey
  , signature
  , eitherCryptoError
  , maybeCryptoError
  , generateSecretKey
  , toPublic
  ) where

import           Control.Arrow         ((&&&))
import           Crypto.Error          (eitherCryptoError, maybeCryptoError)
import           Crypto.PubKey.Ed25519
import           Data.ByteArray        (convert)
import           Data.ByteString       (ByteString)
import           Data.Int              (Int32)
import           Data.List.NonEmpty    (NonEmpty (..))
import qualified Data.List.NonEmpty    as NE

import qualified Auth.Biscuit.Proto    as PB
import qualified Data.Serialize        as PB

type SignedBlock = (ByteString, 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
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert 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
          -> IO (SignedBlock, SecretKey)
signBlock :: SecretKey -> ByteString -> IO (SignedBlock, SecretKey)
signBlock 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 (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
forall (m :: * -> *). MonadRandom m => m SecretKey
generateSecretKey
  let toSign :: ByteString
toSign = ByteString
payload ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> PublicKey -> ByteString
serializePublicKey PublicKey
nextPk
      sig :: Signature
sig = SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
sign SecretKey
sk PublicKey
pk ByteString
toSign
  (SignedBlock, SecretKey) -> IO (SignedBlock, SecretKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString
payload, Signature
sig, PublicKey
nextPk), SecretKey
nextSk)

getSignatureProof :: SignedBlock -> SecretKey -> Signature
getSignatureProof :: SignedBlock -> SecretKey -> Signature
getSignatureProof (ByteString
lastPayload, Signature
lastSig, PublicKey
lastPk) 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
<> Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Signature
lastSig
   in SecretKey -> PublicKey -> ByteString -> Signature
forall ba.
ByteArrayAccess ba =>
SecretKey -> PublicKey -> ba -> Signature
sign SecretKey
sk PublicKey
pk ByteString
toSign

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

getPublicKey :: SignedBlock -> PublicKey
getPublicKey :: SignedBlock -> PublicKey
getPublicKey (ByteString
_, Signature
_, PublicKey
pk) = PublicKey
pk

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) -> 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
rootPk PublicKey -> [PublicKey] -> NonEmpty PublicKey
forall a. a -> [a] -> NonEmpty a
:| NonEmpty PublicKey -> [PublicKey]
forall a. NonEmpty a -> [a]
NE.init (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)
   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
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
verify) NonEmpty (PublicKey, ByteString, Signature)
keysPayloadsSigs

verifySecretProof :: SecretKey
                  -> SignedBlock
                  -> Bool
verifySecretProof :: SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
nextSecret (ByteString
_, Signature
_, PublicKey
lastPk) =
  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
lastSig, PublicKey
lastPk) =
  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
<> Signature -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert Signature
lastSig
   in PublicKey -> ByteString -> Signature -> Bool
forall ba.
ByteArrayAccess ba =>
PublicKey -> ba -> Signature -> Bool
verify PublicKey
lastPk ByteString
toSign Signature
extraSig