biscuit-haskell-0.1.1.0: Library support for the Biscuit security token
Copyright© Clément Delafargue 2021
LicenseMIT
Maintainerclement@delafargue.name
Safe HaskellNone
LanguageHaskell2010

Auth.Biscuit

Description

Haskell implementation for the Biscuit token.

Synopsis

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

data PublicKey Source #

A public key used to generate a biscuit

Instances

Instances details
Eq PublicKey Source # 
Instance details

Defined in Auth.Biscuit.Sel

Ord PublicKey Source # 
Instance details

Defined in Auth.Biscuit.Sel

Show PublicKey Source # 
Instance details

Defined in Auth.Biscuit.Sel

data Keypair Source #

A keypair containing both a private key and a public key

Constructors

Keypair 

Fields

Instances

Instances details
Eq Keypair Source # 
Instance details

Defined in Auth.Biscuit.Sel

Methods

(==) :: Keypair -> Keypair -> Bool #

(/=) :: Keypair -> Keypair -> Bool #

Ord Keypair Source # 
Instance details

Defined in Auth.Biscuit.Sel

Show Keypair Source # 
Instance details

Defined in Auth.Biscuit.Sel

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

data Biscuit Source #

A parsed biscuit

Instances

Instances details
Eq Biscuit Source # 
Instance details

Defined in Auth.Biscuit.Token

Methods

(==) :: Biscuit -> Biscuit -> Bool #

(/=) :: Biscuit -> Biscuit -> Bool #

Show Biscuit Source # 
Instance details

Defined in Auth.Biscuit.Token

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

Constructors

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

Instances details
Eq ParseError Source # 
Instance details

Defined in Auth.Biscuit.Token

Show ParseError Source # 
Instance details

Defined in Auth.Biscuit.Token

data VerificationError Source #

An error that can happen when verifying a biscuit

Constructors

SignatureError

The signature is invalid

DatalogError ExecutionError

The checks and policies could not be verified

data ExecutionError Source #

The result of running verification

Constructors

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

data Limits Source #

Settings for the executor restrictions See defaultLimits for default values.

Constructors

Limits 

Fields