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

import           Data.ByteString (ByteString)
import           Data.Functor    (($>))
import           Data.Time       (getCurrentTime)

import           Auth.Biscuit

privateKey' :: PrivateKey
privateKey' :: PrivateKey
privateKey' = PrivateKey
-> (PrivateKey -> PrivateKey) -> Maybe PrivateKey -> PrivateKey
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> PrivateKey
forall a. HasCallStack => [Char] -> a
error [Char]
"Error parsing private key") PrivateKey -> PrivateKey
forall a. a -> a
id (Maybe PrivateKey -> PrivateKey) -> Maybe PrivateKey -> PrivateKey
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe PrivateKey
parsePrivateKeyHex ByteString
"todo"

publicKey' :: PublicKey
publicKey' :: PublicKey
publicKey' = PublicKey
-> (PublicKey -> PublicKey) -> Maybe PublicKey -> PublicKey
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> PublicKey
forall a. HasCallStack => [Char] -> a
error [Char]
"Error parsing public key") PublicKey -> PublicKey
forall a. a -> a
id (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(#authority,"file1");
       |]
  Keypair
keypair <- PrivateKey -> IO Keypair
fromPrivateKey PrivateKey
privateKey'
  Biscuit
biscuit <- Keypair -> Block -> IO Biscuit
mkBiscuit Keypair
keypair Block
forall (ctx :: ParsedAs). Block' ctx
authority
  let block1 :: Block' ctx
block1 = [block|check if current_time(#ambient, $time), $time < 2021-05-08T00:00:00Z;|]
  Biscuit
newBiscuit <- Block -> Biscuit -> IO Biscuit
addBlock Block
forall (ctx :: ParsedAs). Block' ctx
block1 Biscuit
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 -> ByteString
serializeB64 Biscuit
newBiscuit

verification :: ByteString -> IO Bool
verification :: ByteString -> IO Bool
verification ByteString
serialized = do
  UTCTime
now <- IO UTCTime
getCurrentTime
  Biscuit
biscuit <- (ParseError -> IO Biscuit)
-> (Biscuit -> IO Biscuit)
-> Either ParseError Biscuit
-> IO Biscuit
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> IO Biscuit
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO Biscuit)
-> (ParseError -> [Char]) -> ParseError -> IO Biscuit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) Biscuit -> IO Biscuit
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError Biscuit -> IO Biscuit)
-> Either ParseError Biscuit -> IO Biscuit
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ParseError Biscuit
parseB64 ByteString
serialized
  let verifier' :: Verifier' 'RegularString
verifier' = [verifier|current_time(#ambient, ${now});|]
  Either VerificationError (Check' 'RegularString)
result <- Biscuit
-> Verifier' 'RegularString
-> PublicKey
-> IO (Either VerificationError (Check' 'RegularString))
verifyBiscuit Biscuit
biscuit Verifier' 'RegularString
verifier' PublicKey
publicKey'
  case Either VerificationError (Check' 'RegularString)
result of
    Left VerificationError
e  -> VerificationError -> IO ()
forall a. Show a => a -> IO ()
print VerificationError
e IO () -> Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
    Right Check' 'RegularString
_ -> Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True