biscuit-servant-0.2.0.0: test/AppWithAuthorizer.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE TypeOperators     #-}
module AppWithAuthorizer where

import           Auth.Biscuit
import           Auth.Biscuit.Servant
import           Control.Monad.IO.Class (liftIO)
import           Data.Text              (Text)
import           Data.Time              (getCurrentTime)
import           Servant
import           Servant.Client

import           ClientHelpers

call1 :: Text -> ClientM Int
call1 b =
  let (e1 :<|> _) = client @API Proxy (protect b)
   in e1

call2 :: Text -> Int -> ClientM Int
call2 b =
  let (_ :<|> e2 :<|> _) = client @API Proxy (protect b)
   in e2

call3 :: Text -> ClientM Int
call3 b =
  let (_ :<|> _ :<|> e3) = client @API Proxy (protect b)
   in e3

type H = WithAuthorizer Handler
type API = RequireBiscuit :> ProtectedAPI
type ProtectedAPI =
       "endpoint1" :> Get '[JSON] Int
  :<|> "endpoint2" :> Capture "int" Int :> Get '[JSON] Int
  :<|> "endpoint3" :> Get '[JSON] Int

app :: PublicKey -> Application
app appPublicKey =
  serveWithContext @API Proxy (genBiscuitCtx appPublicKey) server

server :: Server API
server b =
  let nowFact = do
        now <- liftIO getCurrentTime
        pure [authorizer|time(${now});|]
      handleAuth :: WithAuthorizer Handler x -> Handler x
      handleAuth =
          handleBiscuit b
        . withPriorityAuthorizerM nowFact
        . withPriorityAuthorizer [authorizer|allow if right("admin");|]
        . withFallbackAuthorizer [authorizer|allow if right("anon");|]
      handlers = handler1 :<|> handler2 :<|> handler3
   in hoistServer @ProtectedAPI Proxy handleAuth handlers

handler1 :: H Int
handler1 = withAuthorizer [authorizer|allow if right("one");|] $ pure 1

handler2 :: Int -> H Int
handler2 v = withAuthorizer [authorizer|allow if right("two", ${v});|] $ pure 2

handler3 :: H Int
handler3 = withAuthorizer [authorizer|deny if true;|] $ pure 3