{-# 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' = SecretKey -> Maybe SecretKey -> SecretKey
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> SecretKey
forall a. HasCallStack => [Char] -> a
error [Char]
"Error parsing private key") (Maybe SecretKey -> SecretKey) -> Maybe SecretKey -> SecretKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe SecretKey
parseSecretKeyHex ByteString
"a2c4ead323536b925f3488ee83e0888b79c2761405ca7c0c9a018c7c1905eecc"

publicKey' :: PublicKey
publicKey' :: PublicKey
publicKey' = PublicKey -> Maybe PublicKey -> PublicKey
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> PublicKey
forall a. HasCallStack => [Char] -> a
error [Char]
"Error parsing public key") (Maybe PublicKey -> PublicKey) -> Maybe PublicKey -> PublicKey
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 <- Block -> Biscuit Open Verified -> IO (Biscuit Open Verified)
forall check.
Block -> Biscuit Open check -> IO (Biscuit Open check)
addBlock Block
block1 Biscuit Open Verified
biscuit
  ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Biscuit Open Verified -> ByteString
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 <- (ParseError -> IO (Biscuit OpenOrSealed Verified))
-> (Biscuit OpenOrSealed Verified
    -> IO (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified)
-> IO (Biscuit OpenOrSealed Verified)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> IO (Biscuit OpenOrSealed Verified)
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO (Biscuit OpenOrSealed Verified))
-> (ParseError -> [Char])
-> ParseError
-> IO (Biscuit OpenOrSealed Verified)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) Biscuit OpenOrSealed Verified -> IO (Biscuit OpenOrSealed Verified)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError (Biscuit OpenOrSealed Verified)
 -> IO (Biscuit OpenOrSealed Verified))
-> Either ParseError (Biscuit OpenOrSealed Verified)
-> IO (Biscuit OpenOrSealed Verified)
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 <- Biscuit OpenOrSealed Verified
-> Authorizer
-> IO (Either ExecutionError (AuthorizedBiscuit OpenOrSealed))
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  -> ExecutionError -> IO ()
forall a. Show a => a -> IO ()
print ExecutionError
e IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
    Right AuthorizedBiscuit OpenOrSealed
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True