module Ecluse.Core.Registry.Npm.SelectiveDecode (
SelectedVersion (..),
SelectiveError (..),
selectVersionFromPackument,
) where
import Data.Aeson (Value)
import Data.Aeson.Decoding (toEitherValue)
import Data.Aeson.Decoding.ByteString (bsToTokens)
import Data.Aeson.Decoding.Tokens (TkArray (..), TkRecord (..), Tokens (..))
import Data.Aeson.Key qualified as Key
import Data.ByteString qualified as BS
import Ecluse.Core.Security (withinNestingBudget)
import Ecluse.Core.Version (Version, renderVersion)
data SelectedVersion = SelectedVersion
{ SelectedVersion -> Maybe Value
svName :: Maybe Value
, SelectedVersion -> Maybe Value
svVersion :: Maybe Value
, SelectedVersion -> Maybe Value
svTime :: Maybe Value
, SelectedVersion -> Int
svVersionCount :: Int
}
deriving stock (SelectedVersion -> SelectedVersion -> Bool
(SelectedVersion -> SelectedVersion -> Bool)
-> (SelectedVersion -> SelectedVersion -> Bool)
-> Eq SelectedVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectedVersion -> SelectedVersion -> Bool
== :: SelectedVersion -> SelectedVersion -> Bool
$c/= :: SelectedVersion -> SelectedVersion -> Bool
/= :: SelectedVersion -> SelectedVersion -> Bool
Eq, Int -> SelectedVersion -> ShowS
[SelectedVersion] -> ShowS
SelectedVersion -> String
(Int -> SelectedVersion -> ShowS)
-> (SelectedVersion -> String)
-> ([SelectedVersion] -> ShowS)
-> Show SelectedVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectedVersion -> ShowS
showsPrec :: Int -> SelectedVersion -> ShowS
$cshow :: SelectedVersion -> String
show :: SelectedVersion -> String
$cshowList :: [SelectedVersion] -> ShowS
showList :: [SelectedVersion] -> ShowS
Show)
data SelectiveError
=
SelectiveUndecodable
|
SelectiveTooDeeplyNested
deriving stock (SelectiveError -> SelectiveError -> Bool
(SelectiveError -> SelectiveError -> Bool)
-> (SelectiveError -> SelectiveError -> Bool) -> Eq SelectiveError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectiveError -> SelectiveError -> Bool
== :: SelectiveError -> SelectiveError -> Bool
$c/= :: SelectiveError -> SelectiveError -> Bool
/= :: SelectiveError -> SelectiveError -> Bool
Eq, Int -> SelectiveError -> ShowS
[SelectiveError] -> ShowS
SelectiveError -> String
(Int -> SelectiveError -> ShowS)
-> (SelectiveError -> String)
-> ([SelectiveError] -> ShowS)
-> Show SelectiveError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectiveError -> ShowS
showsPrec :: Int -> SelectiveError -> ShowS
$cshow :: SelectiveError -> String
show :: SelectiveError -> String
$cshowList :: [SelectiveError] -> ShowS
showList :: [SelectiveError] -> ShowS
Show)
selectVersionFromPackument :: Int -> Version -> ByteString -> Either SelectiveError SelectedVersion
selectVersionFromPackument :: Int
-> Version -> ByteString -> Either SelectiveError SelectedVersion
selectVersionFromPackument Int
maxDepth Version
version ByteString
body
| Int
maxDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = SelectiveError -> Either SelectiveError SelectedVersion
forall a b. a -> Either a b
Left SelectiveError
SelectiveTooDeeplyNested
| Bool
otherwise = case ByteString -> Tokens ByteString String
bsToTokens ByteString
body of
TkRecordOpen TkRecord ByteString String
rec -> Int
-> Text
-> SelectedVersion
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
walkTop (Int
maxDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Version -> Text
renderVersion Version
version) SelectedVersion
emptySelection TkRecord ByteString String
rec
Tokens ByteString String
_ -> SelectiveError -> Either SelectiveError SelectedVersion
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
emptySelection :: SelectedVersion
emptySelection :: SelectedVersion
emptySelection = Maybe Value -> Maybe Value -> Maybe Value -> Int -> SelectedVersion
SelectedVersion Maybe Value
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing Int
0
walkTop :: Int -> Text -> SelectedVersion -> TkRecord ByteString String -> Either SelectiveError SelectedVersion
walkTop :: Int
-> Text
-> SelectedVersion
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
walkTop Int
childBudget Text
target = SelectedVersion
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
go
where
go :: SelectedVersion
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
go SelectedVersion
acc = \case
TkRecordEnd ByteString
leftover
| ByteString -> Bool
trailingWhitespace ByteString
leftover -> SelectedVersion -> Either SelectiveError SelectedVersion
forall a b. b -> Either a b
Right SelectedVersion
acc
| Bool
otherwise -> SelectiveError -> Either SelectiveError SelectedVersion
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
TkRecordErr String
_ -> SelectiveError -> Either SelectiveError SelectedVersion
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
TkPair Key
key Tokens (TkRecord ByteString String) String
valueToks -> case Key -> Text
Key.toText Key
key of
Text
"versions" -> Int
-> Tokens (TkRecord ByteString String) String
-> (TkRecord (TkRecord ByteString String) String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion
forall k a.
Int
-> Tokens k String
-> (TkRecord k String -> Either SelectiveError a)
-> Either SelectiveError a
withRecord Int
childBudget Tokens (TkRecord ByteString String) String
valueToks ((TkRecord (TkRecord ByteString String) String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion)
-> (TkRecord (TkRecord ByteString String) String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion
forall a b. (a -> b) -> a -> b
$ \TkRecord (TkRecord ByteString String) String
versionsRec -> do
(found, count, cont) <- Int
-> Text
-> TkRecord (TkRecord ByteString String) String
-> Either
SelectiveError (Maybe Value, Int, TkRecord ByteString String)
forall k.
Int
-> Text
-> TkRecord k String
-> Either SelectiveError (Maybe Value, Int, k)
findInRecord (Int
childBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
target TkRecord (TkRecord ByteString String) String
versionsRec
go acc{svVersion = found, svVersionCount = svVersionCount acc + count} cont
Text
"time" -> Int
-> Tokens (TkRecord ByteString String) String
-> (TkRecord (TkRecord ByteString String) String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion
forall k a.
Int
-> Tokens k String
-> (TkRecord k String -> Either SelectiveError a)
-> Either SelectiveError a
withRecord Int
childBudget Tokens (TkRecord ByteString String) String
valueToks ((TkRecord (TkRecord ByteString String) String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion)
-> (TkRecord (TkRecord ByteString String) String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion
forall a b. (a -> b) -> a -> b
$ \TkRecord (TkRecord ByteString String) String
timeRec -> do
(found, _count, cont) <- Int
-> Text
-> TkRecord (TkRecord ByteString String) String
-> Either
SelectiveError (Maybe Value, Int, TkRecord ByteString String)
forall k.
Int
-> Text
-> TkRecord k String
-> Either SelectiveError (Maybe Value, Int, k)
findInRecord (Int
childBudget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
target TkRecord (TkRecord ByteString String) String
timeRec
go acc{svTime = found} cont
Text
"name" -> do
(nameValue, cont) <- Int
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (Value, TkRecord ByteString String)
forall k.
Int -> Tokens k String -> Either SelectiveError (Value, k)
materialiseWithinBudget Int
childBudget Tokens (TkRecord ByteString String) String
valueToks
go acc{svName = Just nameValue} cont
Text
_ -> Int
-> Tokens (TkRecord ByteString String) String
-> Either SelectiveError (TkRecord ByteString String)
forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
childBudget Tokens (TkRecord ByteString String) String
valueToks Either SelectiveError (TkRecord ByteString String)
-> (TkRecord ByteString String
-> Either SelectiveError SelectedVersion)
-> Either SelectiveError SelectedVersion
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SelectedVersion
-> TkRecord ByteString String
-> Either SelectiveError SelectedVersion
go SelectedVersion
acc
findInRecord :: Int -> Text -> TkRecord k String -> Either SelectiveError (Maybe Value, Int, k)
findInRecord :: forall k.
Int
-> Text
-> TkRecord k String
-> Either SelectiveError (Maybe Value, Int, k)
findInRecord Int
childBudget Text
target = Maybe Value
-> Int
-> TkRecord k String
-> Either SelectiveError (Maybe Value, Int, k)
forall {t} {c}.
Num t =>
Maybe Value
-> t
-> TkRecord c String
-> Either SelectiveError (Maybe Value, t, c)
go Maybe Value
forall a. Maybe a
Nothing Int
0
where
go :: Maybe Value
-> t
-> TkRecord c String
-> Either SelectiveError (Maybe Value, t, c)
go Maybe Value
found !t
count = \case
TkRecordEnd c
cont -> (Maybe Value, t, c) -> Either SelectiveError (Maybe Value, t, c)
forall a b. b -> Either a b
Right (Maybe Value
found, t
count, c
cont)
TkRecordErr String
_ -> SelectiveError -> Either SelectiveError (Maybe Value, t, c)
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
TkPair Key
key Tokens (TkRecord c String) String
valueToks
| Key -> Text
Key.toText Key
key Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
target -> do
(value, cont) <- Int
-> Tokens (TkRecord c String) String
-> Either SelectiveError (Value, TkRecord c String)
forall k.
Int -> Tokens k String -> Either SelectiveError (Value, k)
materialiseWithinBudget Int
childBudget Tokens (TkRecord c String) String
valueToks
go (Just value) (count + 1) cont
| Bool
otherwise -> Int
-> Tokens (TkRecord c String) String
-> Either SelectiveError (TkRecord c String)
forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
childBudget Tokens (TkRecord c String) String
valueToks Either SelectiveError (TkRecord c String)
-> (TkRecord c String -> Either SelectiveError (Maybe Value, t, c))
-> Either SelectiveError (Maybe Value, t, c)
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Value
-> t
-> TkRecord c String
-> Either SelectiveError (Maybe Value, t, c)
go Maybe Value
found (t
count t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
materialiseWithinBudget :: Int -> Tokens k String -> Either SelectiveError (Value, k)
materialiseWithinBudget :: forall k.
Int -> Tokens k String -> Either SelectiveError (Value, k)
materialiseWithinBudget Int
budget Tokens k String
toks = case Tokens k String -> Either String (Value, k)
forall k e. Tokens k e -> Either e (Value, k)
toEitherValue Tokens k String
toks of
Left String
_ -> SelectiveError -> Either SelectiveError (Value, k)
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
Right (Value
value, k
cont)
| Int -> Value -> Bool
withinNestingBudget Int
budget Value
value -> (Value, k) -> Either SelectiveError (Value, k)
forall a b. b -> Either a b
Right (Value
value, k
cont)
| Bool
otherwise -> SelectiveError -> Either SelectiveError (Value, k)
forall a b. a -> Either a b
Left SelectiveError
SelectiveTooDeeplyNested
withRecord :: Int -> Tokens k String -> (TkRecord k String -> Either SelectiveError a) -> Either SelectiveError a
withRecord :: forall k a.
Int
-> Tokens k String
-> (TkRecord k String -> Either SelectiveError a)
-> Either SelectiveError a
withRecord Int
budget Tokens k String
toks TkRecord k String -> Either SelectiveError a
k
| Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = SelectiveError -> Either SelectiveError a
forall a b. a -> Either a b
Left SelectiveError
SelectiveTooDeeplyNested
| Bool
otherwise = case Tokens k String
toks of
TkRecordOpen TkRecord k String
rec -> TkRecord k String -> Either SelectiveError a
k TkRecord k String
rec
TkErr String
_ -> SelectiveError -> Either SelectiveError a
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
Tokens k String
_ -> SelectiveError -> Either SelectiveError a
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
skipValue :: Int -> Tokens k String -> Either SelectiveError k
skipValue :: forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
budget Tokens k String
toks
| Int
budget Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = SelectiveError -> Either SelectiveError k
forall a b. a -> Either a b
Left SelectiveError
SelectiveTooDeeplyNested
| Bool
otherwise = case Tokens k String
toks of
TkLit Lit
_ k
cont -> k -> Either SelectiveError k
forall a b. b -> Either a b
Right k
cont
TkText Text
_ k
cont -> k -> Either SelectiveError k
forall a b. b -> Either a b
Right k
cont
TkNumber Number
_ k
cont -> k -> Either SelectiveError k
forall a b. b -> Either a b
Right k
cont
TkArrayOpen TkArray k String
arr -> Int -> TkArray k String -> Either SelectiveError k
forall k. Int -> TkArray k String -> Either SelectiveError k
skipArray (Int
budget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TkArray k String
arr
TkRecordOpen TkRecord k String
rec -> Int -> TkRecord k String -> Either SelectiveError k
forall k. Int -> TkRecord k String -> Either SelectiveError k
skipRecord (Int
budget Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) TkRecord k String
rec
TkErr String
_ -> SelectiveError -> Either SelectiveError k
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
skipArray :: Int -> TkArray k String -> Either SelectiveError k
skipArray :: forall k. Int -> TkArray k String -> Either SelectiveError k
skipArray Int
budget = \case
TkItem Tokens (TkArray k String) String
toks -> Int
-> Tokens (TkArray k String) String
-> Either SelectiveError (TkArray k String)
forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
budget Tokens (TkArray k String) String
toks Either SelectiveError (TkArray k String)
-> (TkArray k String -> Either SelectiveError k)
-> Either SelectiveError k
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> TkArray k String -> Either SelectiveError k
forall k. Int -> TkArray k String -> Either SelectiveError k
skipArray Int
budget
TkArrayEnd k
cont -> k -> Either SelectiveError k
forall a b. b -> Either a b
Right k
cont
TkArrayErr String
_ -> SelectiveError -> Either SelectiveError k
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
skipRecord :: Int -> TkRecord k String -> Either SelectiveError k
skipRecord :: forall k. Int -> TkRecord k String -> Either SelectiveError k
skipRecord Int
budget = \case
TkPair Key
_ Tokens (TkRecord k String) String
toks -> Int
-> Tokens (TkRecord k String) String
-> Either SelectiveError (TkRecord k String)
forall k. Int -> Tokens k String -> Either SelectiveError k
skipValue Int
budget Tokens (TkRecord k String) String
toks Either SelectiveError (TkRecord k String)
-> (TkRecord k String -> Either SelectiveError k)
-> Either SelectiveError k
forall a b.
Either SelectiveError a
-> (a -> Either SelectiveError b) -> Either SelectiveError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> TkRecord k String -> Either SelectiveError k
forall k. Int -> TkRecord k String -> Either SelectiveError k
skipRecord Int
budget
TkRecordEnd k
cont -> k -> Either SelectiveError k
forall a b. b -> Either a b
Right k
cont
TkRecordErr String
_ -> SelectiveError -> Either SelectiveError k
forall a b. a -> Either a b
Left SelectiveError
SelectiveUndecodable
trailingWhitespace :: ByteString -> Bool
trailingWhitespace :: ByteString -> Bool
trailingWhitespace = (Word8 -> Bool) -> ByteString -> Bool
BS.all Word8 -> Bool
isJsonSpace
where
isJsonSpace :: Word8 -> Bool
isJsonSpace :: Word8 -> Bool
isJsonSpace Word8
w = Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x20 Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0a Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x0d Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x09