{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Auth.Biscuit.Token
( Biscuit
, rootKeyId
, symbols
, authority
, blocks
, proof
, proofCheck
, queryRawBiscuitFacts
, ParseError (..)
, ExistingBlock
, ParsedSignedBlock
, AuthorizedBiscuit (..)
, queryAuthorizerFacts
, 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
, 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.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
type ExistingBlock = (ByteString, Block)
type ParsedSignedBlock = (ExistingBlock, Signature, PublicKey, Maybe (Signature, PublicKey))
data OpenOrSealed
= SealedProof Signature
| OpenProof SecretKey
deriving (OpenOrSealed -> OpenOrSealed -> Bool
(OpenOrSealed -> OpenOrSealed -> Bool)
-> (OpenOrSealed -> OpenOrSealed -> Bool) -> Eq OpenOrSealed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenOrSealed -> OpenOrSealed -> Bool
== :: OpenOrSealed -> OpenOrSealed -> Bool
$c/= :: OpenOrSealed -> OpenOrSealed -> Bool
/= :: OpenOrSealed -> OpenOrSealed -> Bool
Eq, Int -> OpenOrSealed -> ShowS
[OpenOrSealed] -> ShowS
OpenOrSealed -> String
(Int -> OpenOrSealed -> ShowS)
-> (OpenOrSealed -> String)
-> ([OpenOrSealed] -> ShowS)
-> Show OpenOrSealed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenOrSealed -> ShowS
showsPrec :: Int -> OpenOrSealed -> ShowS
$cshow :: OpenOrSealed -> String
show :: OpenOrSealed -> String
$cshowList :: [OpenOrSealed] -> ShowS
showList :: [OpenOrSealed] -> ShowS
Show)
newtype Open = Open SecretKey
deriving stock (Open -> Open -> Bool
(Open -> Open -> Bool) -> (Open -> Open -> Bool) -> Eq Open
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Open -> Open -> Bool
== :: Open -> Open -> Bool
$c/= :: Open -> Open -> Bool
/= :: Open -> Open -> Bool
Eq, Int -> Open -> ShowS
[Open] -> ShowS
Open -> String
(Int -> Open -> ShowS)
-> (Open -> String) -> ([Open] -> ShowS) -> Show Open
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Open -> ShowS
showsPrec :: Int -> Open -> ShowS
$cshow :: Open -> String
show :: Open -> String
$cshowList :: [Open] -> ShowS
showList :: [Open] -> ShowS
Show)
newtype Sealed = Sealed Signature
deriving stock (Sealed -> Sealed -> Bool
(Sealed -> Sealed -> Bool)
-> (Sealed -> Sealed -> Bool) -> Eq Sealed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sealed -> Sealed -> Bool
== :: Sealed -> Sealed -> Bool
$c/= :: Sealed -> Sealed -> Bool
/= :: Sealed -> Sealed -> Bool
Eq, Int -> Sealed -> ShowS
[Sealed] -> ShowS
Sealed -> String
(Int -> Sealed -> ShowS)
-> (Sealed -> String) -> ([Sealed] -> ShowS) -> Show Sealed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sealed -> ShowS
showsPrec :: Int -> Sealed -> ShowS
$cshow :: Sealed -> String
show :: Sealed -> String
$cshowList :: [Sealed] -> ShowS
showList :: [Sealed] -> ShowS
Show)
class BiscuitProof a where
toPossibleProofs :: a -> OpenOrSealed
instance BiscuitProof OpenOrSealed where
toPossibleProofs :: OpenOrSealed -> OpenOrSealed
toPossibleProofs = OpenOrSealed -> OpenOrSealed
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
newtype Verified = Verified PublicKey
deriving stock (Verified -> Verified -> Bool
(Verified -> Verified -> Bool)
-> (Verified -> Verified -> Bool) -> Eq Verified
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verified -> Verified -> Bool
== :: Verified -> Verified -> Bool
$c/= :: Verified -> Verified -> Bool
/= :: Verified -> Verified -> Bool
Eq, Int -> Verified -> ShowS
[Verified] -> ShowS
Verified -> String
(Int -> Verified -> ShowS)
-> (Verified -> String) -> ([Verified] -> ShowS) -> Show Verified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verified -> ShowS
showsPrec :: Int -> Verified -> ShowS
$cshow :: Verified -> String
show :: Verified -> String
$cshowList :: [Verified] -> ShowS
showList :: [Verified] -> ShowS
Show)
data Unverified = Unverified
deriving stock (Unverified -> Unverified -> Bool
(Unverified -> Unverified -> Bool)
-> (Unverified -> Unverified -> Bool) -> Eq Unverified
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Unverified -> Unverified -> Bool
== :: Unverified -> Unverified -> Bool
$c/= :: Unverified -> Unverified -> Bool
/= :: Unverified -> Unverified -> Bool
Eq, Int -> Unverified -> ShowS
[Unverified] -> ShowS
Unverified -> String
(Int -> Unverified -> ShowS)
-> (Unverified -> String)
-> ([Unverified] -> ShowS)
-> Show Unverified
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Unverified -> ShowS
showsPrec :: Int -> Unverified -> ShowS
$cshow :: Unverified -> String
show :: Unverified -> String
$cshowList :: [Unverified] -> ShowS
showList :: [Unverified] -> ShowS
Show)
data Biscuit proof check
= Biscuit
{ forall proof check. Biscuit proof check -> Maybe Int
rootKeyId :: Maybe Int
, forall proof check. Biscuit proof check -> Symbols
symbols :: Symbols
, forall proof check. Biscuit proof check -> ParsedSignedBlock
authority :: ParsedSignedBlock
, forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
, forall proof check. Biscuit proof check -> proof
proof :: proof
, forall proof check. Biscuit proof check -> check
proofCheck :: check
}
deriving (Biscuit proof check -> Biscuit proof check -> Bool
(Biscuit proof check -> Biscuit proof check -> Bool)
-> (Biscuit proof check -> Biscuit proof check -> Bool)
-> Eq (Biscuit proof check)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall proof check.
(Eq proof, Eq check) =>
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
/= :: Biscuit proof check -> Biscuit proof check -> Bool
Eq, Int -> Biscuit proof check -> ShowS
[Biscuit proof check] -> ShowS
Biscuit proof check -> String
(Int -> Biscuit proof check -> ShowS)
-> (Biscuit proof check -> String)
-> ([Biscuit proof check] -> ShowS)
-> Show (Biscuit proof check)
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
$cshowsPrec :: forall proof check.
(Show proof, Show check) =>
Int -> Biscuit proof check -> ShowS
showsPrec :: Int -> Biscuit proof check -> ShowS
$cshow :: forall proof check.
(Show proof, Show check) =>
Biscuit proof check -> String
show :: Biscuit proof check -> String
$cshowList :: forall proof check.
(Show proof, Show check) =>
[Biscuit proof check] -> ShowS
showList :: [Biscuit proof check] -> ShowS
Show)
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 :: forall proof check. Biscuit proof check -> ParsedSignedBlock
authority :: ParsedSignedBlock
authority,[ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks} =
let ePks :: [Maybe PublicKey]
ePks = Biscuit openOrSealed check -> [Maybe PublicKey]
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 = [Nat] -> [Block] -> [(Nat, Block)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Nat
0..] ([Block] -> [(Nat, Block)]) -> [Block] -> [(Nat, Block)]
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock -> Block
forall {a} {b} {b} {c} {d}. ((a, b), b, c, d) -> b
getBlock (ParsedSignedBlock -> Block) -> [ParsedSignedBlock] -> [Block]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsedSignedBlock
authority ParsedSignedBlock -> [ParsedSignedBlock] -> [ParsedSignedBlock]
forall a. a -> [a] -> [a]
: [ParsedSignedBlock]
blocks
(Map Nat (Set EvalRule)
_, FactGroup
sFacts) = ((Nat, Block) -> (Map Nat (Set EvalRule), FactGroup))
-> [(Nat, Block)] -> (Map Nat (Set EvalRule), FactGroup)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Nat -> EvalBlock -> (Map Nat (Set EvalRule), FactGroup))
-> (Nat, EvalBlock) -> (Map Nat (Set EvalRule), FactGroup)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Nat -> EvalBlock -> (Map Nat (Set EvalRule), FactGroup)
collectWorld ((Nat, EvalBlock) -> (Map Nat (Set EvalRule), FactGroup))
-> ((Nat, Block) -> (Nat, EvalBlock))
-> (Nat, Block)
-> (Map Nat (Set EvalRule), FactGroup)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Block -> EvalBlock) -> (Nat, Block) -> (Nat, EvalBlock)
forall a b. (a -> b) -> (Nat, a) -> (Nat, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Maybe PublicKey] -> Block -> EvalBlock
forall (elem :: EvaluationContext -> DatalogContext -> *).
ToEvaluation elem =>
[Maybe PublicKey]
-> elem 'Repr 'Representation -> elem 'Eval 'Representation
toEvaluation [Maybe PublicKey]
ePks)) [(Nat, Block)]
allBlocks
in [Maybe PublicKey] -> FactGroup -> Limits -> Query -> Set Bindings
queryAvailableFacts [Maybe PublicKey]
ePks FactGroup
sFacts
queryRawBiscuitFacts :: Biscuit openOrSealed check -> Query
-> Set Bindings
queryRawBiscuitFacts :: forall openOrSealed check.
Biscuit openOrSealed check -> Query -> Set Bindings
queryRawBiscuitFacts Biscuit openOrSealed check
b = Biscuit openOrSealed check -> Limits -> Query -> Set Bindings
forall openOrSealed check.
Biscuit openOrSealed check -> Limits -> Query -> Set Bindings
queryRawBiscuitFactsWithLimits Biscuit openOrSealed check
b Limits
defaultLimits
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 }
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 }
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 :: forall proof check. Biscuit proof check -> proof
proof :: OpenOrSealed
proof} = case OpenOrSealed
proof of
SealedProof Signature
p -> Biscuit Sealed check -> Maybe (Biscuit Sealed check)
forall a. a -> Maybe a
Just (Biscuit Sealed check -> Maybe (Biscuit Sealed check))
-> Biscuit Sealed check -> Maybe (Biscuit Sealed check)
forall a b. (a -> b) -> a -> b
$ Biscuit OpenOrSealed check
b { proof :: Sealed
proof = Signature -> Sealed
Sealed Signature
p }
OpenOrSealed
_ -> Maybe (Biscuit Sealed check)
forall a. Maybe a
Nothing
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 :: forall proof check. Biscuit proof check -> proof
proof :: OpenOrSealed
proof} = case OpenOrSealed
proof of
OpenProof SecretKey
p -> Biscuit Open check -> Maybe (Biscuit Open check)
forall a. a -> Maybe a
Just (Biscuit Open check -> Maybe (Biscuit Open check))
-> Biscuit Open check -> Maybe (Biscuit Open check)
forall a b. (a -> b) -> a -> b
$ Biscuit OpenOrSealed check
b { proof :: Open
proof = SecretKey -> Open
Open SecretKey
p }
OpenOrSealed
_ -> Maybe (Biscuit Open check)
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)
mkBiscuit :: SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuit :: SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuit = Maybe Int -> SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuitWith Maybe Int
forall a. Maybe a
Nothing
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 (Block -> ByteString)
-> (BlockSymbols, Block) -> (BlockSymbols, ByteString)
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 Maybe (Signature, PublicKey)
forall a. Maybe a
Nothing
Biscuit Open Verified -> IO (Biscuit Open Verified)
forall a. a -> IO a
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 (PublicKey -> Verified) -> PublicKey -> Verified
forall a b. (a -> b) -> a -> b
$ SecretKey -> PublicKey
toPublic SecretKey
sk
}
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: Open
proofCheck :: check
..} = do
let (BlockSymbols
blockSymbols, ByteString
blockSerialized) = Block -> ByteString
PB.encodeBlock (Block -> ByteString)
-> (BlockSymbols, Block) -> (BlockSymbols, ByteString)
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 Maybe (Signature, PublicKey)
forall a. Maybe a
Nothing
Biscuit Open check -> IO (Biscuit Open check)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Biscuit Open check -> IO (Biscuit Open check))
-> Biscuit Open check -> IO (Biscuit Open check)
forall a b. (a -> b) -> a -> b
$ Biscuit Open check
b { blocks :: [ParsedSignedBlock]
blocks = [ParsedSignedBlock]
blocks [ParsedSignedBlock] -> [ParsedSignedBlock] -> [ParsedSignedBlock]
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
}
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: Open
proofCheck :: check
..} = do
let symbolsForCurrentBlock :: Symbols
symbolsForCurrentBlock = Symbols -> Symbols
forgetSymbols (Symbols -> Symbols) -> Symbols -> Symbols
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 (Block -> ByteString)
-> (BlockSymbols, Block) -> (BlockSymbols, ByteString)
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 = NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a. NonEmpty a -> a
NE.last (ParsedSignedBlock
authority ParsedSignedBlock
-> [ParsedSignedBlock] -> NonEmpty ParsedSignedBlock
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
Biscuit Open check -> IO (Biscuit Open check)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Biscuit Open check -> IO (Biscuit Open check))
-> Biscuit Open check -> IO (Biscuit Open check)
forall a b. (a -> b) -> a -> b
$ Biscuit Open check
b { blocks :: [ParsedSignedBlock]
blocks = [ParsedSignedBlock]
blocks [ParsedSignedBlock] -> [ParsedSignedBlock] -> [ParsedSignedBlock]
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] (Symbols -> Symbols) -> Symbols -> Symbols
forall a b. (a -> b) -> a -> b
$
[PublicKey] -> Symbols -> Symbols
registerNewPublicKeys [PublicKey]
pkTable Symbols
newSymbolTable
(BlockSymbols
_, ByteString
payload) = Block -> ByteString
PB.encodeBlock (Block -> ByteString)
-> (BlockSymbols, Block) -> (BlockSymbols, ByteString)
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)
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 (ThirdPartyBlockRequest -> Either String (PublicKey, [PublicKey]))
-> Either String ThirdPartyBlockRequest
-> Either String (PublicKey, [PublicKey])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Either String ThirdPartyBlockRequest
PB.decodeThirdPartyBlockRequest ByteString
req
ByteString -> Either String ByteString
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ThirdPartyBlockContents -> ByteString
PB.encodeThirdPartyBlockContents (ThirdPartyBlockContents -> ByteString)
-> ((ByteString, Signature, PublicKey) -> ThirdPartyBlockContents)
-> (ByteString, Signature, PublicKey)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Signature, PublicKey) -> ThirdPartyBlockContents
thirdPartyBlockContentsToPb ((ByteString, Signature, PublicKey) -> ByteString)
-> (ByteString, Signature, PublicKey) -> ByteString
forall a b. (a -> b) -> a -> b
$ SecretKey
-> [PublicKey]
-> PublicKey
-> Block
-> (ByteString, Signature, PublicKey)
mkThirdPartyBlock' SecretKey
eSk [PublicKey]
pkTable PublicKey
previousPk Block
block
mkThirdPartyBlockReq :: Biscuit proof check -> ByteString
mkThirdPartyBlockReq :: forall proof check. Biscuit proof check -> ByteString
mkThirdPartyBlockReq Biscuit{ParsedSignedBlock
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
authority :: ParsedSignedBlock
authority,[ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks,Symbols
symbols :: forall proof check. Biscuit proof check -> Symbols
symbols :: Symbols
symbols} =
let ((ByteString, Block)
_, Signature
_ , PublicKey
lastPk, Maybe (Signature, PublicKey)
_) = NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a. NonEmpty a -> a
NE.last (NonEmpty ParsedSignedBlock -> ParsedSignedBlock)
-> NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock
authority ParsedSignedBlock
-> [ParsedSignedBlock] -> NonEmpty ParsedSignedBlock
forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
in ThirdPartyBlockRequest -> ByteString
PB.encodeThirdPartyBlockRequest (ThirdPartyBlockRequest -> ByteString)
-> ThirdPartyBlockRequest -> ByteString
forall a b. (a -> b) -> a -> b
$ (PublicKey, [PublicKey]) -> ThirdPartyBlockRequest
thirdPartyBlockRequestToPb (PublicKey
lastPk, Symbols -> [PublicKey]
getPkTable Symbols
symbols)
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: Open
proofCheck :: check
..} ByteString
contents = do
(ByteString
payload, Signature
eSig, PublicKey
ePk) <- ThirdPartyBlockContents
-> Either String (ByteString, Signature, PublicKey)
pbToThirdPartyBlockContents (ThirdPartyBlockContents
-> Either String (ByteString, Signature, PublicKey))
-> Either String ThirdPartyBlockContents
-> Either String (ByteString, Signature, PublicKey)
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, (Signature, PublicKey) -> Maybe (Signature, PublicKey)
forall a. a -> Maybe a
Just (Signature
eSig, PublicKey
ePk))
((ByteString, Block)
_, Signature
_, PublicKey
lastPk, Maybe (Signature, PublicKey)
_) = NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a. NonEmpty a -> a
NE.last (NonEmpty ParsedSignedBlock -> ParsedSignedBlock)
-> NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock
authority ParsedSignedBlock
-> [ParsedSignedBlock] -> NonEmpty ParsedSignedBlock
forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
Block
pbBlock <- ByteString -> Either String Block
PB.decodeBlock ByteString
payload
(Block
block, Symbols
newSymbols) <- (StateT Symbols (Either String) Block
-> Symbols -> Either String (Block, Symbols)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` Symbols
symbols) (StateT Symbols (Either String) Block
-> Either String (Block, Symbols))
-> StateT Symbols (Either String) Block
-> Either String (Block, Symbols)
forall a b. (a -> b) -> a -> b
$ Maybe PublicKey -> Block -> StateT Symbols (Either String) Block
pbToBlock (PublicKey -> Maybe PublicKey
forall a. a -> Maybe a
Just PublicKey
ePk) Block
pbBlock
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PublicKey -> (ByteString, Signature, PublicKey) -> Bool
verifyExternalSig PublicKey
lastPk (ByteString
payload, Signature
eSig, PublicKey
ePk)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left String
"Invalid 3rd party signature"
IO (Biscuit Open check) -> Either String (IO (Biscuit Open check))
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IO (Biscuit Open check)
-> Either String (IO (Biscuit Open check)))
-> IO (Biscuit Open check)
-> Either String (IO (Biscuit Open check))
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 ((Signature, PublicKey) -> Maybe (Signature, PublicKey)
forall a. a -> Maybe a
Just (Signature
eSig, PublicKey
ePk))
Biscuit Open check -> IO (Biscuit Open check)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Biscuit Open check -> IO (Biscuit Open check))
-> Biscuit Open check -> IO (Biscuit Open check)
forall a b. (a -> b) -> a -> b
$ Biscuit Open check
b { blocks :: [ParsedSignedBlock]
blocks = [ParsedSignedBlock]
blocks [ParsedSignedBlock] -> [ParsedSignedBlock] -> [ParsedSignedBlock]
forall a. Semigroup a => a -> a -> a
<> [Block -> SignedBlock -> ParsedSignedBlock
toParsedSignedBlock Block
block (SignedBlock -> SignedBlock
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 :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks} =
let getEpk :: (a, b, c, Maybe (a, a)) -> Maybe a
getEpk (a
_, b
_, c
_, Just (a
_, a
ePk)) = a -> Maybe a
forall a. a -> Maybe a
Just a
ePk
getEpk (a, b, c, Maybe (a, a))
_ = Maybe a
forall a. Maybe a
Nothing
in Maybe PublicKey
forall a. Maybe a
Nothing Maybe PublicKey -> [Maybe PublicKey] -> [Maybe PublicKey]
forall a. a -> [a] -> [a]
: (ParsedSignedBlock -> Maybe PublicKey
forall {a} {b} {c} {a} {a}. (a, b, c, Maybe (a, a)) -> Maybe a
getEpk (ParsedSignedBlock -> Maybe PublicKey)
-> [ParsedSignedBlock] -> [Maybe PublicKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedSignedBlock]
blocks)
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: Open
proofCheck :: check
..} =
let Open SecretKey
sk = Open
proof
((ByteString
lastPayload, Block
_), Signature
lastSig, PublicKey
lastPk, Maybe (Signature, PublicKey)
eSig) = NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a. NonEmpty a -> a
NE.last (NonEmpty ParsedSignedBlock -> ParsedSignedBlock)
-> NonEmpty ParsedSignedBlock -> ParsedSignedBlock
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock
authority ParsedSignedBlock
-> [ParsedSignedBlock] -> NonEmpty ParsedSignedBlock
forall a. a -> [a] -> NonEmpty a
:| [ParsedSignedBlock]
blocks
newProof :: Sealed
newProof = Signature -> Sealed
Sealed (Signature -> Sealed) -> Signature -> 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 }
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: p
proofCheck :: Verified
..} =
let proofField :: Proof
proofField = case p -> OpenOrSealed
forall a. BiscuitProof a => a -> OpenOrSealed
toPossibleProofs p
proof of
SealedProof Signature
sig -> Required 2 (Value ByteString) -> Proof
PB.ProofSignature (Required 2 (Value ByteString) -> Proof)
-> Required 2 (Value ByteString) -> Proof
forall a b. (a -> b) -> a -> b
$ FieldType (Field 2 (RequiredField (Always (Value ByteString))))
-> Field 2 (RequiredField (Always (Value ByteString)))
forall a. HasField a => FieldType a -> a
PB.putField (Signature -> ByteString
sigBytes Signature
sig)
OpenProof SecretKey
sk -> Required 1 (Value ByteString) -> Proof
PB.ProofSecret (Required 1 (Value ByteString) -> Proof)
-> Required 1 (Value ByteString) -> Proof
forall a b. (a -> b) -> a -> b
$ FieldType (Field 1 (RequiredField (Always (Value ByteString))))
-> Field 1 (RequiredField (Always (Value ByteString)))
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 = FieldType (Optional 1 (Value Int32)) -> Optional 1 (Value Int32)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Optional 1 (Value Int32)) -> Optional 1 (Value Int32))
-> FieldType (Optional 1 (Value Int32)) -> Optional 1 (Value Int32)
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Maybe Int -> Maybe Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
rootKeyId
, $sel:authority:Biscuit :: Required 2 (Message SignedBlock)
authority = FieldType (Required 2 (Message SignedBlock))
-> Required 2 (Message SignedBlock)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Required 2 (Message SignedBlock))
-> Required 2 (Message SignedBlock))
-> FieldType (Required 2 (Message SignedBlock))
-> Required 2 (Message SignedBlock)
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock -> SignedBlock
toPBSignedBlock ParsedSignedBlock
authority
, $sel:blocks:Biscuit :: Repeated 3 (Message SignedBlock)
blocks = FieldType (Repeated 3 (Message SignedBlock))
-> Repeated 3 (Message SignedBlock)
forall a. HasField a => FieldType a -> a
PB.putField (FieldType (Repeated 3 (Message SignedBlock))
-> Repeated 3 (Message SignedBlock))
-> FieldType (Repeated 3 (Message SignedBlock))
-> Repeated 3 (Message SignedBlock)
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock -> SignedBlock
toPBSignedBlock (ParsedSignedBlock -> SignedBlock)
-> [ParsedSignedBlock] -> [SignedBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedSignedBlock]
blocks
, $sel:proof:Biscuit :: Required 4 (Message Proof)
proof = FieldType (Field 4 (RequiredField (Always (Message Proof))))
-> Field 4 (RequiredField (Always (Message Proof)))
forall a. HasField a => FieldType a -> a
PB.putField FieldType (Field 4 (RequiredField (Always (Message Proof))))
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)
data ParseError
= InvalidHexEncoding
| InvalidB64Encoding
| InvalidProtobufSer Bool String
| InvalidProtobuf Bool String
| InvalidSignatures
| InvalidProof
| RevokedBiscuit
deriving (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, Int -> ParseError -> ShowS
[ParseError] -> ShowS
ParseError -> String
(Int -> ParseError -> ShowS)
-> (ParseError -> String)
-> ([ParseError] -> ShowS)
-> Show ParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseError -> ShowS
showsPrec :: Int -> ParseError -> ShowS
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> ShowS
showList :: [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 <- (String -> ParseError)
-> Either String Biscuit -> Either ParseError Biscuit
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobufSer Bool
True) (Either String Biscuit -> Either ParseError Biscuit)
-> Either String Biscuit -> Either ParseError Biscuit
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Biscuit
PB.decodeBlockList ByteString
bs
let rootKeyId :: Maybe Int
rootKeyId = Int32 -> Int
forall a. Enum a => a -> Int
fromEnum (Int32 -> Int) -> Maybe Int32 -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Field 1 (OptionalField (Last (Value Int32)))
-> FieldType (Field 1 (OptionalField (Last (Value Int32))))
forall a. HasField a => a -> FieldType a
PB.getField (Biscuit -> Optional 1 (Value Int32)
PB.rootKeyId Biscuit
blockList)
SignedBlock
signedAuthority <- (String -> ParseError)
-> Either String SignedBlock -> Either ParseError SignedBlock
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
True) (Either String SignedBlock -> Either ParseError SignedBlock)
-> Either String SignedBlock -> Either ParseError SignedBlock
forall a b. (a -> b) -> a -> b
$ SignedBlock -> Either String SignedBlock
pbToSignedBlock (SignedBlock -> Either String SignedBlock)
-> SignedBlock -> Either String SignedBlock
forall a b. (a -> b) -> a -> b
$ Required 2 (Message SignedBlock)
-> FieldType (Required 2 (Message SignedBlock))
forall a. HasField a => a -> FieldType a
PB.getField (Required 2 (Message SignedBlock)
-> FieldType (Required 2 (Message SignedBlock)))
-> Required 2 (Message SignedBlock)
-> FieldType (Required 2 (Message SignedBlock))
forall a b. (a -> b) -> a -> b
$ Biscuit -> Required 2 (Message SignedBlock)
PB.authority Biscuit
blockList
[SignedBlock]
signedBlocks <- (String -> ParseError)
-> Either String [SignedBlock] -> Either ParseError [SignedBlock]
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
True) (Either String [SignedBlock] -> Either ParseError [SignedBlock])
-> Either String [SignedBlock] -> Either ParseError [SignedBlock]
forall a b. (a -> b) -> a -> b
$ (SignedBlock -> Either String SignedBlock)
-> [SignedBlock] -> Either String [SignedBlock]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse SignedBlock -> Either String SignedBlock
pbToSignedBlock ([SignedBlock] -> Either String [SignedBlock])
-> [SignedBlock] -> Either String [SignedBlock]
forall a b. (a -> b) -> a -> b
$ Repeated 3 (Message SignedBlock)
-> FieldType (Repeated 3 (Message SignedBlock))
forall a. HasField a => a -> FieldType a
PB.getField (Repeated 3 (Message SignedBlock)
-> FieldType (Repeated 3 (Message SignedBlock)))
-> Repeated 3 (Message SignedBlock)
-> FieldType (Repeated 3 (Message SignedBlock))
forall a b. (a -> b) -> a -> b
$ Biscuit -> Repeated 3 (Message SignedBlock)
PB.blocks Biscuit
blockList
Either Signature SecretKey
proof <- (String -> ParseError)
-> Either String (Either Signature SecretKey)
-> Either ParseError (Either Signature SecretKey)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
True) (Either String (Either Signature SecretKey)
-> Either ParseError (Either Signature SecretKey))
-> Either String (Either Signature SecretKey)
-> Either ParseError (Either Signature SecretKey)
forall a b. (a -> b) -> a -> b
$ Proof -> Either String (Either Signature SecretKey)
pbToProof (Proof -> Either String (Either Signature SecretKey))
-> Proof -> Either String (Either Signature SecretKey)
forall a b. (a -> b) -> a -> b
$ Required 4 (Message Proof)
-> FieldType (Required 4 (Message Proof))
forall a. HasField a => a -> FieldType a
PB.getField (Required 4 (Message Proof)
-> FieldType (Required 4 (Message Proof)))
-> Required 4 (Message Proof)
-> FieldType (Required 4 (Message Proof))
forall a b. (a -> b) -> a -> b
$ Biscuit -> Required 4 (Message Proof)
PB.proof Biscuit
blockList
BiscuitWrapper -> Either ParseError BiscuitWrapper
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BiscuitWrapper -> Either ParseError BiscuitWrapper)
-> BiscuitWrapper -> Either ParseError BiscuitWrapper
forall a b. (a -> b) -> a -> b
$ BiscuitWrapper
{ wAuthority :: SignedBlock
wAuthority = SignedBlock
signedAuthority
, wBlocks :: [SignedBlock]
wBlocks = [SignedBlock]
signedBlocks
, wProof :: OpenOrSealed
wProof = (Signature -> OpenOrSealed)
-> (SecretKey -> OpenOrSealed)
-> Either Signature SecretKey
-> OpenOrSealed
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 :: BiscuitWrapper -> SignedBlock
wAuthority :: SignedBlock
wAuthority,[SignedBlock]
wBlocks :: BiscuitWrapper -> [SignedBlock]
wBlocks :: [SignedBlock]
wBlocks} =
let getRevocationId :: (a, Signature, c, d) -> ByteString
getRevocationId (a
_, Signature
sig, c
_, d
_) = Signature -> ByteString
sigBytes Signature
sig
revocationIds :: NonEmpty ByteString
revocationIds = SignedBlock -> ByteString
forall {a} {c} {d}. (a, Signature, c, d) -> ByteString
getRevocationId (SignedBlock -> ByteString)
-> NonEmpty SignedBlock -> NonEmpty ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SignedBlock
wAuthority SignedBlock -> [SignedBlock] -> NonEmpty SignedBlock
forall a. a -> [a] -> NonEmpty a
:| [SignedBlock]
wBlocks
keepIfNotRevoked :: Bool -> Either ParseError BiscuitWrapper
keepIfNotRevoked Bool
True = ParseError -> Either ParseError BiscuitWrapper
forall a b. a -> Either a b
Left ParseError
RevokedBiscuit
keepIfNotRevoked Bool
False = BiscuitWrapper -> Either ParseError BiscuitWrapper
forall a b. b -> Either a b
Right BiscuitWrapper
bw
in Bool -> Either ParseError BiscuitWrapper
keepIfNotRevoked (Bool -> Either ParseError BiscuitWrapper)
-> m Bool -> m (Either ParseError BiscuitWrapper)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set ByteString -> m Bool
isRevoked ([ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList ([ByteString] -> Set ByteString) -> [ByteString] -> Set ByteString
forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> [ByteString]
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
wAuthority :: BiscuitWrapper -> SignedBlock
wBlocks :: BiscuitWrapper -> [SignedBlock]
wProof :: BiscuitWrapper -> OpenOrSealed
wRootKeyId :: BiscuitWrapper -> Maybe Int
wAuthority :: SignedBlock
wBlocks :: [SignedBlock]
wProof :: OpenOrSealed
wRootKeyId :: Maybe Int
..} = 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 <- Either ParseError Block -> StateT Symbols (Either ParseError) Block
forall (m :: * -> *) a. Monad m => m a -> StateT Symbols m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Either ParseError Block
-> StateT Symbols (Either ParseError) Block)
-> Either ParseError Block
-> StateT Symbols (Either ParseError) Block
forall a b. (a -> b) -> a -> b
$ (String -> ParseError)
-> Either String Block -> Either ParseError Block
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobufSer Bool
False) (Either String Block -> Either ParseError Block)
-> Either String Block -> Either ParseError Block
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Block
PB.decodeBlock ByteString
payload
Block
block <- (Either String (Block, Symbols)
-> Either ParseError (Block, Symbols))
-> StateT Symbols (Either String) Block
-> StateT Symbols (Either ParseError) Block
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((String -> ParseError)
-> Either String (Block, Symbols)
-> Either ParseError (Block, Symbols)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Bool -> String -> ParseError
InvalidProtobuf Bool
False)) (StateT Symbols (Either String) Block
-> StateT Symbols (Either ParseError) Block)
-> StateT Symbols (Either String) Block
-> StateT Symbols (Either ParseError) Block
forall a b. (a -> b) -> a -> b
$ Maybe PublicKey -> Block -> StateT Symbols (Either String) Block
pbToBlock ((a, PublicKey) -> PublicKey
forall a b. (a, b) -> b
snd ((a, PublicKey) -> PublicKey)
-> Maybe (a, PublicKey) -> Maybe PublicKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, PublicKey)
eSig) Block
pbBlock
((ByteString, Block), b, c, Maybe (a, PublicKey))
-> StateT
Symbols
(Either ParseError)
((ByteString, Block), b, c, Maybe (a, PublicKey))
forall a. a -> StateT Symbols (Either ParseError) a
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) <- (StateT Symbols (Either ParseError) (NonEmpty ParsedSignedBlock)
-> Symbols
-> Either ParseError (NonEmpty ParsedSignedBlock, Symbols)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` Symbols
newSymbolTable) (StateT Symbols (Either ParseError) (NonEmpty ParsedSignedBlock)
-> Either ParseError (NonEmpty ParsedSignedBlock, Symbols))
-> StateT Symbols (Either ParseError) (NonEmpty ParsedSignedBlock)
-> Either ParseError (NonEmpty ParsedSignedBlock, Symbols)
forall a b. (a -> b) -> a -> b
$ do
(SignedBlock
-> StateT Symbols (Either ParseError) ParsedSignedBlock)
-> NonEmpty SignedBlock
-> StateT Symbols (Either ParseError) (NonEmpty ParsedSignedBlock)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
traverse SignedBlock -> StateT Symbols (Either ParseError) ParsedSignedBlock
forall {b} {c} {a}.
(ByteString, b, c, Maybe (a, PublicKey))
-> StateT
Symbols
(Either ParseError)
((ByteString, Block), b, c, Maybe (a, PublicKey))
parseBlock (SignedBlock
wAuthority SignedBlock -> [SignedBlock] -> NonEmpty SignedBlock
forall a. a -> [a] -> NonEmpty a
:| [SignedBlock]
wBlocks)
(Symbols, NonEmpty ParsedSignedBlock)
-> Either ParseError (Symbols, NonEmpty ParsedSignedBlock)
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Symbols
symbols, NonEmpty ParsedSignedBlock
allBlocks)
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
wAuthority :: BiscuitWrapper -> SignedBlock
wBlocks :: BiscuitWrapper -> [SignedBlock]
wProof :: BiscuitWrapper -> OpenOrSealed
wRootKeyId :: BiscuitWrapper -> Maybe Int
wAuthority :: SignedBlock
wBlocks :: [SignedBlock]
wProof :: OpenOrSealed
wRootKeyId :: Maybe Int
..} <- ByteString -> Either ParseError BiscuitWrapper
parseBiscuitWrapper ByteString
bs
(Symbols
symbols, ParsedSignedBlock
authority :| [ParsedSignedBlock]
blocks) <- BiscuitWrapper
-> Either ParseError (Symbols, NonEmpty ParsedSignedBlock)
parseBlocks BiscuitWrapper
w
Biscuit OpenOrSealed Unverified
-> Either ParseError (Biscuit OpenOrSealed Unverified)
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Biscuit OpenOrSealed Unverified
-> Either ParseError (Biscuit OpenOrSealed Unverified))
-> Biscuit OpenOrSealed Unverified
-> Either ParseError (Biscuit OpenOrSealed Unverified)
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
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
.. }
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
wAuthority :: BiscuitWrapper -> SignedBlock
wBlocks :: BiscuitWrapper -> [SignedBlock]
wProof :: BiscuitWrapper -> OpenOrSealed
wRootKeyId :: BiscuitWrapper -> Maybe Int
wAuthority :: SignedBlock
wBlocks :: [SignedBlock]
wProof :: OpenOrSealed
wRootKeyId :: Maybe Int
..} = do
let allBlocks :: NonEmpty SignedBlock
allBlocks = SignedBlock
wAuthority SignedBlock -> [SignedBlock] -> NonEmpty SignedBlock
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 (NonEmpty SignedBlock -> SignedBlock
forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
OpenProof SecretKey
sk -> SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
sk (NonEmpty SignedBlock -> SignedBlock
forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
Bool -> Either ParseError () -> Either ParseError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
blocksResult Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
proofResult) (Either ParseError () -> Either ParseError ())
-> Either ParseError () -> Either ParseError ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
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
Biscuit OpenOrSealed Verified
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Biscuit OpenOrSealed Verified
-> Either ParseError (Biscuit OpenOrSealed Verified))
-> Biscuit OpenOrSealed Verified
-> Either ParseError (Biscuit OpenOrSealed Verified)
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
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
.. }
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: proof
proofCheck :: Unverified
..} = 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 = ParsedSignedBlock -> SignedBlock
forall {a} {b} {b} {c} {d}. ((a, b), b, c, d) -> (a, b, c, d)
toSignedBlock (ParsedSignedBlock -> SignedBlock)
-> NonEmpty ParsedSignedBlock -> NonEmpty SignedBlock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsedSignedBlock
authority ParsedSignedBlock
-> [ParsedSignedBlock] -> NonEmpty ParsedSignedBlock
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 proof -> OpenOrSealed
forall a. BiscuitProof a => a -> OpenOrSealed
toPossibleProofs proof
proof of
SealedProof Signature
sig -> Signature -> SignedBlock -> Bool
verifySignatureProof Signature
sig (NonEmpty SignedBlock -> SignedBlock
forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
OpenProof SecretKey
sk -> SecretKey -> SignedBlock -> Bool
verifySecretProof SecretKey
sk (NonEmpty SignedBlock -> SignedBlock
forall a. NonEmpty a -> a
NE.last NonEmpty SignedBlock
allBlocks)
Bool -> Either ParseError () -> Either ParseError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
blocksResult Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
proofResult) (Either ParseError () -> Either ParseError ())
-> Either ParseError () -> Either ParseError ()
forall a b. (a -> b) -> a -> b
$ ParseError -> Either ParseError ()
forall a b. a -> Either a b
Left ParseError
InvalidSignatures
Biscuit proof Verified
-> Either ParseError (Biscuit proof Verified)
forall a. a -> Either ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Biscuit proof Verified
-> Either ParseError (Biscuit proof Verified))
-> Biscuit proof Verified
-> Either ParseError (Biscuit proof Verified)
forall a b. (a -> b) -> a -> b
$ Biscuit proof Unverified
b { proofCheck :: Verified
proofCheck = PublicKey -> Verified
Verified PublicKey
pk }
data BiscuitEncoding
= RawBytes
| UrlBase64
data ParserConfig m
= ParserConfig
{ forall (m :: * -> *). ParserConfig m -> BiscuitEncoding
encoding :: BiscuitEncoding
, forall (m :: * -> *). ParserConfig m -> Set ByteString -> m Bool
isRevoked :: Set ByteString -> m Bool
, forall (m :: * -> *). ParserConfig m -> Maybe Int -> PublicKey
getPublicKey :: Maybe Int -> PublicKey
}
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
encoding :: forall (m :: * -> *). ParserConfig m -> BiscuitEncoding
isRevoked :: forall (m :: * -> *). ParserConfig m -> Set ByteString -> m Bool
getPublicKey :: forall (m :: * -> *). ParserConfig m -> Maybe Int -> PublicKey
encoding :: BiscuitEncoding
isRevoked :: Set ByteString -> m Bool
getPublicKey :: Maybe Int -> PublicKey
..} ByteString
bs =
let input :: Either ParseError ByteString
input = case BiscuitEncoding
encoding of
BiscuitEncoding
RawBytes -> ByteString -> Either ParseError ByteString
forall a b. b -> Either a b
Right ByteString
bs
BiscuitEncoding
UrlBase64 -> (Text -> ParseError)
-> Either Text ByteString -> Either ParseError ByteString
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ParseError -> Text -> ParseError
forall a b. a -> b -> a
const ParseError
InvalidB64Encoding) (Either Text ByteString -> Either ParseError ByteString)
-> (ByteString -> Either Text ByteString)
-> ByteString
-> Either ParseError ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
B64.decodeBase64 (ByteString -> Either ParseError ByteString)
-> ByteString -> Either ParseError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
bs
parsedWrapper :: Either ParseError BiscuitWrapper
parsedWrapper = ByteString -> Either ParseError BiscuitWrapper
parseBiscuitWrapper (ByteString -> Either ParseError BiscuitWrapper)
-> Either ParseError ByteString -> Either ParseError BiscuitWrapper
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 :: BiscuitWrapper -> Maybe Int
wRootKeyId :: 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 (BiscuitWrapper
-> Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError BiscuitWrapper
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Either ParseError BiscuitWrapper
-> Either ParseError (Biscuit OpenOrSealed Verified))
-> m (Either ParseError BiscuitWrapper)
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set ByteString -> m Bool)
-> BiscuitWrapper -> m (Either ParseError BiscuitWrapper)
forall (m :: * -> *).
Applicative m =>
(Set ByteString -> m Bool)
-> BiscuitWrapper -> m (Either ParseError BiscuitWrapper)
checkRevocation Set ByteString -> m Bool
isRevoked BiscuitWrapper
w
in Either
ParseError (Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
ParseError (Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified))
-> m (Either
ParseError (Either ParseError (Biscuit OpenOrSealed Verified)))
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (BiscuitWrapper
-> m (Either ParseError (Biscuit OpenOrSealed Verified)))
-> Either ParseError BiscuitWrapper
-> m (Either
ParseError (Either ParseError (Biscuit OpenOrSealed Verified)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either ParseError a -> f (Either ParseError b)
traverse BiscuitWrapper
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
wrapperToBiscuit Either ParseError BiscuitWrapper
parsedWrapper
getRevocationIds :: Biscuit proof check -> NonEmpty ByteString
getRevocationIds :: forall proof check. Biscuit proof check -> NonEmpty ByteString
getRevocationIds Biscuit{ParsedSignedBlock
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
authority :: ParsedSignedBlock
authority, [ParsedSignedBlock]
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
blocks :: [ParsedSignedBlock]
blocks} =
let allBlocks :: NonEmpty ParsedSignedBlock
allBlocks = ParsedSignedBlock
authority ParsedSignedBlock
-> [ParsedSignedBlock] -> NonEmpty ParsedSignedBlock
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 ParsedSignedBlock -> ByteString
forall {a} {c} {d}. (a, Signature, c, d) -> ByteString
getRevocationId (ParsedSignedBlock -> ByteString)
-> NonEmpty ParsedSignedBlock -> NonEmpty ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty ParsedSignedBlock
allBlocks
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
rootKeyId :: forall proof check. Biscuit proof check -> Maybe Int
symbols :: forall proof check. Biscuit proof check -> Symbols
authority :: forall proof check. Biscuit proof check -> ParsedSignedBlock
blocks :: forall proof check. Biscuit proof check -> [ParsedSignedBlock]
proof :: forall proof check. Biscuit proof check -> proof
proofCheck :: forall proof check. Biscuit proof check -> check
rootKeyId :: Maybe Int
symbols :: Symbols
authority :: ParsedSignedBlock
blocks :: [ParsedSignedBlock]
proof :: proof
proofCheck :: Verified
..} 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, (a, b) -> b
forall a b. (a, b) -> b
snd ((a, b) -> b) -> f (a, b) -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (a, b)
eSig)
dropExternalPk :: (a, b, c) -> (a, b, Maybe a)
dropExternalPk (a
b, b
rid, c
_) = (a
b, b
rid, Maybe a
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 (AuthorizationSuccess -> AuthorizedBiscuit proof)
-> Either ExecutionError AuthorizationSuccess
-> Either ExecutionError (AuthorizedBiscuit proof)
forall a b.
(a -> b) -> Either ExecutionError a -> Either ExecutionError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthorizationSuccess -> AuthorizedBiscuit proof
withBiscuit (Either ExecutionError AuthorizationSuccess
-> Either ExecutionError (AuthorizedBiscuit proof))
-> IO (Either ExecutionError AuthorizationSuccess)
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Limits
-> BlockWithRevocationId
-> [BlockWithRevocationId]
-> Authorizer
-> IO (Either ExecutionError AuthorizationSuccess)
runAuthorizerWithLimits Limits
l
(BlockWithRevocationId -> BlockWithRevocationId
forall {a} {b} {c} {a}. (a, b, c) -> (a, b, Maybe a)
dropExternalPk (BlockWithRevocationId -> BlockWithRevocationId)
-> BlockWithRevocationId -> BlockWithRevocationId
forall a b. (a -> b) -> a -> b
$ ParsedSignedBlock -> BlockWithRevocationId
forall {f :: * -> *} {a} {a} {c} {a} {b}.
Functor f =>
((a, a), Signature, c, f (a, b)) -> (a, ByteString, f b)
toBlockWithRevocationId ParsedSignedBlock
authority)
(ParsedSignedBlock -> BlockWithRevocationId
forall {f :: * -> *} {a} {a} {c} {a} {b}.
Functor f =>
((a, a), Signature, c, f (a, b)) -> (a, ByteString, f b)
toBlockWithRevocationId (ParsedSignedBlock -> BlockWithRevocationId)
-> [ParsedSignedBlock] -> [BlockWithRevocationId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsedSignedBlock]
blocks)
Authorizer
authorizer
authorizeBiscuit :: Biscuit proof Verified -> Authorizer -> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuit :: forall proof.
Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuit = Limits
-> Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
forall proof.
Limits
-> Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuitWithLimits Limits
defaultLimits
getVerifiedBiscuitPublicKey :: Biscuit a Verified -> PublicKey
getVerifiedBiscuitPublicKey :: forall a. Biscuit a Verified -> PublicKey
getVerifiedBiscuitPublicKey Biscuit{Verified
proofCheck :: forall proof check. Biscuit proof check -> check
proofCheck :: Verified
proofCheck} =
let Verified PublicKey
pk = Verified
proofCheck
in PublicKey
pk
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
(AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool)
-> (AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool)
-> Eq (AuthorizedBiscuit p)
forall p.
Eq p =>
AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: AuthorizedBiscuit p -> AuthorizedBiscuit p -> Bool
Eq, Int -> AuthorizedBiscuit p -> ShowS
[AuthorizedBiscuit p] -> ShowS
AuthorizedBiscuit p -> String
(Int -> AuthorizedBiscuit p -> ShowS)
-> (AuthorizedBiscuit p -> String)
-> ([AuthorizedBiscuit p] -> ShowS)
-> Show (AuthorizedBiscuit p)
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
$cshowsPrec :: forall p. Show p => Int -> AuthorizedBiscuit p -> ShowS
showsPrec :: Int -> AuthorizedBiscuit p -> ShowS
$cshow :: forall p. Show p => AuthorizedBiscuit p -> String
show :: AuthorizedBiscuit p -> String
$cshowList :: forall p. Show p => [AuthorizedBiscuit p] -> ShowS
showList :: [AuthorizedBiscuit p] -> ShowS
Show)
queryAuthorizerFacts :: AuthorizedBiscuit p -> Query
-> Set Bindings
queryAuthorizerFacts :: forall p. AuthorizedBiscuit p -> Query -> Set Bindings
queryAuthorizerFacts AuthorizedBiscuit{Biscuit p Verified
authorizedBiscuit :: forall p. AuthorizedBiscuit p -> Biscuit p Verified
authorizedBiscuit :: Biscuit p Verified
authorizedBiscuit, AuthorizationSuccess
authorizationSuccess :: forall p. AuthorizedBiscuit p -> AuthorizationSuccess
authorizationSuccess :: AuthorizationSuccess
authorizationSuccess} =
let ePks :: [Maybe PublicKey]
ePks = Biscuit p Verified -> [Maybe PublicKey]
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