-- | Blockfrost authentication schemes
{-# LANGUAGE PolyKinds #-}

module Blockfrost.Auth
  ( APIKeyInHeader
  , APIKeyInHeaderSettings (..)
  , Env (..)
  , Project (..)
  , ProjectAuth
  , mkProject
  , mkProjectEnv
  ) where

import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Data.Text as Text
import GHC.Generics (Generic)
import GHC.TypeLits
import Servant.API (HasLink (..), (:>))

import qualified Data.Text

import Data.String (IsString (..))

import Blockfrost.Env

-- * Authentication result and clients token

data Project = Project {
    Project -> Env
projectEnv :: Env
  , Project -> Text
projectId  :: Text
  }
  deriving (Project -> Project -> Bool
(Project -> Project -> Bool)
-> (Project -> Project -> Bool) -> Eq Project
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Project -> Project -> Bool
== :: Project -> Project -> Bool
$c/= :: Project -> Project -> Bool
/= :: Project -> Project -> Bool
Eq, Int -> Project -> ShowS
[Project] -> ShowS
Project -> String
(Int -> Project -> ShowS)
-> (Project -> String) -> ([Project] -> ShowS) -> Show Project
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Project -> ShowS
showsPrec :: Int -> Project -> ShowS
$cshow :: Project -> String
show :: Project -> String
$cshowList :: [Project] -> ShowS
showList :: [Project] -> ShowS
Show, (forall x. Project -> Rep Project x)
-> (forall x. Rep Project x -> Project) -> Generic Project
forall x. Rep Project x -> Project
forall x. Project -> Rep Project x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Project -> Rep Project x
from :: forall x. Project -> Rep Project x
$cto :: forall x. Rep Project x -> Project
to :: forall x. Rep Project x -> Project
Generic)

-- | Parse @Project@ from @Text@
mkProject' :: Text -> Either Text Project
mkProject' :: Text -> Either Text Project
mkProject' Text
t =
  let st :: Text
st = Text -> Text
Data.Text.strip Text
t
      tEnv :: Text
tEnv = Int -> Text -> Text
Data.Text.dropEnd Int
32 Text
st
      token :: Text
token = Int -> Text -> Text
Data.Text.drop (Text -> Int
Data.Text.length Text
tEnv) Text
st
  in Env -> Text -> Project
Project (Env -> Text -> Project)
-> Either Text Env -> Either Text (Text -> Project)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either Text Env
parseEnv Text
tEnv Either Text (Text -> Project)
-> Either Text Text -> Either Text Project
forall a b. Either Text (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either Text Text
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
token

-- | Parse @Project@ from @Text@ or fail with error
mkProject :: Text -> Project
mkProject :: Text -> Project
mkProject = (Text -> Project)
-> (Project -> Project) -> Either Text Project -> Project
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Project
forall a. HasCallStack => String -> a
error (String -> Project) -> (Text -> String) -> Text -> Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Data.Text.unpack) Project -> Project
forall a. a -> a
id (Either Text Project -> Project)
-> (Text -> Either Text Project) -> Text -> Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Project
mkProject'

-- | @Project@ constructor
mkProjectEnv :: Env -> Text -> Project
mkProjectEnv :: Env -> Text -> Project
mkProjectEnv = Env -> Text -> Project
Project

instance IsString Project where
  fromString :: String -> Project
fromString = Text -> Project
mkProject (Text -> Project) -> (String -> Text) -> String -> Project
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Data.Text.pack

-- * Common

-- | The type of Auth scheme.
data APIKeyInHeader (headerName :: Symbol)

-- | Auth scheme settings
-- Needs IO action to verify passed in token and maybe return Project
newtype APIKeyInHeaderSettings =
  APIKeyInHeaderSettings
    { APIKeyInHeaderSettings -> Text -> IO (Maybe Project)
apiKeySettingsQueryProject :: Text -> IO (Maybe Project)
    }

-- * Custom Auth
-- we use custom ProjectAuth instead of Auth from servant-auth
-- to get rid of superfluous Contexts like JWTSettings and CookiesSettings

data ProjectAuth (auths :: [Type]) val

instance HasLink sub => HasLink (ProjectAuth (tag :: [Type]) value :> sub) where
  type MkLink (ProjectAuth (tag :: [Type]) value :> sub) r = MkLink sub r
  toLink :: forall a.
(Link -> a)
-> Proxy (ProjectAuth tag value :> sub)
-> Link
-> MkLink (ProjectAuth tag value :> sub) a
toLink Link -> a
toA Proxy (ProjectAuth tag value :> sub)
_ = (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall a. (Link -> a) -> Proxy sub -> Link -> MkLink sub a
forall {k} (endpoint :: k) a.
HasLink endpoint =>
(Link -> a) -> Proxy endpoint -> Link -> MkLink endpoint a
toLink Link -> a
toA (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @sub)