Copyright | © Clément Delafargue 2021 |
---|---|
License | MIT |
Maintainer | clement@delafargue.name |
Safe Haskell | None |
Language | Haskell2010 |
Haskell implementation for the Biscuit token.
Synopsis
- newKeypair :: IO Keypair
- fromPrivateKey :: PrivateKey -> IO Keypair
- data PrivateKey
- data PublicKey
- data Keypair = Keypair {}
- serializePrivateKeyHex :: PrivateKey -> ByteString
- serializePublicKeyHex :: PublicKey -> ByteString
- parsePrivateKeyHex :: ByteString -> Maybe PrivateKey
- parsePublicKeyHex :: ByteString -> Maybe PublicKey
- serializePrivateKey :: PrivateKey -> ByteString
- serializePublicKey :: PublicKey -> ByteString
- parsePrivateKey :: ByteString -> Maybe PrivateKey
- parsePublicKey :: ByteString -> Maybe PublicKey
- block :: QuasiQuoter
- blockContext :: Text -> Block
- mkBiscuit :: Keypair -> Block -> IO Biscuit
- addBlock :: Block -> Biscuit -> IO Biscuit
- data Biscuit
- type Block = Block' 'RegularString
- serializeB64 :: Biscuit -> ByteString
- parseB64 :: ByteString -> Either ParseError Biscuit
- parse :: ByteString -> Either ParseError Biscuit
- serialize :: Biscuit -> ByteString
- parseHex :: ByteString -> Either ParseError Biscuit
- serializeHex :: Biscuit -> ByteString
- verifier :: QuasiQuoter
- verifyBiscuit :: Biscuit -> Verifier -> PublicKey -> IO (Either VerificationError Query)
- verifyBiscuitWithLimits :: Limits -> Biscuit -> Verifier -> PublicKey -> IO (Either VerificationError Query)
- checkBiscuitSignature :: Biscuit -> PublicKey -> IO Bool
- defaultLimits :: Limits
- type Verifier = Verifier' 'RegularString
- data ParseError
- data VerificationError
- data ExecutionError
- data Limits = Limits {
- maxFacts :: Int
- maxIterations :: Int
- maxTime :: Int
- allowRegexes :: Bool
- allowBlockFacts :: Bool
- checkRevocationId :: ByteString -> IO (Either () ())
The biscuit auth token
Biscuit is a bearer token, allowing offline attenuation (meaning that anyone having a token can restrict its use), and public key verification. Token rights and attenuation are expressed using a logic language.
Here's how to create a biscuit token:
buildToken :: Keypair -> IO Biscuit buildToken keypair = mkBiscuit keypair [block| // the token holder is identified as `user_1234` user(#authority, "user_1234"); // the token holder is granted access to resource `file1` resource(#authority, "file1"); // the token can only be used before a specified date check if time(#ambient, $time), $time < 2021-05-08T00:00:00Z; |]
Here's how to attenuate a biscuit token:
restrictToken :: Biscuit -> IO Biscuit restrictToken = addBlock [block| // restrict the token to local use only check if user_ip_address(#ambient, "127.0.0.1"); |]
Here's how to verify a biscuit token:
verifyToken :: PublicKey -> Biscuit -> IO Bool verifyToken publicKey biscuit = do now <- getCurrentTime let verif = [verifier| // the datalog snippets can reference haskell variables current_time(#ambient, ${now}); // policies are tried in order allow if resource(#authority, "file1"); // catch-all policy if the previous ones did not match deny if true; |] result <- verifyBiscuit biscuit [verifier|current_time()|] case result of Left e -> print e $> False Right _ -> pure True
Creating keypairs
newKeypair :: IO Keypair Source #
Generate a random keypair
fromPrivateKey :: PrivateKey -> IO Keypair Source #
Construct a keypair from a private key
data PrivateKey Source #
A private key used to generate a biscuit
Instances
Eq PrivateKey Source # | |
Defined in Auth.Biscuit.Sel (==) :: PrivateKey -> PrivateKey -> Bool # (/=) :: PrivateKey -> PrivateKey -> Bool # | |
Ord PrivateKey Source # | |
Defined in Auth.Biscuit.Sel compare :: PrivateKey -> PrivateKey -> Ordering # (<) :: PrivateKey -> PrivateKey -> Bool # (<=) :: PrivateKey -> PrivateKey -> Bool # (>) :: PrivateKey -> PrivateKey -> Bool # (>=) :: PrivateKey -> PrivateKey -> Bool # max :: PrivateKey -> PrivateKey -> PrivateKey # min :: PrivateKey -> PrivateKey -> PrivateKey # | |
Show PrivateKey Source # | |
Defined in Auth.Biscuit.Sel showsPrec :: Int -> PrivateKey -> ShowS # show :: PrivateKey -> String # showList :: [PrivateKey] -> ShowS # |
A public key used to generate a biscuit
A keypair containing both a private key and a public key
Keypair | |
|
Parsing and serializing keypairs
serializePrivateKeyHex :: PrivateKey -> ByteString Source #
Get an hex bytestring from a private key
serializePublicKeyHex :: PublicKey -> ByteString Source #
Get an hex bytestring from a public key
parsePrivateKeyHex :: ByteString -> Maybe PrivateKey Source #
Read a private key from an hex bytestring
parsePublicKeyHex :: ByteString -> Maybe PublicKey Source #
Read a public key from an hex bytestring
serializePrivateKey :: PrivateKey -> ByteString Source #
Serialize a private key to raw bytes
serializePublicKey :: PublicKey -> ByteString Source #
Serialize a public key to raw bytes
parsePrivateKey :: ByteString -> Maybe PrivateKey Source #
Parse a private key from raw bytes.
This returns Nothing
if the raw bytes don't have the expected length
parsePublicKey :: ByteString -> Maybe PublicKey Source #
Parse a public key from raw bytes.
This returns Nothing
if the raw bytes don't have the expected length
Creating a biscuit
block :: QuasiQuoter Source #
Quasiquoter for a block expression. You can reference haskell variables
like this: ${variableName}
.
A typical use of block
looks like this:
[block| resource(#authority, ${fileName}); rule($variable) <- fact($value), other_fact($value); check if operation(#ambient, #read); |]
blockContext :: Text -> Block Source #
Build a block containing an explicit context value.
The context of a block can't be parsed from datalog currently,
so you'll need an explicit call to blockContext
to add it
[block|check if time(#ambient, $t), $t < 2021-01-01;|] <> blockContext "ttl-check"
mkBiscuit :: Keypair -> Block -> IO Biscuit Source #
Create a new biscuit with the provided authority block
addBlock :: Block -> Biscuit -> IO Biscuit Source #
Add a block to an existing biscuit. The block will be signed with a randomly-generated keypair
A parsed biscuit
type Block = Block' 'RegularString Source #
A biscuit block, containing facts, rules and checks.
Block
has a Monoid
instance, this is the expected way
to build composite blocks (eg if you need to generate a list of facts):
-- build a block containing a list of facts `value("a"); value("b"); value("c");`. foldMap (\v -> [block| value(${v}) |]) ["a", "b", "c"]
Parsing and serializing biscuits
serializeB64 :: Biscuit -> ByteString Source #
Serialize a biscuit to URL-compatible base 64, as recommended by the spec
parseB64 :: ByteString -> Either ParseError Biscuit Source #
Parse a biscuit from a URL-compatible base 64 encoded bytestring
parse :: ByteString -> Either ParseError Biscuit Source #
Parse a biscuit from a raw bytestring. If you want to parse
from a URL-compatible base 64 bytestring, consider using parseB64
instead
serialize :: Biscuit -> ByteString Source #
Serialize a biscuit to a binary format. If you intend to send
the biscuit over a text channel, consider using serializeB64
or
serializeHex
instead
parseHex :: ByteString -> Either ParseError Biscuit Source #
Parse a biscuit from an hex-encoded bytestring
serializeHex :: Biscuit -> ByteString Source #
Serialize a biscuit to a hex (base 16) string. Be advised that the specs recommends base 64 instead.
Verifying a biscuit
verifier :: QuasiQuoter Source #
Quasiquoter for a verifier expression. You can reference haskell variables
like this: ${variableName}
.
A typical use of block
looks like this:
[verifier| current_time(#ambient, ${now}); allow if resource(#authority, "file1"); deny if true; |]
verifyBiscuit :: Biscuit -> Verifier -> PublicKey -> IO (Either VerificationError Query) Source #
Same as verifyBiscuitWithLimits
, but with default limits (1ms timeout, max 1000 facts, max 100 iterations)
verifyBiscuitWithLimits :: Limits -> Biscuit -> Verifier -> PublicKey -> IO (Either VerificationError Query) Source #
Given a provided verifier (a set of facts, rules, checks and policies), and a public key, verify a biscuit:
- make sure the biscuit has been signed with the private key associated to the public key
- make sure the biscuit is valid for the provided verifier
checkBiscuitSignature :: Biscuit -> PublicKey -> IO Bool Source #
Only check a biscuit signature. This can be used to perform an early check, before bothering with constructing a verifier.
defaultLimits :: Limits Source #
Default settings for the executor restrictions. (1000 facts, 100 iterations, 1000μs max, regexes are allowed, facts and rules are allowed in blocks)
type Verifier = Verifier' 'RegularString Source #
A biscuit verifier, containing, facts, rules, checks and policies
data ParseError Source #
Errors that can happen when parsing a biscuit
InvalidHexEncoding | The provided ByteString is not hex-encoded |
InvalidB64Encoding | The provided ByteString is not base64-encoded |
InvalidProtobufSer String | The provided ByteString does not contain properly serialized protobuf values |
InvalidProtobuf String | The bytestring was correctly deserialized from protobuf, but the values can't be turned into a proper biscuit |
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 # |
data VerificationError Source #
An error that can happen when verifying a biscuit
SignatureError | The signature is invalid |
DatalogError ExecutionError | The checks and policies could not be verified |
Instances
Eq VerificationError Source # | |
Defined in Auth.Biscuit.Token (==) :: VerificationError -> VerificationError -> Bool # (/=) :: VerificationError -> VerificationError -> Bool # | |
Show VerificationError Source # | |
Defined in Auth.Biscuit.Token showsPrec :: Int -> VerificationError -> ShowS # show :: VerificationError -> String # showList :: [VerificationError] -> ShowS # |
data ExecutionError Source #
The result of running verification
Timeout | Verification took too much time |
TooManyFacts | Too many facts were generated during evaluation |
TooManyIterations | Evaluation did not converge in the alloted number of iterations |
FactsInBlocks | Some blocks contained either rules or facts while it was forbidden |
ResultError ResultError | The checks and policies were not fulfilled after evaluation |
Instances
Eq ExecutionError Source # | |
Defined in Auth.Biscuit.Datalog.Executor (==) :: ExecutionError -> ExecutionError -> Bool # (/=) :: ExecutionError -> ExecutionError -> Bool # | |
Show ExecutionError Source # | |
Defined in Auth.Biscuit.Datalog.Executor showsPrec :: Int -> ExecutionError -> ShowS # show :: ExecutionError -> String # showList :: [ExecutionError] -> ShowS # |
Settings for the executor restrictions
See defaultLimits
for default values.
Limits | |
|