{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE KindSignatures     #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE RecordWildCards    #-}
{- HLINT ignore "Reduce duplication" -}
{-|
  Module      : Auth.Biscuit.Token
  Copyright   : © Clément Delafargue, 2021
  License     : MIT
  Maintainer  : clement@delafargue.name
  Module defining the main biscuit-related operations
-}
module Auth.Biscuit.Token
  ( Biscuit
  , rootKeyId
  , symbols
  , authority
  , blocks
  , proof
  , proofCheck
  , queryRawBiscuitFacts
  , ParseError (..)
  , ExistingBlock
  , ParsedSignedBlock
  , AuthorizedBiscuit (..)
  , queryAuthorizerFacts
  -- $openOrSealed
  , OpenOrSealed
  , Open
  , Sealed
  , BiscuitProof (..)
  , Verified
  , Unverified
  , mkBiscuit
  , mkBiscuitWith
  , addBlock
  , addSignedBlock
  , BiscuitEncoding (..)
  , ParserConfig (..)
  , parseBiscuitWith
  , parseBiscuitUnverified
  , checkBiscuitSignatures
  , serializeBiscuit
  , authorizeBiscuit
  , authorizeBiscuitWithLimits
  , fromOpen
  , fromSealed
  , asOpen
  , asSealed
  , seal

  , getRevocationIds
  , getVerifiedBiscuitPublicKey

  -- third party
  , mkThirdPartyBlockReq
  , mkThirdPartyBlock
  , applyThirdPartyBlock
  ) where

import           Control.Monad                       (join, unless, when)
import           Control.Monad.State                 (lift, mapStateT,
                                                      runStateT)
import           Data.Bifunctor                      (first)
import           Data.ByteString                     (ByteString)
import qualified Data.ByteString.Base64.URL          as B64
import           Data.Foldable                       (fold)
import           Data.List.NonEmpty                  (NonEmpty ((:|)))
import qualified Data.List.NonEmpty                  as NE
import           Data.Set                            (Set)
import qualified Data.Set                            as Set

import           Auth.Biscuit.Crypto                 (PublicKey, SecretKey,
                                                      Signature, SignedBlock,
                                                      getSignatureProof,
                                                      sigBytes,
                                                      sign3rdPartyBlock,
                                                      signBlock,
                                                      signExternalBlock,
                                                      skBytes, toPublic,
                                                      verifyBlocks,
                                                      verifyExternalSig,
                                                      verifySecretProof,
                                                      verifySignatureProof)
import           Auth.Biscuit.Datalog.AST            (Authorizer, Block, Query,
                                                      toEvaluation)
import           Auth.Biscuit.Datalog.Executor       (Bindings, ExecutionError,
                                                      Limits, defaultLimits)
import           Auth.Biscuit.Datalog.ScopedExecutor (AuthorizationSuccess,
                                                      collectWorld,
                                                      queryAvailableFacts,
                                                      queryGeneratedFacts,
                                                      runAuthorizerWithLimits)
import qualified Auth.Biscuit.Proto                  as PB
import           Auth.Biscuit.ProtoBufAdapter        (blockToPb, pbToBlock,
                                                      pbToProof,
                                                      pbToSignedBlock,
                                                      pbToThirdPartyBlockContents,
                                                      pbToThirdPartyBlockRequest,
                                                      signedBlockToPb,
                                                      thirdPartyBlockContentsToPb,
                                                      thirdPartyBlockRequestToPb)
import           Auth.Biscuit.Symbols

-- | Protobuf serialization does not have a guaranteed deterministic behaviour,
-- so we need to keep the initial serialized payload around in order to compute
-- a new signature when adding a block.
type ExistingBlock = (ByteString, Block)
type ParsedSignedBlock = (ExistingBlock, Signature, PublicKey, Maybe (Signature, PublicKey))

-- $openOrSealed
--
-- Biscuit tokens can be /open/ (capable of being attenuated further) or
-- /sealed/ (not capable of being attenuated further). Some operations
-- like verification work on both kinds, while others (like attenuation)
-- only work on a single kind. The 'OpenOrSealed', 'Open' and 'Sealed' trio
-- represents the different possibilities. 'OpenOrSealed' is usually obtained
-- through parsing, while 'Open' is obtained by creating a new biscuit (or
-- attenuating an existing one), and 'Sealed' is obtained by sealing an open
-- biscuit

-- | This datatype represents the final proof of a biscuit, which can be either
-- /open/ or /sealed/. This is the typical state of a biscuit that's been parsed.
data OpenOrSealed
  = SealedProof Signature
  | OpenProof SecretKey
  deriving (OpenOrSealed -> OpenOrSealed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpenOrSealed -> OpenOrSealed -> Bool
$c/= :: OpenOrSealed -> OpenOrSealed -> Bool
== :: OpenOrSealed -> OpenOrSealed -> Bool
$c== :: OpenOrSealed -> OpenOrSealed -> Bool
Eq, Int -> OpenOrSealed -> ShowS
[OpenOrSealed] -> ShowS
OpenOrSealed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpenOrSealed] -> ShowS
$cshowList :: [OpenOrSealed] -> ShowS
show :: OpenOrSealed -> String
$cshow :: OpenOrSealed -> String
showsPrec :: Int -> OpenOrSealed -> ShowS
$cshowsPrec :: Int -> OpenOrSealed -> ShowS
Show)

-- | This datatype represents the final proof of a biscuit statically known to be
-- /open/ (capable of being attenuated further). In that case the proof is a secret
-- key that can be used to sign a new block.
newtype Open = Open SecretKey
  deriving stock (Open -> Open -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Open -> Open -> Bool
$c/= :: Open -> Open -> Bool
== :: Open -> Open -> Bool
$c== :: Open -> Open -> Bool
Eq, Int -> Open -> ShowS
[Open] -> ShowS
Open -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Open] -> ShowS
$cshowList :: [Open] -> ShowS
show :: Open -> String
$cshow :: Open -> String
showsPrec :: Int -> Open -> ShowS
$cshowsPrec :: Int -> Open -> ShowS
Show)

-- | This datatype represents the final proof of a biscuit statically known to be
-- /sealed/ (not capable of being attenuated further). In that case the proof is a
-- signature proving that the party who sealed the token did know the last secret
-- key.
newtype Sealed = Sealed Signature
  deriving stock (Sealed -> Sealed -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sealed -> Sealed -> Bool
$c/= :: Sealed -> Sealed -> Bool
== :: Sealed -> Sealed -> Bool
$c== :: Sealed -> Sealed -> Bool
Eq, Int -> Sealed -> ShowS
[Sealed] -> ShowS
Sealed -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sealed] -> ShowS
$cshowList :: [Sealed] -> ShowS
show :: Sealed -> String
$cshow :: Sealed -> String
showsPrec :: Int -> Sealed -> ShowS
$cshowsPrec :: Int -> Sealed -> ShowS
Show)

-- | This class allows functions working on both open and sealed biscuits to accept
-- indifferently 'OpenOrSealed', 'Open' or 'Sealed' biscuits. It has no laws, it only
-- projects 'Open' and 'Sealed' to the general 'OpenOrSealed' case.
class BiscuitProof a where
  toPossibleProofs :: a -> OpenOrSealed

instance BiscuitProof OpenOrSealed where
  toPossibleProofs :: OpenOrSealed -> OpenOrSealed
toPossibleProofs = forall a. a -> a
id
instance BiscuitProof Sealed where
  toPossibleProofs :: Sealed -> OpenOrSealed
toPossibleProofs (Sealed Signature
sig) = Signature -> OpenOrSealed
SealedProof Signature
sig
instance BiscuitProof Open where
  toPossibleProofs :: Open -> OpenOrSealed
toPossibleProofs (Open SecretKey
sk) = SecretKey -> OpenOrSealed
OpenProof SecretKey
sk

-- $verifiedOrUnverified
--
-- The default parsing mechanism for biscuits checks the signature before parsing the blocks
-- contents (this reduces the attack surface, as only biscuits with a valid signature are parsed).
-- In some cases, we still want to operate on biscuits without knowing the public key necessary
-- to check signatures (eg for inspection, or for generically adding attenuation blocks). In that
-- case, we can have parsed tokens which signatures have /not/ been verified. In order to
-- accidentally forgetting to check signatures, parsed biscuits keep track of whether the
-- signatures have been verified with a dedicated type parameter, which can be instantiated with
-- two types: 'Verified' and 'Unverified'. 'Verified' additionally keeps track of the 'PublicKey'
-- that has been used to verify the signatures.

-- | Proof that a biscuit had its signatures verified with the carried root 'PublicKey'
newtype Verified = Verified PublicKey
  deriving stock (Verified -> Verified -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Verified -> Verified -> Bool
$c/= :: Verified -> Verified -> Bool
== :: Verified -> Verified -> Bool
$c== :: Verified -> Verified -> Bool
Eq, Int -> Verified -> ShowS
[Verified] -> ShowS
Verified -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Verified] -> ShowS
$cshowList :: [Verified] -> ShowS
show :: Verified -> String
$cshow :: Verified -> String
showsPrec :: Int -> Verified -> ShowS
$cshowsPrec :: Int -> Verified -> ShowS
Show)

-- | Marker that a biscuit was parsed without having its signatures verified. Such a biscuit
-- cannot be trusted yet.
data Unverified = Unverified
  deriving stock (Unverified -> Unverified -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unverified -> Unverified -> Bool
$c/= :: Unverified -> Unverified -> Bool
== :: Unverified -> Unverified -> Bool
$c== :: Unverified -> Unverified -> Bool
Eq, Int -> Unverified -> ShowS
[Unverified] -> ShowS
Unverified -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unverified] -> ShowS
$cshowList :: [Unverified] -> ShowS
show :: Unverified -> String
$cshow :: Unverified -> String
showsPrec :: Int -> Unverified -> ShowS
$cshowsPrec :: Int -> Unverified -> ShowS
Show)

-- | A parsed biscuit. The @proof@ type param can be one of 'Open', 'Sealed' or 'OpenOrSealed'.
-- It describes whether a biscuit is open to further attenuation, or sealed and not modifyable
-- further.
--
-- The @check@ type param can be either 'Verified' or 'Unverified' and keeps track of whether
-- the blocks signatures (and final proof) have been verified with a given root 'PublicKey'.
--
-- The constructor is not exposed in order to ensure that 'Biscuit' values can only be created
-- by trusted code paths.
data Biscuit proof check
  = Biscuit
  { forall proof check. Biscuit proof check -> Maybe Int
rootKeyId  :: Maybe Int
  -- ^ an optional identifier for the expected public key
  , forall proof check. Biscuit proof check -> Symbols
symbols    :: Symbols
  -- ^ The symbols already defined in the contained blocks
  , forall proof check. Biscuit proof check -> ParsedSignedBlock
authority  :: ParsedSignedBlock
  -- ^ The authority block, along with the associated public key. The public key
  -- is kept around since it's embedded in the serialized biscuit, but should not
  -- be used for verification. An externally provided public key should be used instead.
  , forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks     :: [ParsedSignedBlock]
  -- ^ The extra blocks, along with the public keys needed
  , forall proof check. Biscuit proof check -> proof
proof      :: proof
  -- ^ The final proof allowing to check the validity of a biscuit
  , forall proof check. Biscuit proof check -> check
proofCheck :: check
  -- ^ A value that keeps track of whether the biscuit signatures have been verified or not.
  }
  deriving (Biscuit proof check -> Biscuit proof check -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall proof check.
(Eq proof, Eq check) =>
Biscuit proof check -> Biscuit proof check -> Bool
/= :: Biscuit proof check -> Biscuit proof check -> Bool
$c/= :: forall proof check.
(Eq proof, Eq check) =>
Biscuit proof check -> Biscuit proof check -> Bool
== :: Biscuit proof check -> Biscuit proof check -> Bool
$c== :: forall proof check.
(Eq proof, Eq check) =>
Biscuit proof check -> Biscuit proof check -> Bool
Eq, Int -> Biscuit proof check -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall proof check.
(Show proof, Show check) =>
Int -> Biscuit proof check -> ShowS
forall proof check.
(Show proof, Show check) =>
[Biscuit proof check] -> ShowS
forall proof check.
(Show proof, Show check) =>
Biscuit proof check -> String
showList :: [Biscuit proof check] -> ShowS
$cshowList :: forall proof check.
(Show proof, Show check) =>
[Biscuit proof check] -> ShowS
show :: Biscuit proof check -> String
$cshow :: forall proof check.
(Show proof, Show check) =>
Biscuit proof check -> String
showsPrec :: Int -> Biscuit proof check -> ShowS
$cshowsPrec :: forall proof check.
(Show proof, Show check) =>
Int -> Biscuit proof check -> ShowS
Show)

-- | Query the facts contained in a biscuit, /before running authorization/. This function
-- should only be used to extract information needed to generate an authorizer. In other
-- cases, you likely want 'queryAuthorizerFacts' instead, which queries facts /after running
-- authorization/.
--
-- ⚠ Only facts directly contained in the biscuit are queried. Rules are not processed
-- at this point, so derived facts are not generated yet.
--
-- ⚠ By default, only facts from the authority block are queried,
-- like what happens in rules and checks. Facts from other blocks can be queried
-- with a @trusting@ annotation. Be careful with @trusting previous@, as it queries
-- facts from all blocks, even untrusted ones.
queryRawBiscuitFactsWithLimits :: Biscuit openOrSealed check -> Limits -> Query
                               -> Set Bindings
queryRawBiscuitFactsWithLimits :: forall openOrSealed check.
Biscuit openOrSealed check -> Limits -> Query -> Set Bindings
queryRawBiscuitFactsWithLimits b :: Biscuit openOrSealed check
b@Biscuit{ParsedSignedBlock
authority :: ParsedSignedBlock
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
authority,[ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks} =
  let ePks :: [Maybe PublicKey]
ePks = forall openOrSealed check.
Biscuit openOrSealed check -> [Maybe PublicKey]
externalKeys Biscuit openOrSealed check
b
      getBlock :: ((a, b), b, c, d) -> b
getBlock ((a
_, b
block), b
_, c
_, d
_) = b
block
      allBlocks :: [(Nat, Block)]
allBlocks = forall a b. [a] -> [b] -> [(a, b)]
zip [Nat
0..] forall a b. (a -> b) -> a -> b
$ forall {a} {b} {b} {c} {d}. ((a, b), b, c, d) -> b
getBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSignedBlock
authority forall a. a -> [a] -> [a]
: [ParsedSignedBlock]
blocks
      (Map Nat (Set EvalRule)
_, FactGroup
sFacts) = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Nat -> EvalBlock -> (Map Nat (Set EvalRule), FactGroup)
collectWorld forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Nat, Block)]
allBlocks)
   in [Maybe PublicKey] -> FactGroup -> Limits -> Query -> Set Bindings
queryAvailableFacts [Maybe PublicKey]
ePks FactGroup
sFacts

-- | Query the facts generated by the authority and authorizer blocks
-- during authorization. This can be used in conjuction with 'getVariableValues'
-- and 'getSingleVariableValue' to retrieve actual values.
--
-- ⚠ By default, only facts from the authority block and the authorizer are queried,
-- like what happens in rules and checks. Facts from other blocks can be queried
-- with a @trusting@ annotation. Be careful with @trusting previous@, as it queries
-- facts from all blocks, even untrusted ones.
--
-- 💁 If the facts you want to query are part of an allow query in the authorizer,
-- you can directly get values by calling 'getBindings' on 'AuthorizationSuccess'.
queryRawBiscuitFacts :: Biscuit openOrSealed check -> Query
                     -> Set Bindings
queryRawBiscuitFacts :: forall openOrSealed check.
Biscuit openOrSealed check -> Query -> Set Bindings
queryRawBiscuitFacts Biscuit openOrSealed check
b = forall openOrSealed check.
Biscuit openOrSealed check -> Limits -> Query -> Set Bindings
queryRawBiscuitFactsWithLimits Biscuit openOrSealed check
b Limits
defaultLimits

-- | Turn a 'Biscuit' statically known to be 'Open' into a more generic 'OpenOrSealed' 'Biscuit'
-- (essentially /forgetting/ about the fact it's 'Open')
fromOpen :: Biscuit Open check -> Biscuit OpenOrSealed check
fromOpen :: forall check. Biscuit Open check -> Biscuit OpenOrSealed check
fromOpen b :: Biscuit Open check
b@Biscuit{proof :: forall proof check. Biscuit proof check -> proof
proof = Open SecretKey
p } = Biscuit Open check
b { proof :: OpenOrSealed
proof = SecretKey -> OpenOrSealed
OpenProof SecretKey
p }

-- | Turn a 'Biscuit' statically known to be 'Sealed' into a more generic 'OpenOrSealed' 'Biscuit'
-- (essentially /forgetting/ about the fact it's 'Sealed')
fromSealed :: Biscuit Sealed check -> Biscuit OpenOrSealed check
fromSealed :: forall check. Biscuit Sealed check -> Biscuit OpenOrSealed check
fromSealed b :: Biscuit Sealed check
b@Biscuit{proof :: forall proof check. Biscuit proof check -> proof
proof = Sealed Signature
p } = Biscuit Sealed check
b { proof :: OpenOrSealed
proof = Signature -> OpenOrSealed
SealedProof Signature
p }

-- | Try to turn a 'Biscuit' that may be open or sealed into a biscuit that's statically known
-- to be 'Sealed'.
asSealed :: Biscuit OpenOrSealed check -> Maybe (Biscuit Sealed check)
asSealed :: forall check.
Biscuit OpenOrSealed check -> Maybe (Biscuit Sealed check)
asSealed b :: Biscuit OpenOrSealed check
b@Biscuit{OpenOrSealed
proof :: OpenOrSealed
proof :: forall proof check. Biscuit proof check -> proof
proof} = case OpenOrSealed
proof of
  SealedProof Signature
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Biscuit OpenOrSealed check
b { proof :: Sealed
proof = Signature -> Sealed
Sealed Signature
p }
  OpenOrSealed
_             -> forall a. Maybe a
Nothing

-- | Try to turn a 'Biscuit' that may be open or sealed into a biscuit that's statically known
-- to be 'Open'.
asOpen :: Biscuit OpenOrSealed check -> Maybe (Biscuit Open check)
asOpen :: forall check.
Biscuit OpenOrSealed check -> Maybe (Biscuit Open check)
asOpen b :: Biscuit OpenOrSealed check
b@Biscuit{OpenOrSealed
proof :: OpenOrSealed
proof :: forall proof check. Biscuit proof check -> proof
proof}   = case OpenOrSealed
proof of
  OpenProof SecretKey
p -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Biscuit OpenOrSealed check
b { proof :: Open
proof = SecretKey -> Open
Open SecretKey
p }
  OpenOrSealed
_           -> forall a. Maybe a
Nothing

toParsedSignedBlock :: Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock :: Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock Block
block (ByteString
serializedBlock, Signature
sig, PublicKey
pk, Maybe (Signature, PublicKey)
eSig) = ((ByteString
serializedBlock, Block
block), Signature
sig, PublicKey
pk, Maybe (Signature, PublicKey)
eSig)

-- | Create a new biscuit with the provided authority block. Such a biscuit is 'Open' to
-- further attenuation.
mkBiscuit :: SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuit :: SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuit = Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuitWith forall a. Maybe a
Nothing

-- | Create a new biscuit with the provided authority block and root key id. Such a biscuit is 'Open' to
-- further attenuation.
mkBiscuitWith :: Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuitWith :: Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuitWith Maybe Int
rootKeyId SecretKey
sk Block
authority = do
  let (BlockSymbols
authoritySymbols, ByteString
authoritySerialized) = Block -> ByteString
PB.encodeBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Symbols -> Block -> (BlockSymbols, Block)
blockToPb Bool
False Symbols
newSymbolTable Block
authority
  (SignedBlock
signedBlock, SecretKey
nextSk) <- SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlock SecretKey
sk ByteString
authoritySerialized forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure Biscuit { Maybe Int
rootKeyId :: Maybe Int
rootKeyId :: Maybe Int
rootKeyId
               , authority :: ParsedSignedBlock
authority = Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock Block
authority SignedBlock
signedBlock
               , blocks :: [ParsedSignedBlock]
blocks = []
               , symbols :: Symbols
symbols = Symbols -> BlockSymbols -> Symbols
addFromBlock Symbols
newSymbolTable BlockSymbols
authoritySymbols
               , proof :: Open
proof = SecretKey -> Open
Open SecretKey
nextSk
               , proofCheck :: Verified
proofCheck = PublicKey -> Verified
Verified forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
toPublic SecretKey
sk
               }

-- | Add a block to an existing biscuit. Only 'Open' biscuits can be attenuated; the
-- newly created biscuit is 'Open' as well.
addBlock :: Block
         -> Biscuit Open check
         -> IO (Biscuit Open check)
addBlock :: forall check.
Block -> Biscuit Open check -> IO (Biscuit Open check)
addBlock Block
block b :: Biscuit Open check
b@Biscuit{check
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Open
proofCheck :: check
proof :: Open
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} = do
  let (BlockSymbols
blockSymbols, ByteString
blockSerialized) = Block -> ByteString
PB.encodeBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Symbols -> Block -> (BlockSymbols, Block)
blockToPb Bool
False Symbols
symbols Block
block
      Open SecretKey
p = Open
proof
  (SignedBlock
signedBlock, SecretKey
nextSk) <- SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlock SecretKey
p ByteString
blockSerialized forall a. Maybe a
Nothing
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Biscuit Open check
b { blocks :: [ParsedSignedBlock]
blocks = [ParsedSignedBlock]
blocks forall a. Semigroup a => a -> a -> a
<> [Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock Block
block SignedBlock
signedBlock]
           , symbols :: Symbols
symbols = Symbols -> BlockSymbols -> Symbols
addFromBlock Symbols
symbols BlockSymbols
blockSymbols
           , proof :: Open
proof = SecretKey -> Open
Open SecretKey
nextSk
           }

-- | Directly append a third-party block to a token. Please use
-- 'mkThirdPartyBlockReq', 'mkThirdPartyBlock' and 'applyThirdPartyBlock'
-- instead if the party signing the block cannot have access to the token.
addSignedBlock :: SecretKey
               -> Block
               -> Biscuit Open check
               -> IO (Biscuit Open check)
addSignedBlock :: forall check.
SecretKey -> Block -> Biscuit Open check -> IO (Biscuit Open check)
addSignedBlock SecretKey
eSk Block
block b :: Biscuit Open check
b@Biscuit{check
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Open
proofCheck :: check
proof :: Open
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} = do
  let symbolsForCurrentBlock :: Symbols
symbolsForCurrentBlock = Symbols -> Symbols
forgetSymbols forall a b. (a -> b) -> a -> b
$ [PublicKey] -> Symbols -> Symbols
registerNewPublicKeys [SecretKey -> PublicKey
toPublic SecretKey
eSk] Symbols
symbols
      (BlockSymbols
newSymbols, ByteString
blockSerialized) = Block -> ByteString
PB.encodeBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Symbols -> Block -> (BlockSymbols, Block)
blockToPb Bool
True Symbols
symbolsForCurrentBlock Block
block
      lastBlock :: ParsedSignedBlock
lastBlock = forall a. NonEmpty a -> a
NE.last (ParsedSignedBlock
authority forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks)
      ((ByteString, Block)
_, Signature
_, PublicKey
lastPublicKey, Maybe (Signature, PublicKey)
_) = ParsedSignedBlock
lastBlock
      Open SecretKey
p = Open
proof
  (SignedBlock
signedBlock, SecretKey
nextSk) <- SecretKey
-> SecretKey
-> PublicKey
-> ByteString
-> IO (SignedBlock, SecretKey)
signExternalBlock SecretKey
p SecretKey
eSk PublicKey
lastPublicKey ByteString
blockSerialized
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Biscuit Open check
b { blocks :: [ParsedSignedBlock]
blocks = [ParsedSignedBlock]
blocks forall a. Semigroup a => a -> a -> a
<> [Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock Block
block SignedBlock
signedBlock]
           , symbols :: Symbols
symbols = [PublicKey] -> Symbols -> Symbols
registerNewPublicKeys (BlockSymbols -> [PublicKey]
getPkList BlockSymbols
newSymbols) Symbols
symbols
           , proof :: Open
proof = SecretKey -> Open
Open SecretKey
nextSk
           }

mkThirdPartyBlock' :: SecretKey
                   -> [PublicKey]
                   -> PublicKey
                   -> Block
                   -> (ByteString, Signature, PublicKey)
mkThirdPartyBlock' :: SecretKey
-> [PublicKey]
-> PublicKey
-> Block
-> (ByteString, Signature, PublicKey)
mkThirdPartyBlock' SecretKey
eSk [PublicKey]
pkTable PublicKey
lastPublicKey Block
block =
  let symbolsForCurrentBlock :: Symbols
symbolsForCurrentBlock = [PublicKey] -> Symbols -> Symbols
registerNewPublicKeys [SecretKey -> PublicKey
toPublic SecretKey
eSk] forall a b. (a -> b) -> a -> b
$
        [PublicKey] -> Symbols -> Symbols
registerNewPublicKeys [PublicKey]
pkTable Symbols
newSymbolTable
      (BlockSymbols
_, ByteString
payload) = Block -> ByteString
PB.encodeBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Symbols -> Block -> (BlockSymbols, Block)
blockToPb Bool
True Symbols
symbolsForCurrentBlock Block
block
      (Signature
eSig, PublicKey
ePk) = SecretKey -> PublicKey -> ByteString -> (Signature, PublicKey)
sign3rdPartyBlock SecretKey
eSk PublicKey
lastPublicKey ByteString
payload
   in (ByteString
payload, Signature
eSig, PublicKey
ePk)

-- | Given a third-party block request, generate a third-party block,
-- which can be then appended to a token with 'applyThirdPartyBlock'.
mkThirdPartyBlock :: SecretKey
                  -> ByteString
                  -> Block
                  -> Either String ByteString
mkThirdPartyBlock :: SecretKey -> ByteString -> Block -> Either String ByteString
mkThirdPartyBlock SecretKey
eSk ByteString
req Block
block = do
  (PublicKey
previousPk, [PublicKey]
pkTable) <- ThirdPartyBlockRequest -> Either String (PublicKey, [PublicKey])
pbToThirdPartyBlockRequest forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either String ThirdPartyBlockRequest
PB.decodeThirdPartyBlockRequest ByteString
req
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ThirdPartyBlockContents -> ByteString
PB.encodeThirdPartyBlockContents forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Signature, PublicKey) -> ThirdPartyBlockContents
thirdPartyBlockContentsToPb forall a b. (a -> b) -> a -> b
$ SecretKey
-> [PublicKey]
-> PublicKey
-> Block
-> (ByteString, Signature, PublicKey)
mkThirdPartyBlock' SecretKey
eSk [PublicKey]
pkTable PublicKey
previousPk Block
block

-- | Generate a third-party block request. It can be used in
-- conjunction with 'mkThirdPartyBlock' to generate a
-- third-party block, which can be then appended to a token with
-- 'applyThirdPartyBlock'.
mkThirdPartyBlockReq :: Biscuit proof check -> ByteString
mkThirdPartyBlockReq :: forall proof check. Biscuit proof check -> ByteString
mkThirdPartyBlockReq Biscuit{ParsedSignedBlock
authority :: ParsedSignedBlock
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
authority,[ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks,Symbols
symbols :: Symbols
symbols :: forall proof check. Biscuit proof check -> Symbols
symbols} =
  let ((ByteString, Block)
_, Signature
_ , PublicKey
lastPk, Maybe (Signature, PublicKey)
_) = forall a. NonEmpty a -> a
NE.last forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock
authority forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
   in ThirdPartyBlockRequest -> ByteString
PB.encodeThirdPartyBlockRequest forall a b. (a -> b) -> a -> b
$ (PublicKey, [PublicKey]) -> ThirdPartyBlockRequest
thirdPartyBlockRequestToPb (PublicKey
lastPk, Symbols -> [PublicKey]
getPkTable Symbols
symbols)

-- | Given a base64-encoded third-party block, append it to a token.
applyThirdPartyBlock :: Biscuit Open check -> ByteString -> Either String (IO (Biscuit Open check))
applyThirdPartyBlock :: forall check.
Biscuit Open check
-> ByteString -> Either String (IO (Biscuit Open check))
applyThirdPartyBlock b :: Biscuit Open check
b@Biscuit{check
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Open
proofCheck :: check
proof :: Open
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} ByteString
contents = do
  (ByteString
payload, Signature
eSig, PublicKey
ePk) <- ThirdPartyBlockContents
-> Either String (ByteString, Signature, PublicKey)
pbToThirdPartyBlockContents forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either String ThirdPartyBlockContents
PB.decodeThirdPartyBlockContents ByteString
contents
  let Open SecretKey
p = Open
proof
      addESig :: (a, b, c, d) -> (a, b, c, Maybe (Signature, PublicKey))
addESig (a
a,b
b',c
c,d
_) = (a
a,b
b',c
c, forall a. a -> Maybe a
Just (Signature
eSig, PublicKey
ePk))
      ((ByteString, Block)
_, Signature
_, PublicKey
lastPk, Maybe (Signature, PublicKey)
_) = forall a. NonEmpty a -> a
NE.last forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock
authority forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
  Block
pbBlock <- ByteString -> Either String Block
PB.decodeBlock ByteString
payload
  (Block
block, Symbols
newSymbols) <- (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` Symbols
symbols) forall a b. (a -> b) -> a -> b
$ Maybe PublicKey -> Block -> StateT Symbols (Either String) Block
pbToBlock (forall a. a -> Maybe a
Just PublicKey
ePk) Block
pbBlock
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PublicKey -> (ByteString, Signature, PublicKey) -> Bool
verifyExternalSig PublicKey
lastPk (ByteString
payload, Signature
eSig, PublicKey
ePk)) forall a b. (a -> b) -> a -> b
$
    forall a b. a -> Either a b
Left String
"Invalid 3rd party signature"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
    (SignedBlock
signedBlock, SecretKey
nextSk) <- SecretKey
-> ByteString
-> Maybe (Signature, PublicKey)
-> IO (SignedBlock, SecretKey)
signBlock SecretKey
p ByteString
payload (forall a. a -> Maybe a
Just (Signature
eSig, PublicKey
ePk))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Biscuit Open check
b { blocks :: [ParsedSignedBlock]
blocks = [ParsedSignedBlock]
blocks forall a. Semigroup a => a -> a -> a
<> [Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock Block
block (forall {a} {b} {c} {d}.
(a, b, c, d) -> (a, b, c, Maybe (Signature, PublicKey))
addESig SignedBlock
signedBlock)]
             , proof :: Open
proof = SecretKey -> Open
Open SecretKey
nextSk
             , symbols :: Symbols
symbols = Symbols
newSymbols
             }

externalKeys :: Biscuit openOrSealed check -> [Maybe PublicKey]
externalKeys :: forall openOrSealed check.
Biscuit openOrSealed check -> [Maybe PublicKey]
externalKeys Biscuit{[ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks} =
  let getEpk :: (a, b, c, Maybe (a, a)) -> Maybe a
getEpk (a
_, b
_, c
_, Just (a
_, a
ePk)) = forall a. a -> Maybe a
Just a
ePk
      getEpk (a, b, c, Maybe (a, a))
_                        = forall a. Maybe a
Nothing
   in forall a. Maybe a
Nothing forall a. a -> [a] -> [a]
: (forall {a} {b} {c} {a} {a}. (a, b, c, Maybe (a, a)) -> Maybe a
getEpk forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedSignedBlock]
blocks)

-- | 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 :: forall check. Biscuit Open check -> Biscuit Sealed check
seal b :: Biscuit Open check
b@Biscuit{check
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Open
proofCheck :: check
proof :: Open
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} =
  let Open SecretKey
sk = Open
proof
      ((ByteString
lastPayload, Block
_), Signature
lastSig, PublicKey
lastPk, Maybe (Signature, PublicKey)
eSig) = forall a. NonEmpty a -> a
NE.last forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock
authority forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
      newProof :: Sealed
newProof = Signature -> Sealed
Sealed forall a b. (a -> b) -> a -> b
$ SignedBlock -> SecretKey -> Signature
getSignatureProof (ByteString
lastPayload, Signature
lastSig, PublicKey
lastPk, Maybe (Signature, PublicKey)
eSig) SecretKey
sk
   in Biscuit Open check
b { proof :: Sealed
proof = Sealed
newProof }

-- | Serialize a biscuit to a raw bytestring
serializeBiscuit :: BiscuitProof p => Biscuit p Verified -> ByteString
serializeBiscuit :: forall p. BiscuitProof p => Biscuit p Verified -> ByteString
serializeBiscuit Biscuit{p
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Verified
proofCheck :: Verified
proof :: p
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} =
  let proofField :: Proof
proofField = case forall a. BiscuitProof a => a -> OpenOrSealed
toPossibleProofs p
proof of
          SealedProof Signature
sig -> Required 2 (Value ByteString) -> Proof
PB.ProofSignature forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField (Signature -> ByteString
sigBytes Signature
sig)
          OpenProof   SecretKey
sk  -> Required 1 (Value ByteString) -> Proof
PB.ProofSecret forall a b. (a -> b) -> a -> b
$ forall a. HasField a => FieldType a -> a
PB.putField (SecretKey -> ByteString
skBytes SecretKey
sk)
   in Biscuit -> ByteString
PB.encodeBlockList PB.Biscuit
        { $sel:rootKeyId:Biscuit :: Optional 1 (Value Int32)
rootKeyId = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
rootKeyId
        , $sel:authority:Biscuit :: Required 2 (Message SignedBlock)
authority = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock -> SignedBlock
toPBSignedBlock ParsedSignedBlock
authority
        , $sel:blocks:Biscuit :: Repeated 3 (Message SignedBlock)
blocks    = forall a. HasField a => FieldType a -> a
PB.putField forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock -> SignedBlock
toPBSignedBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedSignedBlock]
blocks
        , $sel:proof:Biscuit :: Required 4 (Message Proof)
proof     = forall a. HasField a => FieldType a -> a
PB.putField Proof
proofField
        }

toPBSignedBlock :: ParsedSignedBlock -> PB.SignedBlock
toPBSignedBlock :: ParsedSignedBlock -> SignedBlock
toPBSignedBlock ((ByteString
block, Block
_), Signature
sig, PublicKey
pk, Maybe (Signature, PublicKey)
eSig) = SignedBlock -> SignedBlock
signedBlockToPb (ByteString
block, Signature
sig, PublicKey
pk, Maybe (Signature, PublicKey)
eSig)

-- | Errors that can happen when parsing a biscuit. Since complete parsing of a biscuit
-- requires a signature check, an invalid signature check is a parsing error
data ParseError
  = InvalidHexEncoding
  -- ^ The provided ByteString is not hex-encoded
  | InvalidB64Encoding
  -- ^ The provided ByteString is not base64-encoded
  | InvalidProtobufSer Bool String
  -- ^ The provided ByteString does not contain properly serialized protobuf values
  -- The boolean parameter is True if the error happened on the wrapper, False if it happened on a block
  | InvalidProtobuf Bool String
  -- ^ The bytestring was correctly deserialized from protobuf, but the values can't be turned into a proper biscuit
  -- The boolean parameter is True if the error happened on the wrapper, False if it happened on a block
  | InvalidSignatures
  -- ^ The signatures were invalid
  | InvalidProof
  -- ^ The biscuit final proof was invalid
  | RevokedBiscuit
  -- ^ The biscuit has been revoked
  deriving (ParseError -> ParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c== :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseError] -> ShowS
$cshowList :: [ParseError] -> ShowS
show :: ParseError -> String
$cshow :: ParseError -> String
showsPrec :: Int -> ParseError -> ShowS
$cshowsPrec :: Int -> ParseError -> ShowS
Show)

data BiscuitWrapper
  = BiscuitWrapper
  { BiscuitWrapper -> SignedBlock
wAuthority :: SignedBlock
  , BiscuitWrapper -> [SignedBlock]
wBlocks    :: [SignedBlock]
  , BiscuitWrapper -> OpenOrSealed
wProof     :: OpenOrSealed
  , BiscuitWrapper -> Maybe Int
wRootKeyId :: Maybe Int
  }

parseBiscuitWrapper :: ByteString -> Either ParseError BiscuitWrapper
parseBiscuitWrapper :: ByteString -> Either ParseError BiscuitWrapper
parseBiscuitWrapper ByteString
bs = do
  Biscuit
blockList <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobufSer Bool
True) forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Biscuit
PB.decodeBlockList ByteString
bs
  let rootKeyId :: Maybe Int
rootKeyId = forall a. Enum a => a -> Int
fromEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasField a => a -> FieldType a
PB.getField (Biscuit -> Optional 1 (Value Int32)
PB.rootKeyId Biscuit
blockList)
  SignedBlock
signedAuthority <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
True) forall a b. (a -> b) -> a -> b
$ SignedBlock -> Either String SignedBlock
pbToSignedBlock forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ Biscuit -> Required 2 (Message SignedBlock)
PB.authority Biscuit
blockList
  [SignedBlock]
signedBlocks    <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
True) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse SignedBlock -> Either String SignedBlock
pbToSignedBlock forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ Biscuit -> Repeated 3 (Message SignedBlock)
PB.blocks Biscuit
blockList
  Either Signature SecretKey
proof         <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
True) forall a b. (a -> b) -> a -> b
$ Proof -> Either String (Either Signature SecretKey)
pbToProof forall a b. (a -> b) -> a -> b
$ forall a. HasField a => a -> FieldType a
PB.getField forall a b. (a -> b) -> a -> b
$ Biscuit -> Required 4 (Message Proof)
PB.proof Biscuit
blockList

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BiscuitWrapper
    { wAuthority :: SignedBlock
wAuthority = SignedBlock
signedAuthority
    , wBlocks :: [SignedBlock]
wBlocks = [SignedBlock]
signedBlocks
    , wProof :: OpenOrSealed
wProof  = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Signature -> OpenOrSealed
SealedProof
                       SecretKey -> OpenOrSealed
OpenProof
                       Either Signature SecretKey
proof
    , wRootKeyId :: Maybe Int
wRootKeyId = Maybe Int
rootKeyId
    , ..
    }

checkRevocation :: Applicative m
                => (Set ByteString -> m Bool)
                -> BiscuitWrapper
                -> m (Either ParseError BiscuitWrapper)
checkRevocation :: forall (m :: * -> *).
Applicative m =>
(Set ByteString -> m Bool)
-> BiscuitWrapper -> m (Either ParseError BiscuitWrapper)
checkRevocation Set ByteString -> m Bool
isRevoked bw :: BiscuitWrapper
bw@BiscuitWrapper{SignedBlock
wAuthority :: SignedBlock
wAuthority :: BiscuitWrapper -> SignedBlock
wAuthority,[SignedBlock]
wBlocks :: [SignedBlock]
wBlocks :: BiscuitWrapper -> [SignedBlock]
wBlocks} =
  let getRevocationId :: (a, Signature, c, d) -> ByteString
getRevocationId (a
_, Signature
sig, c
_, d
_) = Signature -> ByteString
sigBytes Signature
sig
      revocationIds :: NonEmpty ByteString
revocationIds = forall {a} {c} {d}. (a, Signature, c, d) -> ByteString
getRevocationId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SignedBlock
wAuthority forall a. a -> [a] -> NonEmpty a
:| [SignedBlock]
wBlocks
      keepIfNotRevoked :: Bool -> Either ParseError BiscuitWrapper
keepIfNotRevoked Bool
True  = forall a b. a -> Either a b
Left ParseError
RevokedBiscuit
      keepIfNotRevoked Bool
False = forall a b. b -> Either a b
Right BiscuitWrapper
bw
   in Bool -> Either ParseError BiscuitWrapper
keepIfNotRevoked forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set ByteString -> m Bool
isRevoked (forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty ByteString
revocationIds)

parseBlocks :: BiscuitWrapper -> Either ParseError (Symbols, NonEmpty ParsedSignedBlock)
parseBlocks :: BiscuitWrapper
-> Either ParseError (Symbols, NonEmpty ParsedSignedBlock)
parseBlocks BiscuitWrapper{[SignedBlock]
Maybe Int
SignedBlock
OpenOrSealed
wRootKeyId :: Maybe Int
wProof :: OpenOrSealed
wBlocks :: [SignedBlock]
wAuthority :: SignedBlock
wRootKeyId :: BiscuitWrapper -> Maybe Int
wProof :: BiscuitWrapper -> OpenOrSealed
wBlocks :: BiscuitWrapper -> [SignedBlock]
wAuthority :: BiscuitWrapper -> SignedBlock
..} = do
  let parseBlock :: (ByteString, b, c, Maybe (a, PublicKey))
-> StateT
     Symbols
     (Either ParseError)
     ((ByteString, Block), b, c, Maybe (a, PublicKey))
parseBlock (ByteString
payload, b
sig, c
pk, Maybe (a, PublicKey)
eSig) = do
        Block
pbBlock <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobufSer Bool
False) forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Block
PB.decodeBlock ByteString
payload
        Block
block   <- forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
False)) forall a b. (a -> b) -> a -> b
$ Maybe PublicKey -> Block -> StateT Symbols (Either String) Block
pbToBlock (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, PublicKey)
eSig) Block
pbBlock
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString
payload, Block
block), b
sig, c
pk, Maybe (a, PublicKey)
eSig)

  (NonEmpty ParsedSignedBlock
allBlocks, Symbols
symbols) <- (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` Symbols
newSymbolTable) forall a b. (a -> b) -> a -> b
$ do
     forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {b} {c} {a}.
(ByteString, b, c, Maybe (a, PublicKey))
-> StateT
     Symbols
     (Either ParseError)
     ((ByteString, Block), b, c, Maybe (a, PublicKey))
parseBlock (SignedBlock
wAuthority forall a. a -> [a] -> NonEmpty a
:| [SignedBlock]
wBlocks)

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbols
symbols, NonEmpty ParsedSignedBlock
allBlocks)

-- | Parse a biscuit without performing any signatures check. This function is intended to
-- provide tooling (eg adding a block, or inspecting a biscuit) without having to verify
-- its signatures. Running an 'Authorizer' is not possible without checking signatures.
-- 'checkBiscuitSignatures' allows a delayed signature check. For normal auth workflows,
-- please use 'parseWith' (or 'parse', or 'parseB64') instead, as they check signatures
-- before completely parsing the biscuit.
parseBiscuitUnverified :: ByteString -> Either ParseError (Biscuit OpenOrSealed Unverified)
parseBiscuitUnverified :: ByteString -> Either ParseError (Biscuit OpenOrSealed Unverified)
parseBiscuitUnverified ByteString
bs = do
  w :: BiscuitWrapper
w@BiscuitWrapper{[SignedBlock]
Maybe Int
SignedBlock
OpenOrSealed
wRootKeyId :: Maybe Int
wProof :: OpenOrSealed
wBlocks :: [SignedBlock]
wAuthority :: SignedBlock
wRootKeyId :: BiscuitWrapper -> Maybe Int
wProof :: BiscuitWrapper -> OpenOrSealed
wBlocks :: BiscuitWrapper -> [SignedBlock]
wAuthority :: BiscuitWrapper -> SignedBlock
..} <- ByteString -> Either ParseError BiscuitWrapper
parseBiscuitWrapper ByteString
bs
  (Symbols
symbols, ParsedSignedBlock
authority :| [ParsedSignedBlock]
blocks) <- BiscuitWrapper
-> Either ParseError (Symbols, NonEmpty ParsedSignedBlock)
parseBlocks BiscuitWrapper
w
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Biscuit { rootKeyId :: Maybe Int
rootKeyId = Maybe Int
wRootKeyId
                 , proof :: OpenOrSealed
proof = OpenOrSealed
wProof
                 , proofCheck :: Unverified
proofCheck = Unverified
Unverified
                 , [ParsedSignedBlock]
ParsedSignedBlock
Symbols
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
.. }

parseBiscuit' :: PublicKey -> BiscuitWrapper -> Either ParseError (Biscuit OpenOrSealed Verified)
parseBiscuit' :: PublicKey
-> BiscuitWrapper
-> Either ParseError (Biscuit OpenOrSealed Verified)
parseBiscuit' PublicKey
pk w :: BiscuitWrapper
w@BiscuitWrapper{[SignedBlock]
Maybe Int
SignedBlock
OpenOrSealed
wRootKeyId :: Maybe Int
wProof :: OpenOrSealed
wBlocks :: [SignedBlock]
wAuthority :: SignedBlock
wRootKeyId :: BiscuitWrapper -> Maybe Int
wProof :: BiscuitWrapper -> OpenOrSealed
wBlocks :: BiscuitWrapper -> [SignedBlock]
wAuthority :: BiscuitWrapper -> SignedBlock
..} = do
  let allBlocks :: NonEmpty SignedBlock
allBlocks = SignedBlock
wAuthority forall a. a -> [a] -> NonEmpty a
:| [SignedBlock]
wBlocks
  let blocksResult :: Bool
blocksResult = NonEmpty SignedBlock -> PublicKey -> Bool
verifyBlocks NonEmpty SignedBlock
allBlocks PublicKey
pk
  let proofResult :: Bool
proofResult = case OpenOrSealed
wProof of
        SealedProof Signature
sig -> Signature -> SignedBlock -> Bool
verifySignatureProof Signature
sig (forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
        OpenProof   SecretKey
sk  -> SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
sk     (forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
blocksResult Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
proofResult) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ParseError
InvalidSignatures

  (Symbols
symbols, ParsedSignedBlock
authority :| [ParsedSignedBlock]
blocks) <- BiscuitWrapper
-> Either ParseError (Symbols, NonEmpty ParsedSignedBlock)
parseBlocks BiscuitWrapper
w
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Biscuit { rootKeyId :: Maybe Int
rootKeyId = Maybe Int
wRootKeyId
                 , proof :: OpenOrSealed
proof = OpenOrSealed
wProof
                 , proofCheck :: Verified
proofCheck = PublicKey -> Verified
Verified PublicKey
pk
                 , [ParsedSignedBlock]
ParsedSignedBlock
Symbols
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
.. }

-- | Check the signatures (and final proof) of an already parsed biscuit. These checks normally
-- happen during the parsing phase, but can be delayed (or even ignored) in some cases. This
-- fuction allows to turn a 'Unverified' 'Biscuit' into a 'Verified' one after it has been parsed
-- with 'parseBiscuitUnverified'.
checkBiscuitSignatures :: BiscuitProof proof
                       => (Maybe Int -> PublicKey)
                       -> Biscuit proof Unverified
                       -> Either ParseError (Biscuit proof Verified)
checkBiscuitSignatures :: forall proof.
BiscuitProof proof =>
(Maybe Int -> PublicKey)
-> Biscuit proof Unverified
-> Either ParseError (Biscuit proof Verified)
checkBiscuitSignatures Maybe Int -> PublicKey
getPublicKey b :: Biscuit proof Unverified
b@Biscuit{proof
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Unverified
proofCheck :: Unverified
proof :: proof
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} = do
  let pk :: PublicKey
pk = Maybe Int -> PublicKey
getPublicKey Maybe Int
rootKeyId
      toSignedBlock :: ((a, b), b, c, d) -> (a, b, c, d)
toSignedBlock ((a
payload, b
_), b
sig, c
nextPk, d
eSig) = (a
payload, b
sig, c
nextPk, d
eSig)
      allBlocks :: NonEmpty SignedBlock
allBlocks = forall {a} {b} {b} {c} {d}. ((a, b), b, c, d) -> (a, b, c, d)
toSignedBlock forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsedSignedBlock
authority forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks)
      blocksResult :: Bool
blocksResult = NonEmpty SignedBlock -> PublicKey -> Bool
verifyBlocks NonEmpty SignedBlock
allBlocks PublicKey
pk
      proofResult :: Bool
proofResult = case forall a. BiscuitProof a => a -> OpenOrSealed
toPossibleProofs proof
proof of
        SealedProof Signature
sig -> Signature -> SignedBlock -> Bool
verifySignatureProof Signature
sig (forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
        OpenProof   SecretKey
sk  -> SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
sk     (forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
blocksResult Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
proofResult) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ParseError
InvalidSignatures
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Biscuit proof Unverified
b { proofCheck :: Verified
proofCheck = PublicKey -> Verified
Verified PublicKey
pk }

-- | Biscuits can be transmitted as raw bytes, or as base64-encoded text. This datatype
-- lets the parser know about the expected encoding.
data BiscuitEncoding
  = RawBytes
  | UrlBase64

-- | Parsing a biscuit involves various steps. This data type allows configuring those steps.
data ParserConfig m
  = ParserConfig
  { forall (m :: * -> *). ParserConfig m -> BiscuitEncoding
encoding     :: BiscuitEncoding
  -- ^ Is the biscuit base64-encoded, or is it raw binary?
  , forall (m :: * -> *). ParserConfig m -> Set ByteString -> m Bool
isRevoked    :: Set ByteString -> m Bool
  -- ^ Has one of the token blocks been revoked?
  -- 'fromRevocationList' lets you build this function from a static revocation list
  , forall (m :: * -> *). ParserConfig m -> Maybe Int -> PublicKey
getPublicKey :: Maybe Int -> PublicKey
  -- ^ How to select the public key based on the token 'rootKeyId'
  }

parseBiscuitWith :: Applicative m
                 => ParserConfig m
                 -> ByteString
                 -> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseBiscuitWith :: forall (m :: * -> *).
Applicative m =>
ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseBiscuitWith ParserConfig{BiscuitEncoding
Maybe Int -> PublicKey
Set ByteString -> m Bool
getPublicKey :: Maybe Int -> PublicKey
isRevoked :: Set ByteString -> m Bool
encoding :: BiscuitEncoding
getPublicKey :: forall (m :: * -> *). ParserConfig m -> Maybe Int -> PublicKey
isRevoked :: forall (m :: * -> *). ParserConfig m -> Set ByteString -> m Bool
encoding :: forall (m :: * -> *). ParserConfig m -> BiscuitEncoding
..} ByteString
bs =
  let input :: Either ParseError ByteString
input = case BiscuitEncoding
encoding of
        BiscuitEncoding
RawBytes  -> forall a b. b -> Either a b
Right ByteString
bs
        BiscuitEncoding
UrlBase64 -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. a -> b -> a
const ParseError
InvalidB64Encoding) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
B64.decodeBase64 forall a b. (a -> b) -> a -> b
$ ByteString
bs
      parsedWrapper :: Either ParseError BiscuitWrapper
parsedWrapper = ByteString -> Either ParseError BiscuitWrapper
parseBiscuitWrapper forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either ParseError ByteString
input
      wrapperToBiscuit :: BiscuitWrapper
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
wrapperToBiscuit w :: BiscuitWrapper
w@BiscuitWrapper{Maybe Int
wRootKeyId :: Maybe Int
wRootKeyId :: BiscuitWrapper -> Maybe Int
wRootKeyId} =
        let pk :: PublicKey
pk = Maybe Int -> PublicKey
getPublicKey Maybe Int
wRootKeyId
         in (PublicKey
-> BiscuitWrapper
-> Either ParseError (Biscuit OpenOrSealed Verified)
parseBiscuit' PublicKey
pk forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
Applicative m =>
(Set ByteString -> m Bool)
-> BiscuitWrapper -> m (Either ParseError BiscuitWrapper)
checkRevocation Set ByteString -> m Bool
isRevoked BiscuitWrapper
w
   in forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse BiscuitWrapper
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
wrapperToBiscuit Either ParseError BiscuitWrapper
parsedWrapper

-- | Extract the list of revocation ids from a biscuit.
-- To reject revoked biscuits, please use 'parseWith' instead. This function
-- should only be used for inspecting biscuits, not for deciding whether to
-- reject them or not.
getRevocationIds :: Biscuit proof check -> NonEmpty ByteString
getRevocationIds :: forall proof check. Biscuit proof check -> NonEmpty ByteString
getRevocationIds Biscuit{ParsedSignedBlock
authority :: ParsedSignedBlock
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
authority, [ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks} =
  let allBlocks :: NonEmpty ParsedSignedBlock
allBlocks = ParsedSignedBlock
authority forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
      getRevocationId :: (a, Signature, c, d) -> ByteString
getRevocationId (a
_, Signature
sig, c
_, d
_) = Signature -> ByteString
sigBytes Signature
sig
   in forall {a} {c} {d}. (a, Signature, c, d) -> ByteString
getRevocationId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ParsedSignedBlock
allBlocks

-- | Generic version of 'authorizeBiscuitWithLimits' which takes custom 'Limits'.
authorizeBiscuitWithLimits :: Limits -> Biscuit proof Verified -> Authorizer -> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuitWithLimits :: forall proof.
Limits
-> Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuitWithLimits Limits
l biscuit :: Biscuit proof Verified
biscuit@Biscuit{proof
[ParsedSignedBlock]
Maybe Int
ParsedSignedBlock
Symbols
Verified
proofCheck :: Verified
proof :: proof
blocks :: [ParsedSignedBlock]
authority :: ParsedSignedBlock
symbols :: Symbols
rootKeyId :: Maybe Int
proofCheck :: forall proof check. Biscuit proof check -> check
proof :: forall proof check. Biscuit proof check -> proof
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
symbols :: forall proof check. Biscuit proof check -> Symbols
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
..} Authorizer
authorizer =
  let toBlockWithRevocationId :: ((a, a), Signature, c, f (a, b)) -> (a, ByteString, f b)
toBlockWithRevocationId ((a
_, a
block), Signature
sig, c
_, f (a, b)
eSig) = (a
block, Signature -> ByteString
sigBytes Signature
sig, forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
eSig)
      -- the authority block can't be externally signed. If it carries a signature, it won't be
      -- verified. So we need to make sure there is none, to avoid having facts trusted without
      -- a proper signature check
      dropExternalPk :: (a, b, c) -> (a, b, Maybe a)
dropExternalPk (a
b, b
rid, c
_) = (a
b, b
rid, forall a. Maybe a
Nothing)
      withBiscuit :: AuthorizationSuccess -> AuthorizedBiscuit proof
withBiscuit AuthorizationSuccess
authorizationSuccess =
        AuthorizedBiscuit
          { authorizedBiscuit :: Biscuit proof Verified
authorizedBiscuit = Biscuit proof Verified
biscuit
          , AuthorizationSuccess
authorizationSuccess :: AuthorizationSuccess
authorizationSuccess :: AuthorizationSuccess
authorizationSuccess
          }
   in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthorizationSuccess -> AuthorizedBiscuit proof
withBiscuit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Limits
-> BlockWithRevocationId
-> [BlockWithRevocationId]
-> Authorizer
-> IO (Either ExecutionError AuthorizationSuccess)
runAuthorizerWithLimits Limits
l
          (forall {a} {b} {c} {a}. (a, b, c) -> (a, b, Maybe a)
dropExternalPk forall a b. (a -> b) -> a -> b
$ forall {f :: * -> *} {a} {a} {c} {a} {b}.
Functor f =>
((a, a), Signature, c, f (a, b)) -> (a, ByteString, f b)
toBlockWithRevocationId ParsedSignedBlock
authority)
          (forall {f :: * -> *} {a} {a} {c} {a} {b}.
Functor f =>
((a, a), Signature, c, f (a, b)) -> (a, ByteString, f b)
toBlockWithRevocationId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedSignedBlock]
blocks)
          Authorizer
authorizer

-- | Given a biscuit with a verified signature and an authorizer (a set of facts, rules, checks
-- and policies), verify a biscuit:
--
-- - all the checks declared in the biscuit and authorizer must pass
-- - an allow policy provided by the authorizer has to match (policies are tried in order)
-- - the datalog computation must happen in an alloted time, with a capped number of generated
--   facts and a capped number of iterations
--
-- checks and policies declared in the authorizer only operate on the authority block. Facts
-- declared by extra blocks cannot interfere with previous blocks.
--
-- Specific runtime limits can be specified by using 'authorizeBiscuitWithLimits'. 'authorizeBiscuit'
-- uses a set of defaults defined in 'defaultLimits'.
authorizeBiscuit :: Biscuit proof Verified -> Authorizer -> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuit :: forall proof.
Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuit = forall proof.
Limits
-> Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuitWithLimits Limits
defaultLimits

-- | Retrieve the `PublicKey` which was used to verify the `Biscuit` signatures
getVerifiedBiscuitPublicKey :: Biscuit a Verified -> PublicKey
getVerifiedBiscuitPublicKey :: forall a. Biscuit a Verified -> PublicKey
getVerifiedBiscuitPublicKey Biscuit{Verified
proofCheck :: Verified
proofCheck :: forall proof check. Biscuit proof check -> check
proofCheck} =
  let Verified PublicKey
pk = Verified
proofCheck
   in PublicKey
pk

-- | The results of authorization, along with the biscuit that was authorized.
data AuthorizedBiscuit p
  = AuthorizedBiscuit
  { forall p. AuthorizedBiscuit p -> Biscuit p Verified
authorizedBiscuit    :: Biscuit p Verified
  , forall p. AuthorizedBiscuit p -> AuthorizationSuccess
authorizationSuccess :: AuthorizationSuccess
  }
  deriving (AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
forall p.
Eq p =>
AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
$c/= :: forall p.
Eq p =>
AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
== :: AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
$c== :: forall p.
Eq p =>
AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
Eq, Int -> AuthorizedBiscuit p -> ShowS
forall p. Show p => Int -> AuthorizedBiscuit p -> ShowS
forall p. Show p => [AuthorizedBiscuit p] -> ShowS
forall p. Show p => AuthorizedBiscuit p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuthorizedBiscuit p] -> ShowS
$cshowList :: forall p. Show p => [AuthorizedBiscuit p] -> ShowS
show :: AuthorizedBiscuit p -> String
$cshow :: forall p. Show p => AuthorizedBiscuit p -> String
showsPrec :: Int -> AuthorizedBiscuit p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> AuthorizedBiscuit p -> ShowS
Show)

-- | Query the facts generated during authorization. This can be used in conjuction
-- with 'getVariableValues' and 'getSingleVariableValue' to retrieve actual values.
--
-- ⚠ By default, only facts from the authority block and the authorizer are queried,
-- like what happens in rules and checks. Facts from other blocks can be queried
-- with a @trusting@ annotation. Be careful with @trusting previous@, as it queries
-- facts from all blocks, even untrusted ones.
--
-- 💁 If the facts you want to query are part of an allow query in the authorizer,
-- you can directly get values by calling 'getBindings' on 'AuthorizationSuccess'.
--
-- 💁 If you are trying to extract facts from a biscuit in order to generate an
-- authorizer, have a look at 'queryRawBiscuitFacts' instead.
queryAuthorizerFacts :: AuthorizedBiscuit p -> Query
                     -> Set Bindings
queryAuthorizerFacts :: forall p. AuthorizedBiscuit p -> Query -> Set Bindings
queryAuthorizerFacts AuthorizedBiscuit{Biscuit p Verified
authorizedBiscuit :: Biscuit p Verified
authorizedBiscuit :: forall p. AuthorizedBiscuit p -> Biscuit p Verified
authorizedBiscuit, AuthorizationSuccess
authorizationSuccess :: AuthorizationSuccess
authorizationSuccess :: forall p. AuthorizedBiscuit p -> AuthorizationSuccess
authorizationSuccess} =
  let ePks :: [Maybe PublicKey]
ePks = forall openOrSealed check.
Biscuit openOrSealed check -> [Maybe PublicKey]
externalKeys Biscuit p Verified
authorizedBiscuit
   in [Maybe PublicKey] -> AuthorizationSuccess -> Query -> Set Bindings
queryGeneratedFacts [Maybe PublicKey]
ePks AuthorizationSuccess
authorizationSuccess