mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 09:51:59 +03:00
a5589c185b
### Description
During the PDV refactor that led to 2.0, we broke an undocumented and untested semantic of inserts: accepting _explicit_ null values in nested object inserts.
In short: in the schema, we often distinguish between _explicit_ null values `{id: 3, author: null}` and _implicit_ null values that correspond to the field being omitted `{id: 3}`. In this particular case, we forgot to accept explicit null values. Since the field is optional (meaning we accept implicit null values), it was nullable in the schema, like it was in pre-PDV times. But in practice we would reject explicit nulls.
This PR fixes this, and adds a test. Furthermore, it does a bit of a cleanup of the Mutation part of the schema, and more specifically of all insertion code.
https://github.com/hasura/graphql-engine-mono/pull/2341
GitOrigin-RevId: 895cfeecef7e8e49903a3fb37987707150446eb0
255 lines
9.1 KiB
Haskell
255 lines
9.1 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
module Hasura.Prelude
|
|
( module M
|
|
, alphabet
|
|
, alphaNumerics
|
|
, onNothing
|
|
, onJust
|
|
, withJust
|
|
, onLeft
|
|
, whenMaybe
|
|
, choice
|
|
, afold
|
|
, bsToTxt
|
|
, lbsToTxt
|
|
, txtToBs
|
|
, base64Decode
|
|
, spanMaybeM
|
|
, liftEitherM
|
|
, hoistMaybe
|
|
, hoistEither
|
|
, tshow
|
|
-- * Trace debugging
|
|
, ltrace
|
|
, ltraceM
|
|
-- * Efficient coercions
|
|
, coerce
|
|
, findWithIndex
|
|
-- * Map-related utilities
|
|
, mapFromL
|
|
, mapKeys
|
|
, oMapFromL
|
|
-- * Measuring and working with moments and durations
|
|
, withElapsedTime
|
|
, startTimer
|
|
-- * Aeson options
|
|
, hasuraJSON
|
|
-- * Extensions to @Data.Foldable@
|
|
, fold'
|
|
, module Data.Time.Clock.Units
|
|
) where
|
|
|
|
import Control.Applicative as M (Alternative (..), liftA2)
|
|
import Control.Arrow as M (first, second, (&&&), (***), (<<<), (>>>))
|
|
import Control.DeepSeq as M (NFData, deepseq, force)
|
|
import Control.Lens as M (ix, (%~))
|
|
import Control.Monad.Base as M
|
|
import Control.Monad.Except as M
|
|
import Control.Monad.Identity as M
|
|
import Control.Monad.Reader as M
|
|
import Control.Monad.State.Strict as M
|
|
import Control.Monad.Trans.Maybe as M (MaybeT (..))
|
|
import Control.Monad.Writer.Strict as M (MonadWriter (..), WriterT (..), execWriterT,
|
|
runWriterT)
|
|
import Data.Bool as M (bool)
|
|
import Data.Coerce
|
|
import Data.Data as M (Data (..))
|
|
import Data.Either as M (lefts, partitionEithers, rights)
|
|
import Data.Foldable as M (asum, fold, foldMap', foldlM, foldrM, for_,
|
|
toList, traverse_)
|
|
import Data.Function as M (on, (&))
|
|
import Data.Functor as M (($>), (<&>))
|
|
import Data.Functor.Const as M (Const)
|
|
import Data.HashMap.Strict as M (HashMap)
|
|
import Data.HashMap.Strict.InsOrd as M (InsOrdHashMap)
|
|
import Data.HashSet as M (HashSet)
|
|
import Data.Hashable as M (Hashable)
|
|
import Data.List as M (find, findIndex, foldl', group, intercalate,
|
|
intersect, lookup, sort, sortBy, sortOn, union,
|
|
unionBy, (\\))
|
|
import Data.List.NonEmpty as M (NonEmpty (..), nonEmpty)
|
|
import Data.Maybe as M (catMaybes, fromMaybe, isJust, isNothing,
|
|
listToMaybe, mapMaybe, maybeToList)
|
|
import Data.Monoid as M (getAlt)
|
|
import Data.Ord as M (comparing)
|
|
import Data.Semigroup as M (Semigroup (..))
|
|
import Data.Sequence as M (Seq)
|
|
import Data.Sequence.NonEmpty as M (NESeq)
|
|
import Data.String as M (IsString)
|
|
import Data.Text as M (Text)
|
|
import Data.Time.Clock.Units
|
|
import Data.Traversable as M (for)
|
|
import Data.Void as M (Void, absurd)
|
|
import Data.Word as M (Word64)
|
|
import GHC.Generics as M (Generic)
|
|
import Prelude as M hiding (fail, init, lookup)
|
|
import Text.Read as M (readEither, readMaybe)
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Casing as J
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Base64.Lazy as Base64
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
|
import qualified Data.Hashable as H
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import qualified Data.Text.Encoding.Error as TE
|
|
import qualified Data.Text.Lazy as TL
|
|
import qualified Debug.Trace as Debug (trace, traceM)
|
|
import qualified GHC.Clock as Clock
|
|
import qualified Text.Pretty.Simple as PS
|
|
|
|
|
|
alphabet :: String
|
|
alphabet = ['a'..'z'] ++ ['A'..'Z']
|
|
|
|
alphaNumerics :: String
|
|
alphaNumerics = alphabet ++ "0123456789"
|
|
|
|
onNothing :: Applicative m => Maybe a -> m a -> m a
|
|
onNothing m act = maybe act pure m
|
|
|
|
onJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
|
|
onJust m action = maybe (pure ()) action m
|
|
|
|
withJust :: Applicative m => Maybe a -> (a -> m (Maybe b)) -> m (Maybe b)
|
|
withJust m action = maybe (pure Nothing) action m
|
|
|
|
onLeft :: Applicative m => Either e a -> (e -> m a) -> m a
|
|
onLeft e f = either f pure e
|
|
|
|
whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a)
|
|
whenMaybe True = fmap Just
|
|
whenMaybe False = const $ pure Nothing
|
|
|
|
choice :: Alternative f => [f a] -> f a
|
|
choice = asum
|
|
|
|
afold :: (Foldable t, Alternative f) => t a -> f a
|
|
afold = getAlt . foldMap pure
|
|
|
|
bsToTxt :: B.ByteString -> Text
|
|
bsToTxt = TE.decodeUtf8With TE.lenientDecode
|
|
|
|
lbsToTxt :: BL.ByteString -> Text
|
|
lbsToTxt = bsToTxt . BL.toStrict
|
|
|
|
txtToBs :: Text -> B.ByteString
|
|
txtToBs = TE.encodeUtf8
|
|
|
|
base64Decode :: Text -> BL.ByteString
|
|
base64Decode =
|
|
Base64.decodeLenient . BL.fromStrict . txtToBs
|
|
|
|
-- Like `liftEither`, but accepts a monadic action
|
|
liftEitherM :: MonadError e m => m (Either e a) -> m a
|
|
liftEitherM action = action >>= liftEither
|
|
|
|
-- Like 'span', but monadic and with a function that produces 'Maybe' instead of 'Bool'
|
|
spanMaybeM
|
|
:: (Foldable f, Monad m)
|
|
=> (a -> m (Maybe b)) -> f a -> m ([b], [a])
|
|
spanMaybeM f = go . toList
|
|
where
|
|
go [] = pure ([], [])
|
|
go l@(x:xs) = f x >>= \case
|
|
Just y -> first (y:) <$> go xs
|
|
Nothing -> pure ([], l)
|
|
|
|
findWithIndex :: (a -> Bool) -> [a] -> Maybe (a, Int)
|
|
findWithIndex p l = do
|
|
v <- find p l
|
|
i <- findIndex p l
|
|
pure (v, i)
|
|
|
|
-- TODO (from main): Move to Data.HashMap.Strict.Extended; rename to fromListWith?
|
|
mapFromL :: (Eq k, Hashable k) => (a -> k) -> [a] -> Map.HashMap k a
|
|
mapFromL f = Map.fromList . map (\v -> (f v, v))
|
|
|
|
-- | re-key a map. In the case that @f@ is not injective you may end up with a
|
|
-- smaller map than what you started with.
|
|
--
|
|
-- This may be a code smell.
|
|
mapKeys :: (Eq k2, Hashable k2) => (k1 -> k2) -> Map.HashMap k1 a -> Map.HashMap k2 a
|
|
mapKeys f = Map.fromList . map (first f) . Map.toList
|
|
|
|
oMapFromL :: (Eq k, Hashable k) => (a -> k) -> [a] -> InsOrdHashMap k a
|
|
oMapFromL f = OMap.fromList . map (\v -> (f v, v))
|
|
|
|
-- | Time an IO action, returning the time with microsecond precision. The
|
|
-- result of the input action will be evaluated to WHNF.
|
|
--
|
|
-- The result 'DiffTime' is guarenteed to be >= 0.
|
|
withElapsedTime :: MonadIO m => m a -> m (DiffTime, a)
|
|
withElapsedTime ma = do
|
|
bef <- liftIO Clock.getMonotonicTimeNSec
|
|
!a <- ma
|
|
aft <- liftIO Clock.getMonotonicTimeNSec
|
|
let !dur = nanoseconds $ fromIntegral (aft - bef)
|
|
return (dur, a)
|
|
|
|
-- | Start timing and return an action to return the elapsed time since 'startTimer' was called.
|
|
--
|
|
-- @
|
|
-- timer <- startTimer
|
|
-- someStuffToTime
|
|
-- elapsed <- timer
|
|
-- moreStuff
|
|
-- elapsedBoth <- timer
|
|
-- @
|
|
startTimer :: (MonadIO m, MonadIO n) => m (n DiffTime)
|
|
startTimer = do
|
|
!bef <- liftIO Clock.getMonotonicTimeNSec
|
|
return $ do
|
|
aft <- liftIO Clock.getMonotonicTimeNSec
|
|
return $ nanoseconds $ fromIntegral (aft - bef)
|
|
|
|
-- | Upgrade a 'Maybe' to a 'MaybeT'.
|
|
--
|
|
-- cf. http://hackage.haskell.org/package/errors-2.3.0/docs/src/Control.Error.Util.html#hoistMaybe
|
|
hoistMaybe :: Applicative m => Maybe b -> MaybeT m b
|
|
hoistMaybe = MaybeT . pure
|
|
|
|
-- | Upgrade an 'Either' to an 'ExceptT'.
|
|
--
|
|
-- cf. http://hackage.haskell.org/package/errors-2.3.0/docs/src/Control.Error.Util.html#hoistEither
|
|
hoistEither :: Applicative m => Either e a -> ExceptT e m a
|
|
hoistEither = ExceptT . pure
|
|
|
|
tshow :: Show a => a -> Text
|
|
tshow = T.pack . show
|
|
|
|
-- | Customized 'J.Options' which apply "snake case" to Generic or Template
|
|
-- Haskell JSON derivations.
|
|
--
|
|
-- For example, a Haskell field @fooBar@ would be de/serialized from/to JSON as
|
|
-- @foo_bar@.
|
|
hasuraJSON :: J.Options
|
|
hasuraJSON = J.aesonPrefix J.snakeCase
|
|
|
|
instance (Hashable a) => Hashable (Seq a) where
|
|
hashWithSalt i = H.hashWithSalt i . toList
|
|
|
|
-- | Given a structure with elements whose type is a 'Monoid', combine them via
|
|
-- the monoid's @('<>')@ operator.
|
|
--
|
|
-- This fold is right-associative and strict in the accumulator; it's defined
|
|
-- as @foldMap id@, per the documentation in @Data.Foldable@.
|
|
fold' :: (Monoid m, Foldable t) => t m -> m
|
|
fold' = foldMap' id
|
|
|
|
-- Fancy trace debugging
|
|
|
|
-- | Labeled, prettified traceShowId
|
|
ltrace :: Show a => String -> a -> a
|
|
ltrace lbl x = Debug.trace (lbl <> ": " <> TL.unpack (PS.pShow x)) x
|
|
{-# warning ltrace "ltrace left in code" #-}
|
|
|
|
-- | Labeled, prettified traceShowM
|
|
ltraceM :: Applicative m => Show a => String -> a -> m ()
|
|
ltraceM lbl x = Debug.traceM (lbl <> ": " <> TL.unpack (PS.pShow x))
|
|
{-# warning ltraceM "ltraceM left in code" #-}
|