Skip to content

Commit a52c51e

Browse files
claudeMartinSStewart
claude
authored and
MartinSStewart
committed
Add non-validating w3_unsafe_decode_<T> alongside validating w3_decode_<T>
Validation should only run on attacker-controlled, backend-inbound data, not on trusted data (persistence, evergreen migrations). So every custom type and alias now gets two decoders: * w3_decode_<T> validating: applies w3_validate_<T> if present and recurses through the w3_decode_* chain (for the Lamdera runtime to use on backend-inbound data). * w3_unsafe_decode_<T> non-validating: behaves like w3_decode_<T> did before validation existed, recursing through the w3_unsafe_decode_* chain. The two chains are threaded through decoder codegen via a DecodeMode parameter. The validating chain is byte-identical to the previous w3_decode output (only the prefix and, for unions, the validator hook differ), so existing behaviour is unchanged. Built-in decoders (decodeList etc.) are mode-agnostic and thread the mode through their element decoder. The trusted in-repo consumers are repointed at the unsafe chain to preserve their pre-validation behaviour: the evergreen migration harness and backend-model persistence reload. Also adds w3_unsafe_decode_* stubs + exports and extends the getForeignSig fallback to the new prefix. The validator-module reference check already covers w3_unsafe_decode_* (names are derived from the generated defs). Tests: Wire3ValidateTest now contrasts unsafe-decode-accepts-invalid vs validating-decode-rejects; the full Test.Wire suite passes with all fixtures compiling under both chains.
1 parent 2ef8672 commit a52c51e

7 files changed

Lines changed: 156 additions & 57 deletions

File tree

‎extra/Lamdera/CLI/Backend.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -910,7 +910,7 @@ addBackendModelDecl base64 =
910910
\ >> nextChunk []\n\
911911
\ )\n\
912912
\ |>Lamdera.Wire3.intListToBytes\n\
913-
\ |>Lamdera.Wire3.bytesDecode Types.w3_decode_BackendModel\n\
913+
\ |>Lamdera.Wire3.bytesDecode Types.w3_unsafe_decode_BackendModel\n\
914914
\ |>(\\maybeModel ->\n\
915915
\ case maybeModel of\n\
916916
\ Just m -> m\n\

‎extra/Lamdera/Evergreen/MigrationHarness.hs‎

Lines changed: 11 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -133,14 +133,14 @@ decodeAndUpgradeFor migrationSequence nextVersion valueType = do
133133
if valueType == "BackendModel" then
134134
[text|
135135
$nextVersion_ ->
136-
decodeType $valueTypeInt version bytes T$nextVersion_.w3_decode_$valueType
136+
decodeType $valueTypeInt version bytes T$nextVersion_.w3_unsafe_decode_$valueType
137137
|> upgradeIsCurrent
138138
|> otherwiseError
139139
|]
140140
else
141141
[text|
142142
$nextVersion_ ->
143-
decodeType $valueTypeInt version bytes T$nextVersion_.w3_decode_$valueType
143+
decodeType $valueTypeInt version bytes T$nextVersion_.w3_unsafe_decode_$valueType
144144
|> upgradeIsCurrent
145145
|> otherwiseError
146146
|]
@@ -308,13 +308,13 @@ migrationForType migrationSequence migrationsForVersion startVersion finalVersio
308308
if tipe == "BackendModel"
309309
then
310310
[text|
311-
decodeType $valueTypeInt $finalVersion_ bytes T$finalVersion_.w3_decode_$tipe
311+
decodeType $valueTypeInt $finalVersion_ bytes T$finalVersion_.w3_unsafe_decode_$tipe
312312
|> upgradeSucceeds
313313
|> otherwiseError
314314
|]
315315
else
316316
[text|
317-
decodeType $valueTypeInt $finalVersion_ bytes T$finalVersion_.w3_decode_$tipe
317+
decodeType $valueTypeInt $finalVersion_ bytes T$finalVersion_.w3_unsafe_decode_$tipe
318318
|> upgradeSucceeds
319319
|> otherwiseError
320320
|]
@@ -323,14 +323,14 @@ migrationForType migrationSequence migrationsForVersion startVersion finalVersio
323323
if tipe == "BackendModel"
324324
then
325325
[text|
326-
decodeType $valueTypeInt $startVersion_ bytes T$startVersion_.w3_decode_$tipe
326+
decodeType $valueTypeInt $startVersion_ bytes T$startVersion_.w3_unsafe_decode_$tipe
327327
$intermediateMigrationsFormatted
328328
|> upgradeSucceeds
329329
|> otherwiseError
330330
|]
331331
else
332332
[text|
333-
decodeType $valueTypeInt $startVersion_ bytes T$startVersion_.w3_decode_$tipe
333+
decodeType $valueTypeInt $startVersion_ bytes T$startVersion_.w3_unsafe_decode_$tipe
334334
$intermediateMigrationsFormatted
335335
|> upgradeSucceeds
336336
|> otherwiseError
@@ -397,16 +397,16 @@ intermediateMigration allMigrations tipe from to finalVersion =
397397
migrationFn = [text|M$to_.$typenameCamel|]
398398
in
399399
[text|
400-
|> $thenMigrateForType $valueTypeInt $migrationFn T$from_.w3_encode_$tipe T$to_.w3_decode_$tipe $to_
400+
|> $thenMigrateForType $valueTypeInt $migrationFn T$from_.w3_encode_$tipe T$to_.w3_unsafe_decode_$tipe $to_
401401
|]
402402

403403
WithoutMigrations v ->
404404
{- It might seem like this is uneeded, but it's for when there's a migration in our chain, yet
405405
the last version has no migrations. I.e.:
406406
407-
decodeType "BackendModel" 1 intList T1.w3_decode_BackendModel
408-
|> thenMigrateModel "BackendModel" M2.backendModel T1.w3_encode_BackendModel T2.w3_decode_BackendModel 2
409-
|> thenMigrateModel "BackendModel" (always ModelUnchanged) T2.w3_encode_BackendModel T3.w3_decode_BackendModel 3
407+
decodeType "BackendModel" 1 intList T1.w3_unsafe_decode_BackendModel
408+
|> thenMigrateModel "BackendModel" M2.backendModel T1.w3_encode_BackendModel T2.w3_unsafe_decode_BackendModel 2
409+
|> thenMigrateModel "BackendModel" (always ModelUnchanged) T2.w3_encode_BackendModel T3.w3_unsafe_decode_BackendModel 3
410410
|> upgradeSucceeds CurrentBackendModel
411411
|> otherwiseError
412412
@@ -416,7 +416,7 @@ intermediateMigration allMigrations tipe from to finalVersion =
416416
migrationFn = "(always " <> kindForType <> "Unchanged)"
417417
in
418418
[text|
419-
|> $thenMigrateForType $valueTypeInt $migrationFn T$from_.w3_encode_$tipe T$to_.w3_decode_$tipe $to_
419+
|> $thenMigrateForType $valueTypeInt $migrationFn T$from_.w3_encode_$tipe T$to_.w3_unsafe_decode_$tipe $to_
420420
|]
421421

422422

‎extra/Lamdera/Wire3/Core.hs‎

Lines changed: 24 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -180,7 +180,8 @@ addWireGenerations_ canonical pkg ifaces modul =
180180
& Map.toList
181181
& concatMap (\(name, union) ->
182182
[ (encoderUnion isTest_ ifaces pkg modul decls_ name union)
183-
, (decoderUnion isTest_ ifaces pkg modul decls_ name union)
183+
, (decoderUnion DecodeValidating isTest_ ifaces pkg modul decls_ name union)
184+
, (decoderUnion DecodeUnsafe isTest_ ifaces pkg modul decls_ name union)
184185
]
185186
)
186187

@@ -190,7 +191,8 @@ addWireGenerations_ canonical pkg ifaces modul =
190191
& filter (\(_, Alias _ tipe) -> not (isLambdaType tipe))
191192
& concatMap (\(name, alias) ->
192193
[ (encoderAlias isTest_ ifaces pkg modul decls_ name alias)
193-
, (decoderAlias isTest_ ifaces pkg modul decls_ name alias)
194+
, (decoderAlias DecodeValidating isTest_ ifaces pkg modul decls_ name alias)
195+
, (decoderAlias DecodeUnsafe isTest_ ifaces pkg modul decls_ name alias)
194196
]
195197
)
196198

@@ -539,12 +541,12 @@ encoderUnion isTest_ ifaces pkg modul decls unionName union =
539541
finalGen
540542

541543

542-
decoderUnion :: Bool -> Map.Map Module.Raw I.Interface -> Pkg.Name -> Src.Module -> Decls -> Data.Name.Name -> Union -> Def
543-
decoderUnion isTest_ ifaces pkg modul decls unionName union =
544+
decoderUnion :: DecodeMode -> Bool -> Map.Map Module.Raw I.Interface -> Pkg.Name -> Src.Module -> Decls -> Data.Name.Name -> Union -> Def
545+
decoderUnion mode isTest_ ifaces pkg modul decls unionName union =
544546
let
545547
!x = runTests isTest_ "decoderUnion" pkg modul decls generatedName generated union (unionAsModule cname unionName union)
546548

547-
generatedName = Data.Name.fromChars $ "w3_decode_" ++ Data.Name.toChars unionName
549+
generatedName = Data.Name.fromChars $ decodePrefix mode ++ Data.Name.toChars unionName
548550
cname = Module.Canonical pkg (Src.getName modul)
549551
tvars = _u_vars union
550552
tvarsTypesig = tvars & foldl (\acc name -> Map.insert name () acc ) Map.empty
@@ -577,20 +579,26 @@ decoderUnion isTest_ ifaces pkg modul decls unionName union =
577579
& imap (\i (Ctor tagName tagIndex numParams paramTypes) ->
578580
CaseBranch (pint i) $
579581
([(succeedDecode (vctor tagName tagIndex paramTypes))]
580-
++ fmap (\paramType -> andMapDecode1 ((decoderForType ifaces cname paramType))) paramTypes)
582+
++ fmap (\paramType -> andMapDecode1 ((decoderForType mode ifaces cname paramType))) paramTypes)
581583
& foldlPairs (|>)
582584
)
583585
& (\l -> l ++ [CaseBranch pAny_ $ failDecode (Data.Name.toChars generatedName <> " unexpected union tag index")])
584586
)
585587
)
586588

587-
{- If the current module defines `w3_validate_<unionName>`, the decoder calls
588-
it after producing a value. The function's existence and signature are
589-
verified by checkValidators in addWireGenerations_ before this runs. -}
589+
{- Only the validating chain (w3_decode_*) attaches the validator. If the
590+
current module defines `w3_validate_<unionName>`, the validating decoder
591+
calls it after producing a value (its existence and signature are verified by
592+
checkValidators in addWireGenerations_ before this runs). The unsafe chain
593+
(w3_unsafe_decode_*) never validates. -}
590594
finalBody =
591-
case findValidatorDef decls unionName of
592-
Just _ -> wrapWithValidator ifaces cname unionName baseBody
593-
Nothing -> baseBody
595+
case mode of
596+
DecodeValidating ->
597+
case findValidatorDef decls unionName of
598+
Just _ -> wrapWithValidator ifaces cname unionName baseBody
599+
Nothing -> baseBody
600+
DecodeUnsafe ->
601+
baseBody
594602

595603
generated =
596604
Def
@@ -834,17 +842,17 @@ encoderAlias isTest_ ifaces pkg modul decls aliasName alias@(Alias tvars tipe) =
834842
finalGen
835843

836844

837-
decoderAlias :: Bool -> Map.Map Module.Raw I.Interface -> Pkg.Name -> Src.Module -> Decls -> Data.Name.Name -> Alias -> Def
838-
decoderAlias isTest_ ifaces pkg modul decls aliasName alias@(Alias tvars tipe) =
845+
decoderAlias :: DecodeMode -> Bool -> Map.Map Module.Raw I.Interface -> Pkg.Name -> Src.Module -> Decls -> Data.Name.Name -> Alias -> Def
846+
decoderAlias mode isTest_ ifaces pkg modul decls aliasName alias@(Alias tvars tipe) =
839847
let
840848
!x = runTests isTest_ "decoderAlias" pkg modul decls generatedName generated alias (aliasAsModule cname aliasName alias)
841849

842-
generatedName = Data.Name.fromChars $ "w3_decode_" ++ Data.Name.toChars aliasName
850+
generatedName = Data.Name.fromChars $ decodePrefix mode ++ Data.Name.toChars aliasName
843851
cname = Module.Canonical pkg (Src.getName modul)
844852
ptvars = tvars & fmap (\tvar -> pvar $ Data.Name.fromChars $ "w3_x_c_" ++ Data.Name.toChars tvar )
845853

846854
generated = Def (a (generatedName)) ptvars $
847855
-- debugDecoder (Data.Name.toElmString aliasName) $
848-
decoderForType ifaces cname tipe
856+
decoderForType mode ifaces cname tipe
849857
in
850858
generated

‎extra/Lamdera/Wire3/Decoder.hs‎

Lines changed: 29 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -37,8 +37,8 @@ callDecoder name tipe =
3737
(a (VarForeign mLamdera_Wire name (Forall Map.empty (TAlias mLamdera_Wire "Decoder" [("a", tipe)] (Filled (TType (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") "Decoder" [tipe]))))))
3838

3939

40-
decoderForType :: Map.Map Module.Raw I.Interface -> Module.Canonical -> Type -> Expr
41-
decoderForType ifaces cname tipe =
40+
decoderForType :: DecodeMode -> Map.Map Module.Raw I.Interface -> Module.Canonical -> Type -> Expr
41+
decoderForType mode ifaces cname tipe =
4242
if containsUnsupportedTypes tipe then
4343
failDecode "contains unsupported types"
4444
else
@@ -89,8 +89,8 @@ decoderForType ifaces cname tipe =
8989
(Module.Canonical (Name "elm" "bytes") "Bytes.Decode")
9090
"Decoder"
9191
[TTuple (TVar "a") (TVar "b") Nothing]))))))))
92-
[ decoderForType ifaces cname a_
93-
, decoderForType ifaces cname b
92+
[ decoderForType mode ifaces cname a_
93+
, decoderForType mode ifaces cname b
9494
]))
9595

9696
TTuple a_ b (Just c) ->
@@ -126,9 +126,9 @@ decoderForType ifaces cname tipe =
126126
(Filled
127127
(TType (Module.Canonical (Name "elm" "bytes") "Bytes.Decode") "Decoder"
128128
[TTuple (TVar "a") (TVar "b") (Just (TVar "c"))])))))))))
129-
[ decoderForType ifaces cname a_
130-
, decoderForType ifaces cname b
131-
, decoderForType ifaces cname c
129+
[ decoderForType mode ifaces cname a_
130+
, decoderForType mode ifaces cname b
131+
, decoderForType mode ifaces cname c
132132
]))
133133

134134
TType (Module.Canonical (Name "elm" "core") "Maybe") "Maybe" [ptype] ->
@@ -148,7 +148,7 @@ decoderForType ifaces cname tipe =
148148
(Module.Canonical (Name "elm" "bytes") "Bytes.Decode")
149149
"Decoder"
150150
[TType (Module.Canonical (Name "elm" "core") "Maybe") "Maybe" [TVar "a"]])))))))
151-
[ decoderForType ifaces cname ptype ]))
151+
[ decoderForType mode ifaces cname ptype ]))
152152

153153
TType (Module.Canonical (Name "elm" "core") "List") "List" [ptype] ->
154154
(a (Call
@@ -167,7 +167,7 @@ decoderForType ifaces cname tipe =
167167
(Module.Canonical (Name "elm" "bytes") "Bytes.Decode")
168168
"Decoder"
169169
[TType (Module.Canonical (Name "elm" "core") "List") "List" [TVar "a"]])))))))
170-
[ decoderForType ifaces cname ptype ]))
170+
[ decoderForType mode ifaces cname ptype ]))
171171

172172
TType (Module.Canonical (Name "elm" "core") "Set") "Set" [ptype] ->
173173
(a (Call
@@ -186,7 +186,7 @@ decoderForType ifaces cname tipe =
186186
(Module.Canonical (Name "elm" "bytes") "Bytes.Decode")
187187
"Decoder"
188188
[TType (Module.Canonical (Name "elm" "core") "Set") "Set" [TVar "comparable"]])))))))
189-
[ decoderForType ifaces cname ptype ]))
189+
[ decoderForType mode ifaces cname ptype ]))
190190

191191
TType (Module.Canonical (Name "lamdera" "containers") "SeqSet") "SeqSet" [ptype] ->
192192
(a (Call
@@ -205,7 +205,7 @@ decoderForType ifaces cname tipe =
205205
(Module.Canonical (Name "elm" "bytes") "Bytes.Decode")
206206
"Decoder"
207207
[TType mLamdera_SeqSet "SeqSet" [TVar "k"]])))))))
208-
[ decoderForType ifaces cname ptype ]))
208+
[ decoderForType mode ifaces cname ptype ]))
209209

210210
TType (Module.Canonical (Name "elm" "core") "Array") "Array" [ptype] ->
211211
(a (Call
@@ -224,7 +224,7 @@ decoderForType ifaces cname tipe =
224224
(Module.Canonical (Name "elm" "bytes") "Bytes.Decode")
225225
"Decoder"
226226
[TType (Module.Canonical (Name "elm" "core") "Array") "Array" [TVar "a"]])))))))
227-
[ decoderForType ifaces cname ptype ]))
227+
[ decoderForType mode ifaces cname ptype ]))
228228

229229
TType (Module.Canonical (Name "elm" "core") "Result") "Result" [err, a_] ->
230230
(a (Call
@@ -259,8 +259,8 @@ decoderForType ifaces cname tipe =
259259
"Result"
260260
[TVar "err", TVar "val"]
261261
]))))))))
262-
[ decoderForType ifaces cname err
263-
, decoderForType ifaces cname a_
262+
[ decoderForType mode ifaces cname err
263+
, decoderForType mode ifaces cname a_
264264
]))
265265

266266
TType (Module.Canonical (Name "elm" "core") "Dict") "Dict" [key, val] ->
@@ -298,8 +298,8 @@ decoderForType ifaces cname tipe =
298298
"Dict"
299299
[TVar "comparable", TVar "value"]
300300
]))))))))
301-
[ decoderForType ifaces cname key
302-
, decoderForType ifaces cname val
301+
[ decoderForType mode ifaces cname key
302+
, decoderForType mode ifaces cname val
303303
]))
304304

305305
TType (Module.Canonical (Name "lamdera" "containers") "SeqDict") "SeqDict" [key, val] ->
@@ -337,8 +337,8 @@ decoderForType ifaces cname tipe =
337337
"SeqDict"
338338
[TVar "k", TVar "value"]
339339
]))))))))
340-
[ decoderForType ifaces cname key
341-
, decoderForType ifaces cname val
340+
[ decoderForType mode ifaces cname key
341+
, decoderForType mode ifaces cname val
342342
]))
343343

344344
TType (Module.Canonical (Name "elm" "bytes") "Bytes") "Bytes" _ ->
@@ -355,7 +355,7 @@ decoderForType ifaces cname tipe =
355355

356356
TType moduleName typeName params ->
357357
let
358-
generatedName = Data.Name.fromChars $ "w3_decode_" ++ Data.Name.toChars typeName
358+
generatedName = Data.Name.fromChars $ decodePrefix mode ++ Data.Name.toChars typeName
359359

360360
decoder =
361361
if cname == moduleName
@@ -368,7 +368,7 @@ decoderForType ifaces cname tipe =
368368
else
369369
case params of
370370
[] -> decoder
371-
_ -> call decoder $ fmap (decoderForType ifaces cname) params
371+
_ -> call decoder $ fmap (decoderForType mode ifaces cname) params
372372

373373
TRecord fieldMap maybeExtensible ->
374374
-- | TRecord (Map.Map Name FieldType) (Maybe Name)
@@ -379,11 +379,11 @@ decoderForType ifaces cname tipe =
379379
Nothing ->
380380
let fields = fieldMap & fieldsToList & List.sortOn (\(name, field) -> name)
381381
in
382-
decodeRecord ifaces cname fields
382+
decodeRecord mode ifaces cname fields
383383

384384
TAlias moduleName typeName tvars_ aType ->
385385
let
386-
generatedName = Data.Name.fromChars $ "w3_decode_" ++ Data.Name.toChars typeName
386+
generatedName = Data.Name.fromChars $ decodePrefix mode ++ Data.Name.toChars typeName
387387
innerType = case aType of { Holey t -> t; Filled t -> t }
388388

389389
decoder =
@@ -402,7 +402,7 @@ decoderForType ifaces cname tipe =
402402
TVar name ->
403403
lvar $ Data.Name.fromChars $ "w3_x_c_" ++ Data.Name.toChars name
404404
_ ->
405-
decoderForType ifaces cname tvarType
405+
decoderForType mode ifaces cname tvarType
406406
) tvars_
407407
in
408408
if isUnsupportedKernelType tipe
@@ -417,23 +417,23 @@ decoderForType ifaces cname tipe =
417417
case resolvedRecordFieldMapM fieldMap extensibleName tvars_ of
418418
Just resolved ->
419419
let extendedRecord = TRecord resolved Nothing & resolveTvar tvars_
420-
in decoderForType ifaces cname extendedRecord
420+
in decoderForType mode ifaces cname extendedRecord
421421
Nothing -> normalDecoder
422422
_ ->
423423
-- Resolve extensible records through TAlias chains,
424424
-- e.g. Color = ColorValue { red, green, blue, alpha }
425425
case resolveTvar tvars_ tipe of
426426
TAlias _ _ _ (Filled (TRecord fieldMap Nothing)) ->
427427
let fields = fieldMap & fieldsToList & List.sortOn (\(name, field) -> name)
428-
in decodeRecord ifaces cname fields
428+
in decodeRecord mode ifaces cname fields
429429
_ -> normalDecoder
430430
Filled tipe ->
431431
case tipe of
432432
TRecord fieldMap extensibleName ->
433433
case resolvedRecordFieldMapM fieldMap extensibleName tvars_ of
434434
Just resolved ->
435435
let extendedRecord = TRecord resolved Nothing & resolveTvar tvars_
436-
in decoderForType ifaces cname extendedRecord
436+
in decoderForType mode ifaces cname extendedRecord
437437
Nothing -> normalDecoder
438438
otherTypes -> normalDecoder
439439

@@ -444,8 +444,8 @@ decoderForType ifaces cname tipe =
444444
failDecode "lambda"
445445

446446

447-
decodeRecord :: Map.Map Module.Raw I.Interface -> Module.Canonical -> [(Data.Name.Name, Type)] -> Expr
448-
decodeRecord ifaces cname fields =
447+
decodeRecord :: DecodeMode -> Map.Map Module.Raw I.Interface -> Module.Canonical -> [(Data.Name.Name, Type)] -> Expr
448+
decodeRecord mode ifaces cname fields =
449449
let
450450
pvars :: [Pattern]
451451
pvars =
@@ -463,7 +463,7 @@ decodeRecord ifaces cname fields =
463463
++ fmap (\(name, field) ->
464464
andMapDecode1 (
465465
-- debugDecoder (Utf8.fromChars $ "." <> Data.Name.toChars name) $
466-
decoderForType ifaces cname field
466+
decoderForType mode ifaces cname field
467467
)
468468
) fields
469469
& foldlPairs (|>)

0 commit comments

Comments
 (0)