{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyDataDeriving #-}
module Auth.Biscuit
(
newSecret
, toPublic
, SecretKey
, PublicKey
, serializeSecretKeyHex
, serializePublicKeyHex
, parseSecretKeyHex
, parsePublicKeyHex
, serializeSecretKey
, serializePublicKey
, parseSecretKey
, parsePublicKey
, mkBiscuit
, mkBiscuitWith
, block
, blockContext
, Biscuit
, OpenOrSealed
, Open
, Sealed
, Verified
, Unverified
, BiscuitProof
, Block
, parseB64
, parse
, parseWith
, parseBiscuitUnverified
, checkBiscuitSignatures
, BiscuitEncoding (..)
, ParserConfig (..)
, fromRevocationList
, serializeB64
, serialize
, fromHex
, addBlock
, addSignedBlock
, mkThirdPartyBlockReq
, mkThirdPartyBlockReqB64
, mkThirdPartyBlock
, mkThirdPartyBlockB64
, applyThirdPartyBlock
, applyThirdPartyBlockB64
, seal
, fromOpen
, fromSealed
, asOpen
, asSealed
, authorizer
, Authorizer
, authorizeBiscuit
, authorizeBiscuitWithLimits
, Limits (..)
, defaultLimits
, ParseError (..)
, ExecutionError (..)
, AuthorizedBiscuit (..)
, AuthorizationSuccess (..)
, MatchedQuery (..)
, getBindings
, ToTerm (..)
, FromValue (..)
, Term
, Term' (..)
, queryAuthorizerFacts
, queryRawBiscuitFacts
, getVariableValues
, getSingleVariableValue
, query
, getRevocationIds
, getVerifiedBiscuitPublicKey
) where
import Control.Monad ((<=<))
import Control.Monad.Identity (runIdentity)
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64.URL as B64
import Data.Foldable (toList)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text, unpack)
import Auth.Biscuit.Crypto (PublicKey, SecretKey,
generateSecretKey,
pkBytes,
readEd25519PublicKey,
readEd25519SecretKey,
skBytes, toPublic)
import Auth.Biscuit.Datalog.AST (Authorizer, Block,
FromValue (..), Term,
Term' (..), ToTerm (..),
bContext)
import Auth.Biscuit.Datalog.Executor (ExecutionError (..),
Limits (..),
MatchedQuery (..),
defaultLimits)
import Auth.Biscuit.Datalog.Parser (authorizer, block, query)
import Auth.Biscuit.Datalog.ScopedExecutor (AuthorizationSuccess (..),
getBindings,
getSingleVariableValue,
getVariableValues)
import Auth.Biscuit.Token (AuthorizedBiscuit (..),
Biscuit,
BiscuitEncoding (..),
BiscuitProof (..), Open,
OpenOrSealed,
ParseError (..),
ParserConfig (..), Sealed,
Unverified, Verified,
addBlock, addSignedBlock,
applyThirdPartyBlock,
asOpen, asSealed,
authorizeBiscuit,
authorizeBiscuitWithLimits,
checkBiscuitSignatures,
fromOpen, fromSealed,
getRevocationIds,
getVerifiedBiscuitPublicKey,
mkBiscuit, mkBiscuitWith,
mkThirdPartyBlock,
mkThirdPartyBlockReq,
parseBiscuitUnverified,
parseBiscuitWith,
queryAuthorizerFacts,
queryRawBiscuitFacts,
seal, serializeBiscuit)
import Auth.Biscuit.Utils (decodeHex, encodeHex')
import qualified Data.Text as Text
blockContext :: Text -> Block
blockContext :: Text -> Block' 'Repr 'Representation
blockContext Text
c = Block' 'Repr 'Representation
forall a. Monoid a => a
mempty { bContext :: Maybe Text
bContext = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c }
fromHex :: MonadFail m => ByteString -> m ByteString
fromHex :: forall (m :: * -> *). MonadFail m => ByteString -> m ByteString
fromHex = (Text -> m ByteString)
-> (ByteString -> m ByteString)
-> Either Text ByteString
-> m ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m ByteString
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ByteString)
-> (Text -> String) -> Text -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack) ByteString -> m ByteString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ByteString -> m ByteString)
-> (ByteString -> Either Text ByteString)
-> ByteString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text ByteString
decodeHex
newSecret :: IO SecretKey
newSecret :: IO SecretKey
newSecret = IO SecretKey
generateSecretKey
serializeSecretKey :: SecretKey -> ByteString
serializeSecretKey :: SecretKey -> ByteString
serializeSecretKey = SecretKey -> ByteString
skBytes
serializePublicKey :: PublicKey -> ByteString
serializePublicKey :: PublicKey -> ByteString
serializePublicKey = PublicKey -> ByteString
pkBytes
serializeSecretKeyHex :: SecretKey -> ByteString
serializeSecretKeyHex :: SecretKey -> ByteString
serializeSecretKeyHex = ByteString -> ByteString
encodeHex' (ByteString -> ByteString)
-> (SecretKey -> ByteString) -> SecretKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> ByteString
skBytes
serializePublicKeyHex :: PublicKey -> ByteString
serializePublicKeyHex :: PublicKey -> ByteString
serializePublicKeyHex = ByteString -> ByteString
encodeHex' (ByteString -> ByteString)
-> (PublicKey -> ByteString) -> PublicKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> ByteString
pkBytes
parseSecretKey :: ByteString -> Maybe SecretKey
parseSecretKey :: ByteString -> Maybe SecretKey
parseSecretKey = ByteString -> Maybe SecretKey
readEd25519SecretKey
parseSecretKeyHex :: ByteString -> Maybe SecretKey
parseSecretKeyHex :: ByteString -> Maybe SecretKey
parseSecretKeyHex = ByteString -> Maybe SecretKey
parseSecretKey (ByteString -> Maybe SecretKey)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Maybe SecretKey
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe ByteString
forall (m :: * -> *). MonadFail m => ByteString -> m ByteString
fromHex
parsePublicKey :: ByteString -> Maybe PublicKey
parsePublicKey :: ByteString -> Maybe PublicKey
parsePublicKey = ByteString -> Maybe PublicKey
readEd25519PublicKey
parsePublicKeyHex :: ByteString -> Maybe PublicKey
parsePublicKeyHex :: ByteString -> Maybe PublicKey
parsePublicKeyHex = ByteString -> Maybe PublicKey
parsePublicKey (ByteString -> Maybe PublicKey)
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Maybe PublicKey
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe ByteString
forall (m :: * -> *). MonadFail m => ByteString -> m ByteString
fromHex
parse :: PublicKey -> ByteString -> Either ParseError (Biscuit OpenOrSealed Verified)
parse :: PublicKey
-> ByteString -> Either ParseError (Biscuit OpenOrSealed Verified)
parse PublicKey
pk = Identity (Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall a. Identity a -> a
runIdentity (Identity (Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified))
-> (ByteString
-> Identity (Either ParseError (Biscuit OpenOrSealed Verified)))
-> ByteString
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserConfig Identity
-> ByteString
-> Identity (Either ParseError (Biscuit OpenOrSealed Verified))
forall (m :: * -> *).
Applicative m =>
ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseBiscuitWith ParserConfig
{ encoding :: BiscuitEncoding
encoding = BiscuitEncoding
RawBytes
, isRevoked :: Set ByteString -> Identity Bool
isRevoked = Identity Bool -> Set ByteString -> Identity Bool
forall a b. a -> b -> a
const (Identity Bool -> Set ByteString -> Identity Bool)
-> Identity Bool -> Set ByteString -> Identity Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Identity Bool
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
, getPublicKey :: Maybe Int -> PublicKey
getPublicKey = PublicKey -> Maybe Int -> PublicKey
forall a. a -> Maybe Int -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PublicKey
pk
}
parseB64 :: PublicKey -> ByteString -> Either ParseError (Biscuit OpenOrSealed Verified)
parseB64 :: PublicKey
-> ByteString -> Either ParseError (Biscuit OpenOrSealed Verified)
parseB64 PublicKey
pk = Identity (Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall a. Identity a -> a
runIdentity (Identity (Either ParseError (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified))
-> (ByteString
-> Identity (Either ParseError (Biscuit OpenOrSealed Verified)))
-> ByteString
-> Either ParseError (Biscuit OpenOrSealed Verified)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserConfig Identity
-> ByteString
-> Identity (Either ParseError (Biscuit OpenOrSealed Verified))
forall (m :: * -> *).
Applicative m =>
ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseBiscuitWith ParserConfig
{ encoding :: BiscuitEncoding
encoding = BiscuitEncoding
UrlBase64
, isRevoked :: Set ByteString -> Identity Bool
isRevoked = Identity Bool -> Set ByteString -> Identity Bool
forall a b. a -> b -> a
const (Identity Bool -> Set ByteString -> Identity Bool)
-> Identity Bool -> Set ByteString -> Identity Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Identity Bool
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
, getPublicKey :: Maybe Int -> PublicKey
getPublicKey = PublicKey -> Maybe Int -> PublicKey
forall a. a -> Maybe Int -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PublicKey
pk
}
parseWith :: Applicative m
=> ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseWith :: forall (m :: * -> *).
Applicative m =>
ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseWith = ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
forall (m :: * -> *).
Applicative m =>
ParserConfig m
-> ByteString
-> m (Either ParseError (Biscuit OpenOrSealed Verified))
parseBiscuitWith
fromRevocationList :: (Applicative m, Foldable t)
=> t ByteString
-> Set ByteString
-> m Bool
fromRevocationList :: forall (m :: * -> *) (t :: * -> *).
(Applicative m, Foldable t) =>
t ByteString -> Set ByteString -> m Bool
fromRevocationList t ByteString
revokedIds Set ByteString
tokenIds =
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool)
-> (Set ByteString -> Bool) -> Set ByteString -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool)
-> (Set ByteString -> Bool) -> Set ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set ByteString -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set ByteString -> m Bool) -> Set ByteString -> m Bool
forall a b. (a -> b) -> a -> b
$ Set ByteString -> Set ByteString -> Set ByteString
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection ([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
$ t ByteString -> [ByteString]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t ByteString
revokedIds) Set ByteString
tokenIds
serialize :: BiscuitProof p => Biscuit p Verified -> ByteString
serialize :: forall p. BiscuitProof p => Biscuit p Verified -> ByteString
serialize = Biscuit p Verified -> ByteString
forall p. BiscuitProof p => Biscuit p Verified -> ByteString
serializeBiscuit
serializeB64 :: BiscuitProof p => Biscuit p Verified -> ByteString
serializeB64 :: forall p. BiscuitProof p => Biscuit p Verified -> ByteString
serializeB64 = ByteString -> ByteString
B64.encodeBase64' (ByteString -> ByteString)
-> (Biscuit p Verified -> ByteString)
-> Biscuit p Verified
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Biscuit p Verified -> ByteString
forall p. BiscuitProof p => Biscuit p Verified -> ByteString
serialize
mkThirdPartyBlockReqB64 :: Biscuit Open c -> ByteString
mkThirdPartyBlockReqB64 :: forall c. Biscuit Open c -> ByteString
mkThirdPartyBlockReqB64 = ByteString -> ByteString
B64.encodeBase64' (ByteString -> ByteString)
-> (Biscuit Open c -> ByteString) -> Biscuit Open c -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Biscuit Open c -> ByteString
forall proof check. Biscuit proof check -> ByteString
mkThirdPartyBlockReq
mkThirdPartyBlockB64 :: SecretKey -> ByteString -> Block -> Either String ByteString
mkThirdPartyBlockB64 :: SecretKey
-> ByteString
-> Block' 'Repr 'Representation
-> Either String ByteString
mkThirdPartyBlockB64 SecretKey
sk ByteString
reqB64 Block' 'Repr 'Representation
b = do
ByteString
req <- (Text -> String)
-> Either Text ByteString -> Either String 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 Text -> String
unpack (Either Text ByteString -> Either String ByteString)
-> Either Text ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
B64.decodeBase64 ByteString
reqB64
ByteString
contents <- SecretKey
-> ByteString
-> Block' 'Repr 'Representation
-> Either String ByteString
mkThirdPartyBlock SecretKey
sk ByteString
req Block' 'Repr 'Representation
b
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
$ ByteString -> ByteString
B64.encodeBase64' ByteString
contents
applyThirdPartyBlockB64 :: Biscuit Open check -> ByteString -> Either String (IO (Biscuit Open check))
applyThirdPartyBlockB64 :: forall check.
Biscuit Open check
-> ByteString -> Either String (IO (Biscuit Open check))
applyThirdPartyBlockB64 Biscuit Open check
b ByteString
contentsB64 = do
ByteString
contents <- (Text -> String)
-> Either Text ByteString -> Either String 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 Text -> String
unpack (Either Text ByteString -> Either String ByteString)
-> Either Text ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
B64.decodeBase64 ByteString
contentsB64
Biscuit Open check
-> ByteString -> Either String (IO (Biscuit Open check))
forall check.
Biscuit Open check
-> ByteString -> Either String (IO (Biscuit Open check))
applyThirdPartyBlock Biscuit Open check
b ByteString
contents