{-|
Module      : PostgREST.Types
Description : PostgREST common types and functions used by the rest of the modules
-}
{-# LANGUAGE DuplicateRecordFields #-}

module PostgREST.Config.JSPath
  ( JSPath
  , JSPathExp(..)
  , pRoleClaimKey
  ) where

import qualified Text.ParserCombinators.Parsec as P

import Data.Either.Combinators       (mapLeft)
import Text.ParserCombinators.Parsec ((<?>))
import Text.Read                     (read)

import qualified GHC.Show (show)

import Protolude      hiding (toS)
import Protolude.Conv (toS)


-- | full jspath, e.g. .property[0].attr.detail
type JSPath = [JSPathExp]

-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
data JSPathExp
  = JSPKey Text
  | JSPIdx Int

instance Show JSPathExp where
  -- TODO: this needs to be quoted properly for special chars
  show :: JSPathExp -> String
show (JSPKey Text
k) = String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Text
k
  show (JSPIdx Int
i) = String
"[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"

-- Used for the config value "role-claim-key"
pRoleClaimKey :: Text -> Either Text JSPath
pRoleClaimKey :: Text -> Either Text [JSPathExp]
pRoleClaimKey Text
selStr =
  (ParseError -> Text)
-> Either ParseError [JSPathExp] -> Either Text [JSPathExp]
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ParseError -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show (Either ParseError [JSPathExp] -> Either Text [JSPathExp])
-> Either ParseError [JSPathExp] -> Either Text [JSPathExp]
forall a b. (a -> b) -> a -> b
$ Parsec String () [JSPathExp]
-> String -> String -> Either ParseError [JSPathExp]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
P.parse Parsec String () [JSPathExp]
pJSPath (String
"failed to parse role-claim-key value (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. StringConv a b => a -> b
toS Text
selStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") (Text -> String
forall a b. StringConv a b => a -> b
toS Text
selStr)

pJSPath :: P.Parser JSPath
pJSPath :: Parsec String () [JSPathExp]
pJSPath = [(Text, Maybe Int)] -> [JSPathExp]
toJSPath ([(Text, Maybe Int)] -> [JSPathExp])
-> ParsecT String () Identity [(Text, Maybe Int)]
-> Parsec String () [JSPathExp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
period ParsecT String () Identity Char
-> ParsecT String () Identity [(Text, Maybe Int)]
-> ParsecT String () Identity [(Text, Maybe Int)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Maybe Int)
pPath Parser (Text, Maybe Int)
-> ParsecT String () Identity Char
-> ParsecT String () Identity [(Text, Maybe Int)]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`P.sepBy` ParsecT String () Identity Char
forall u. ParsecT String u Identity Char
period ParsecT String () Identity [(Text, Maybe Int)]
-> ParsecT String () Identity ()
-> ParsecT String () Identity [(Text, Maybe Int)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof)
  where
    toJSPath :: [(Text, Maybe Int)] -> JSPath
    toJSPath :: [(Text, Maybe Int)] -> [JSPathExp]
toJSPath = ((Text, Maybe Int) -> [JSPathExp])
-> [(Text, Maybe Int)] -> [JSPathExp]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
key, Maybe Int
idx) -> Text -> JSPathExp
JSPKey Text
key JSPathExp -> [JSPathExp] -> [JSPathExp]
forall a. a -> [a] -> [a]
: Maybe JSPathExp -> [JSPathExp]
forall a. Maybe a -> [a]
maybeToList (Int -> JSPathExp
JSPIdx (Int -> JSPathExp) -> Maybe Int -> Maybe JSPathExp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
idx))
    period :: ParsecT String u Identity Char
period = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'.' ParsecT String u Identity Char
-> String -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"period (.)"
    pPath :: P.Parser (Text, Maybe Int)
    pPath :: Parser (Text, Maybe Int)
pPath = (,) (Text -> Maybe Int -> (Text, Maybe Int))
-> ParsecT String () Identity Text
-> ParsecT String () Identity (Maybe Int -> (Text, Maybe Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Text
pJSPKey ParsecT String () Identity (Maybe Int -> (Text, Maybe Int))
-> ParsecT String () Identity (Maybe Int)
-> Parser (Text, Maybe Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT String () Identity Int
-> ParsecT String () Identity (Maybe Int)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
P.optionMaybe ParsecT String () Identity Int
pJSPIdx

pJSPKey :: P.Parser Text
pJSPKey :: ParsecT String () Identity Text
pJSPKey = String -> Text
forall a b. StringConv a b => a -> b
toS (String -> Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 (ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.alphaNum ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"_$@") ParsecT String () Identity Text
-> ParsecT String () Identity Text
-> ParsecT String () Identity Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT String () Identity Text
pQuotedValue ParsecT String () Identity Text
-> String -> ParsecT String () Identity Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"attribute name [a..z0..9_$@])"

pJSPIdx :: P.Parser Int
pJSPIdx :: ParsecT String () Identity Int
pJSPIdx = Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'[' ParsecT String () Identity Char
-> ParsecT String () Identity Int -> ParsecT String () Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Int
forall a. Read a => String -> a
read (String -> Int)
-> ParsecT String () Identity String
-> ParsecT String () Identity Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
P.many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit) ParsecT String () Identity Int
-> ParsecT String () Identity Char
-> ParsecT String () Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
']' ParsecT String () Identity Int
-> String -> ParsecT String () Identity Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"array index [0..n]"

pQuotedValue :: P.Parser Text
pQuotedValue :: ParsecT String () Identity Text
pQuotedValue = String -> Text
forall a b. StringConv a b => a -> b
toS (String -> Text)
-> ParsecT String () Identity String
-> ParsecT String () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"' ParsecT String () Identity Char
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
P.many (String -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.noneOf String
"\"") ParsecT String () Identity String
-> ParsecT String () Identity Char
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
'"')