{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
module Auth.Biscuit.Example where

import           Data.ByteString (ByteString)
import           Data.Functor    (($>))
import           Data.Maybe      (fromMaybe)
import           Data.Text       (Text)
import           Data.Time       (getCurrentTime)

import           Auth.Biscuit

privateKey' :: SecretKey
privateKey' :: SecretKey
privateKey' = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Error parsing private key") forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe SecretKey
parseSecretKeyHex ByteString
"a2c4ead323536b925f3488ee83e0888b79c2761405ca7c0c9a018c7c1905eecc"

publicKey' :: PublicKey
publicKey' :: PublicKey
publicKey' = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Error parsing public key") forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe PublicKey
parsePublicKeyHex ByteString
"24afd8171d2c0107ec6d5656aa36f8409184c2567649e0a7f66e629cc3dbfd70"

creation :: IO ByteString
creation :: IO ByteString
creation = do
  let allowedOperations :: [Text]
allowedOperations = [Text
"read", Text
"write"] :: [Text]
      networkLocal :: Text
networkLocal = Text
"192.168.0.1" :: Text
  let authority :: Block
authority = [block|
       // this is a comment
       right("file1", {allowedOperations});
       check if source_ip($source_ip), ["127.0.0.1", {networkLocal}].contains($source_ip);
       |]
  Biscuit Open Verified
biscuit <- SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuit SecretKey
privateKey' Block
authority
  let block1 :: Block
block1 = [block|check if time($time), $time < 2025-05-08T00:00:00Z;|]
  Biscuit Open Verified
newBiscuit <- forall check.
Block -> Biscuit Open check -> IO (Biscuit Open check)
addBlock Block
block1 Biscuit Open Verified
biscuit
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall p. BiscuitProof p => Biscuit p Verified -> ByteString
serializeB64 Biscuit Open Verified
newBiscuit

verification :: ByteString -> IO Bool
verification :: ByteString -> IO Bool
verification ByteString
serialized = do
  UTCTime
now <- IO UTCTime
getCurrentTime
  Biscuit OpenOrSealed Verified
biscuit <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PublicKey
-> ByteString -> Either ParseError (Biscuit OpenOrSealed Verified)
parseB64 PublicKey
publicKey' ByteString
serialized
  let authorizer' :: Authorizer
authorizer' = [authorizer|
        time({now});
        source_ip("127.0.0.1");
        allow if right("file1", $ops), $ops.contains("read");
      |]
  Either ExecutionError (AuthorizedBiscuit OpenOrSealed)
result <- forall proof.
Biscuit proof Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit proof))
authorizeBiscuit Biscuit OpenOrSealed Verified
biscuit Authorizer
authorizer'
  case Either ExecutionError (AuthorizedBiscuit OpenOrSealed)
result of
    Left ExecutionError
e  -> forall a. Show a => a -> IO ()
print ExecutionError
e forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
    Right AuthorizedBiscuit OpenOrSealed
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True