Copyright | © Clément Delafargue 2021 |
---|---|
License | MIT |
Maintainer | clement@delafargue.name |
Safe Haskell | None |
Language | Haskell2010 |
Module defining the main biscuit-related operations
Synopsis
- data Biscuit proof check
- rootKeyId :: Biscuit proof check -> Maybe Int
- symbols :: Biscuit proof check -> Symbols
- authority :: Biscuit proof check -> ParsedSignedBlock
- blocks :: Biscuit proof check -> [ParsedSignedBlock]
- proof :: Biscuit proof check -> proof
- proofCheck :: Biscuit proof check -> check
- data ParseError
- type ExistingBlock = (ByteString, Block)
- type ParsedSignedBlock = (ExistingBlock, Signature, PublicKey)
- data OpenOrSealed
- data Open
- data Sealed
- class BiscuitProof a where
- toPossibleProofs :: a -> OpenOrSealed
- data Verified
- data Unverified
- mkBiscuit :: SecretKey -> Block -> IO (Biscuit Open Verified)
- mkBiscuitWith :: Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified)
- addBlock :: Block -> Biscuit Open check -> IO (Biscuit Open check)
- data BiscuitEncoding
- data ParserConfig m = ParserConfig {
- encoding :: BiscuitEncoding
- isRevoked :: Set ByteString -> m Bool
- getPublicKey :: Maybe Int -> PublicKey
- parseBiscuitWith :: Applicative m => ParserConfig m -> ByteString -> m (Either ParseError (Biscuit OpenOrSealed Verified))
- parseBiscuitUnverified :: ByteString -> Either ParseError (Biscuit OpenOrSealed Unverified)
- checkBiscuitSignatures :: BiscuitProof proof => (Maybe Int -> PublicKey) -> Biscuit proof Unverified -> Either ParseError (Biscuit proof Verified)
- serializeBiscuit :: BiscuitProof p => Biscuit p Verified -> ByteString
- authorizeBiscuit :: Biscuit proof Verified -> Authorizer -> IO (Either ExecutionError AuthorizationSuccess)
- authorizeBiscuitWithLimits :: Limits -> Biscuit a Verified -> Authorizer -> IO (Either ExecutionError AuthorizationSuccess)
- fromOpen :: Biscuit Open check -> Biscuit OpenOrSealed check
- fromSealed :: Biscuit Sealed check -> Biscuit OpenOrSealed check
- asOpen :: Biscuit OpenOrSealed check -> Maybe (Biscuit Open check)
- asSealed :: Biscuit OpenOrSealed check -> Maybe (Biscuit Sealed check)
- seal :: Biscuit Open check -> Biscuit Sealed check
- getRevocationIds :: Biscuit proof check -> NonEmpty ByteString
- getVerifiedBiscuitPublicKey :: Biscuit a Verified -> PublicKey
Documentation
data Biscuit proof check Source #
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.
rootKeyId :: Biscuit proof check -> Maybe Int Source #
an optional identifier for the expected public key
symbols :: Biscuit proof check -> Symbols Source #
The symbols already defined in the contained blocks
authority :: Biscuit proof check -> ParsedSignedBlock Source #
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.
blocks :: Biscuit proof check -> [ParsedSignedBlock] Source #
The extra blocks, along with the public keys needed
proof :: Biscuit proof check -> proof Source #
The final proof allowing to check the validity of a biscuit
proofCheck :: Biscuit proof check -> check Source #
A value that keeps track of whether the biscuit signatures have been verified or not.
data ParseError Source #
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
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 |
InvalidProtobuf Bool String | The bytestring was correctly deserialized from protobuf, but the values can't be turned into a proper biscuit |
InvalidSignatures | The signatures were invalid |
InvalidProof | The biscuit final proof was invalid |
RevokedBiscuit | The biscuit has been revoked |
Instances
Eq ParseError Source # | |
Defined in Auth.Biscuit.Token (==) :: ParseError -> ParseError -> Bool # (/=) :: ParseError -> ParseError -> Bool # | |
Show ParseError Source # | |
Defined in Auth.Biscuit.Token showsPrec :: Int -> ParseError -> ShowS # show :: ParseError -> String # showList :: [ParseError] -> ShowS # |
type ExistingBlock = (ByteString, Block) Source #
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 ParsedSignedBlock = (ExistingBlock, Signature, PublicKey) Source #
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
data OpenOrSealed Source #
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.
Instances
Eq OpenOrSealed Source # | |
Defined in Auth.Biscuit.Token (==) :: OpenOrSealed -> OpenOrSealed -> Bool # (/=) :: OpenOrSealed -> OpenOrSealed -> Bool # | |
Show OpenOrSealed Source # | |
Defined in Auth.Biscuit.Token showsPrec :: Int -> OpenOrSealed -> ShowS # show :: OpenOrSealed -> String # showList :: [OpenOrSealed] -> ShowS # | |
BiscuitProof OpenOrSealed Source # | |
Defined in Auth.Biscuit.Token |
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.
Instances
BiscuitProof Open Source # | |
Defined in Auth.Biscuit.Token toPossibleProofs :: Open -> OpenOrSealed Source # |
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.
Instances
BiscuitProof Sealed Source # | |
Defined in Auth.Biscuit.Token |
class BiscuitProof a where Source #
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.
toPossibleProofs :: a -> OpenOrSealed Source #
Instances
BiscuitProof Sealed Source # | |
Defined in Auth.Biscuit.Token | |
BiscuitProof Open Source # | |
Defined in Auth.Biscuit.Token toPossibleProofs :: Open -> OpenOrSealed Source # | |
BiscuitProof OpenOrSealed Source # | |
Defined in Auth.Biscuit.Token |
Proof that a biscuit had its signatures verified with the carried root PublicKey
data Unverified Source #
Marker that a biscuit was parsed without having its signatures verified. Such a biscuit cannot be trusted yet.
Instances
Eq Unverified Source # | |
Defined in Auth.Biscuit.Token (==) :: Unverified -> Unverified -> Bool # (/=) :: Unverified -> Unverified -> Bool # | |
Show Unverified Source # | |
Defined in Auth.Biscuit.Token showsPrec :: Int -> Unverified -> ShowS # show :: Unverified -> String # showList :: [Unverified] -> ShowS # |
mkBiscuit :: SecretKey -> Block -> IO (Biscuit Open Verified) Source #
Create a new biscuit with the provided authority block. Such a biscuit is Open
to
further attenuation.
mkBiscuitWith :: Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified) Source #
Create a new biscuit with the provided authority block and root key id. Such a biscuit is Open
to
further attenuation.
data BiscuitEncoding Source #
Biscuits can be transmitted as raw bytes, or as base64-encoded text. This datatype lets the parser know about the expected encoding.
data ParserConfig m Source #
Parsing a biscuit involves various steps. This data type allows configuring those steps.
ParserConfig | |
|
parseBiscuitWith :: Applicative m => ParserConfig m -> ByteString -> m (Either ParseError (Biscuit OpenOrSealed Verified)) Source #
parseBiscuitUnverified :: ByteString -> Either ParseError (Biscuit OpenOrSealed Unverified) Source #
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.
checkBiscuitSignatures :: BiscuitProof proof => (Maybe Int -> PublicKey) -> Biscuit proof Unverified -> Either ParseError (Biscuit proof Verified) Source #
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
.
serializeBiscuit :: BiscuitProof p => Biscuit p Verified -> ByteString Source #
Serialize a biscuit to a raw bytestring
authorizeBiscuit :: Biscuit proof Verified -> Authorizer -> IO (Either ExecutionError AuthorizationSuccess) Source #
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
.
authorizeBiscuitWithLimits :: Limits -> Biscuit a Verified -> Authorizer -> IO (Either ExecutionError AuthorizationSuccess) Source #
Generic version of authorizeBiscuitWithLimits
which takes custom Limits
.
fromOpen :: Biscuit Open check -> Biscuit OpenOrSealed check Source #
Turn a Biscuit
statically known to be Open
into a more generic OpenOrSealed
Biscuit
(essentially forgetting about the fact it's Open
)
fromSealed :: Biscuit Sealed check -> Biscuit OpenOrSealed check Source #
Turn a Biscuit
statically known to be Sealed
into a more generic OpenOrSealed
Biscuit
(essentially forgetting about the fact it's Sealed
)
getRevocationIds :: Biscuit proof check -> NonEmpty ByteString Source #
Extract the list of revocation ids from a biscuit.
To reject revoked biscuits, please use parseWith
instead. This function
should only be used for debugging purposes.