biscuit-servant-0.3.0.0: test/AppWithAuthorizer.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# 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           Control.Monad.Reader   (ask)
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

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

type H = WithAuthorizer Handler
type H' = WithAuthorizer' Int Handler
type API = RequireBiscuit :> ProtectedAPI
type ProtectedAPI =
       "endpoint1" :> Get '[JSON] Int
  :<|> "endpoint2" :> Capture "int" Int :> Get '[JSON] Int
  :<|> "endpoint3" :> Get '[JSON] Int
  :<|> "endpoint4" :> 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 :<|> handler4
   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

handler4 :: H Int
handler4 = withTransformation extractUserId $
  withAuthorizer [authorizer|allow if user($user_id); |] $ do
    ask

extractUserId :: AuthorizedBiscuit OpenOrSealed -> Handler Int
extractUserId AuthorizedBiscuit{authorizationSuccess} = do
  let b = getBindings authorizationSuccess
   in maybe (throwError err403) pure $ getSingleVariableValue b "user_id"