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

import           Data.ByteString (ByteString)
import           Data.Functor    (($>))
import           Data.Maybe      (fromMaybe)
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
"todo"

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
"todo"

creation :: IO ByteString
creation :: IO ByteString
creation = do
  let authority :: Block' ctx
authority = [block|
       // toto
       resource("file1");
       |]
  Biscuit Open Verified
biscuit <- SecretKey -> Block -> IO (Biscuit Open Verified)
mkBiscuit SecretKey
privateKey' Block
forall (ctx :: ParsedAs). Block' ctx
authority
  let block1 :: Block' ctx
block1 = [block|check if current_time($time), $time < 2021-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
forall (ctx :: ParsedAs). Block' ctx
block1 Biscuit Open Verified
biscuit
  ByteString -> IO ByteString
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 (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 (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' 'RegularString
authorizer' = [authorizer|current_time(${now});|]
  Either ExecutionError AuthorizationSuccess
result <- Biscuit OpenOrSealed Verified
-> Authorizer' 'RegularString
-> IO (Either ExecutionError AuthorizationSuccess)
forall proof.
Biscuit proof Verified
-> Authorizer' 'RegularString
-> IO (Either ExecutionError AuthorizationSuccess)
authorizeBiscuit Biscuit OpenOrSealed Verified
biscuit Authorizer' 'RegularString
authorizer'
  case Either ExecutionError AuthorizationSuccess
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 AuthorizationSuccess
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True