fix: stricter validation of POST json body passed to the textile API. (…

…#760)

There actually wasn't any strict validation performed on some optional
parameters passed as a JSON body to POST requests, because we were using
the infamous `Json.Decode.maybe` decoder which fallbacks to returning
`Nothing` instead of a failure in case the decoded value is invalid.

src/Data/Textile/Query.elm

@@ -37,6 +37,7 @@ import Data.Textile.Product as Product exposing (Product)
 import Data.Textile.Step.Label as Label exposing (Label)
 import Data.Unit as Unit
 import Json.Decode as Decode exposing (Decoder)
+import Json.Decode.Extra as DE
 import Json.Decode.Pipeline as Pipe
 import Json.Encode as Encode
 import List.Extra as LE
@@ -110,39 +111,46 @@ buildApiQuery clientUrl query =
 decode : Decoder Query
 decode =
     Decode.succeed Query
-        |> Pipe.optional "airTransportRatio" (Decode.maybe Split.decodeFloat) Nothing
-        |> Pipe.optional "business" (Decode.maybe Economics.decodeBusiness) Nothing
-        |> Pipe.optional "countryDyeing" (Decode.maybe Country.decodeCode) Nothing
-        |> Pipe.optional "countryFabric" (Decode.maybe Country.decodeCode) Nothing
-        |> Pipe.optional "countryMaking" (Decode.maybe Country.decodeCode) Nothing
-        |> Pipe.optional "countrySpinning" (Decode.maybe Country.decodeCode) Nothing
+        |> strictOptional "airTransportRatio" Split.decodeFloat
+        |> strictOptional "business" Economics.decodeBusiness
+        |> strictOptional "countryDyeing" Country.decodeCode
+        |> strictOptional "countryFabric" Country.decodeCode
+        |> strictOptional "countryMaking" Country.decodeCode
+        |> strictOptional "countrySpinning" Country.decodeCode
         |> Pipe.optional "disabledSteps" (Decode.list Label.decodeFromCode) []
-        |> Pipe.optional "dyeingMedium" (Decode.maybe DyeingMedium.decode) Nothing
-        |> Pipe.optional "fabricProcess" (Decode.maybe Fabric.decode) Nothing
-        |> Pipe.optional "fading" (Decode.maybe Decode.bool) Nothing
-        |> Pipe.optional "makingComplexity" (Decode.maybe MakingComplexity.decode) Nothing
-        |> Pipe.optional "makingDeadStock" (Decode.maybe Split.decodeFloat) Nothing
-        |> Pipe.optional "makingWaste" (Decode.maybe Split.decodeFloat) Nothing
+        |> strictOptional "dyeingMedium" DyeingMedium.decode
+        |> strictOptional "fabricProcess" Fabric.decode
+        |> strictOptional "fading" Decode.bool
+        |> strictOptional "makingComplexity" MakingComplexity.decode
+        |> strictOptional "makingDeadStock" Split.decodeFloat
+        |> strictOptional "makingWaste" Split.decodeFloat
         |> Pipe.required "mass" (Decode.map Mass.kilograms Decode.float)
         |> Pipe.required "materials" (Decode.list decodeMaterialQuery)
-        |> Pipe.optional "numberOfReferences" (Decode.maybe Decode.int) Nothing
-        |> Pipe.optional "physicalDurability" (Decode.maybe Unit.decodePhysicalDurability) Nothing
-        |> Pipe.optional "price" (Decode.maybe Economics.decodePrice) Nothing
-        |> Pipe.optional "printing" (Decode.maybe Printing.decode) Nothing
+        |> strictOptional "numberOfReferences" Decode.int
+        |> strictOptional "physicalDurability" Unit.decodePhysicalDurability
+        |> strictOptional "price" Economics.decodePrice
+        |> strictOptional "printing" Printing.decode
         |> Pipe.required "product" (Decode.map Product.Id Decode.string)
-        |> Pipe.optional "surfaceMass" (Decode.maybe Unit.decodeSurfaceMass) Nothing
-        |> Pipe.optional "traceability" (Decode.maybe Decode.bool) Nothing
+        |> strictOptional "surfaceMass" Unit.decodeSurfaceMass
+        |> strictOptional "traceability" Decode.bool
         |> Pipe.optional "upcycled" Decode.bool False
-        |> Pipe.optional "yarnSize" (Decode.maybe Unit.decodeYarnSize) Nothing
+        |> strictOptional "yarnSize" Unit.decodeYarnSize
+
+
+strictOptional : String -> Decoder a -> Decoder (Maybe a -> b) -> Decoder b
+strictOptional field decoder =
+    -- Note: Using Json.Decode.Extra's optionalField here because we want
+    -- a failure when a Maybe decoded field value is invalid
+    DE.andMap (DE.optionalField field decoder)
 
 
 decodeMaterialQuery : Decoder MaterialQuery
 decodeMaterialQuery =
     Decode.succeed MaterialQuery
-        |> Pipe.optional "country" (Decode.maybe Country.decodeCode) Nothing
+        |> strictOptional "country" Country.decodeCode
         |> Pipe.required "id" (Decode.map Material.Id Decode.string)
         |> Pipe.required "share" Split.decodeFloat
-        |> Pipe.optional "spinning" (Decode.maybe Spinning.decode) Nothing
+        |> strictOptional "spinning" Spinning.decode
 
 
 encode : Query -> Encode.Value

src/Data/Unit.elm

@@ -187,9 +187,8 @@ decodePhysicalDurability =
                         )
 
                 else
-                    Decode.succeed float
+                    Decode.succeed (physicalDurability float)
             )
-        |> Decode.map physicalDurability
 
 
 encodePhysicalDurability : PhysicalDurability -> Encode.Value

src/Server.elm

@@ -19,7 +19,6 @@ import Data.Textile.Material as Material exposing (Material)
 import Data.Textile.Product as TextileProduct exposing (Product)
 import Data.Textile.Query as TextileQuery
 import Data.Textile.Simulator as Simulator exposing (Simulator)
-import Json.Decode as Decode
 import Json.Encode as Encode
 import Route as WebRoute
 import Server.Query as Query
@@ -277,41 +276,40 @@ handleRequest db request =
                 |> respondWith 400
 
         -- POST routes
-        Just Route.FoodPostRecipe ->
-            request.body
-                |> handleDecodeBody BuilderQuery.decode
-                    (\query ->
-                        executeFoodQuery db (toFoodResults query) query
-                    )
-
-        Just Route.TextilePostSimulator ->
-            request.body
-                |> handleDecodeBody TextileQuery.decode
-                    (executeTextileQuery db toAllImpactsSimple)
-
-        Just Route.TextilePostSimulatorDetailed ->
-            request.body
-                |> handleDecodeBody TextileQuery.decode
-                    (executeTextileQuery db Simulator.encode)
-
-        Just (Route.TextilePostSimulatorSingle trigram) ->
-            request.body
-                |> handleDecodeBody TextileQuery.decode
-                    (executeTextileQuery db (toSingleImpactSimple trigram))
+        Just (Route.FoodPostRecipe (Ok foodQuery)) ->
+            executeFoodQuery db (toFoodResults foodQuery) foodQuery
 
-        Nothing ->
-            encodeStringError "Endpoint doesn't exist"
-                |> respondWith 404
+        Just (Route.FoodPostRecipe (Err error)) ->
+            Encode.string error
+                |> respondWith 400
 
+        Just (Route.TextilePostSimulator (Ok textileQuery)) ->
+            textileQuery
+                |> executeTextileQuery db toAllImpactsSimple
 
-handleDecodeBody : Decode.Decoder a -> (a -> JsonResponse) -> Encode.Value -> JsonResponse
-handleDecodeBody decoder mapper jsonBody =
-    case Decode.decodeValue decoder jsonBody of
-        Err error ->
-            ( 400, Encode.string (Decode.errorToString error) )
+        Just (Route.TextilePostSimulator (Err error)) ->
+            Encode.string error
+                |> respondWith 400
+
+        Just (Route.TextilePostSimulatorDetailed (Ok textileQuery)) ->
+            textileQuery
+                |> executeTextileQuery db Simulator.encode
 
-        Ok x ->
-            mapper x
+        Just (Route.TextilePostSimulatorDetailed (Err error)) ->
+            Encode.string error
+                |> respondWith 400
+
+        Just (Route.TextilePostSimulatorSingle (Ok textileQuery) trigram) ->
+            textileQuery
+                |> executeTextileQuery db (toSingleImpactSimple trigram)
+
+        Just (Route.TextilePostSimulatorSingle (Err error) _) ->
+            Encode.string error
+                |> respondWith 400
+
+        Nothing ->
+            encodeStringError "Endpoint doesn't exist"
+                |> respondWith 404
 
 
 update : Msg -> Cmd Msg

src/Server/Query.elm

@@ -15,7 +15,6 @@ import Data.Food.Query as BuilderQuery
 import Data.Food.Retail as Retail exposing (Distribution)
 import Data.Scope as Scope exposing (Scope)
 import Data.Split as Split exposing (Split)
-import Data.Textile.Db as Textile
 import Data.Textile.DyeingMedium as DyeingMedium exposing (DyeingMedium)
 import Data.Textile.Economics as Economics
 import Data.Textile.Fabric as Fabric exposing (Fabric)
@@ -33,6 +32,7 @@ import Mass exposing (Mass)
 import Quantity
 import Regex
 import Result.Extra as RE
+import Static.Db exposing (Db)
 import Url.Parser.Query as Query exposing (Parser)
 
 
@@ -63,8 +63,8 @@ succeed =
     always >> Query.custom ""
 
 
-parseFoodQuery : List Country -> Food.Db -> Parser (Result Errors BuilderQuery.Query)
-parseFoodQuery countries food =
+parseFoodQuery : Db -> Parser (Result Errors BuilderQuery.Query)
+parseFoodQuery { countries, food } =
     succeed (Ok BuilderQuery.Query)
         |> apply (distributionParser "distribution")
         |> apply (ingredientListParser "ingredients" countries food)
@@ -281,9 +281,8 @@ validatePhysicalDurability string =
                         )
 
                 else
-                    Ok durability
+                    Ok (Unit.PhysicalDurability durability)
             )
-        |> Result.map Unit.PhysicalDurability
 
 
 maybeTransformParser : String -> List FoodProcess.Process -> Parser (ParseResult (Maybe BuilderQuery.ProcessQuery))
@@ -384,8 +383,8 @@ parseTransform_ transforms string =
             Err <| "Format de procédé de transformation invalide : " ++ string ++ "."
 
 
-parseTextileQuery : List Country -> Textile.Db -> Parser (Result Errors TextileQuery.Query)
-parseTextileQuery countries textile =
+parseTextileQuery : Db -> Parser (Result Errors TextileQuery.Query)
+parseTextileQuery { countries, textile } =
     succeed (Ok TextileQuery.Query)
         |> apply (maybeSplitParser "airTransportRatio")
         |> apply (maybeBusiness "business")
@@ -884,7 +883,6 @@ encodeErrors : Errors -> Encode.Value
 encodeErrors errors =
     Encode.object
         [ ( "errors"
-          , errors
-                |> Encode.dict identity Encode.string
+          , errors |> Encode.dict identity Encode.string
           )
         ]

src/Server/Route.elm

@@ -3,13 +3,13 @@ module Server.Route exposing
     , endpoint
     )
 
-import Data.Country exposing (Country)
-import Data.Food.Db as Food
 import Data.Food.Query as BuilderQuery
 import Data.Impact as Impact
 import Data.Impact.Definition as Definition
-import Data.Textile.Db as Textile
+import Data.Textile.Inputs as Inputs
 import Data.Textile.Query as TextileQuery
+import Json.Decode as Decode
+import Json.Encode as Encode
 import Server.Query as Query
 import Server.Request exposing (Request)
 import Static.Db exposing (Db)
@@ -38,7 +38,7 @@ type Route
     | FoodGetTransformList
       --   POST
       --     Food recipe builder (POST, JSON body)
-    | FoodPostRecipe
+    | FoodPostRecipe (Result String BuilderQuery.Query)
       --
       -- Textile Routes
       --   GET
@@ -56,42 +56,73 @@ type Route
     | TextileGetSimulatorSingle Definition.Trigram (Result Query.Errors TextileQuery.Query)
       --   POST
       --     Textile Simple version of all impacts (POST, JSON body)
-    | TextilePostSimulator
+    | TextilePostSimulator (Result String TextileQuery.Query)
       --     Textile Detailed version for all impacts (POST, JSON body)
-    | TextilePostSimulatorDetailed
-      --     Textile Simple version for one specific impact (POST, JSON bosy)
-    | TextilePostSimulatorSingle Definition.Trigram
+    | TextilePostSimulatorDetailed (Result String TextileQuery.Query)
+      --     Textile Simple version for one specific impact (POST, JSON body)
+    | TextilePostSimulatorSingle (Result String TextileQuery.Query) Definition.Trigram
 
 
-parser : Food.Db -> Textile.Db -> List Country -> Parser (Route -> a) a
-parser foodDb textile countries =
+parser : Db -> Encode.Value -> Parser (Route -> a) a
+parser db body =
     Parser.oneOf
         [ -- Food
-          Parser.map FoodGetCountryList (s "GET" </> s "food" </> s "countries")
-        , Parser.map FoodGetIngredientList (s "GET" </> s "food" </> s "ingredients")
-        , Parser.map FoodGetTransformList (s "GET" </> s "food" </> s "transforms")
-        , Parser.map FoodGetPackagingList (s "GET" </> s "food" </> s "packagings")
-        , Parser.map FoodGetRecipe (s "GET" </> s "food" <?> Query.parseFoodQuery countries foodDb)
-        , Parser.map FoodPostRecipe (s "POST" </> s "food")
+          -- GET
+          (s "GET" </> s "food" </> s "countries")
+            |> Parser.map FoodGetCountryList
+        , (s "GET" </> s "food" </> s "ingredients")
+            |> Parser.map FoodGetIngredientList
+        , (s "GET" </> s "food" </> s "transforms")
+            |> Parser.map FoodGetTransformList
+        , (s "GET" </> s "food" </> s "packagings")
+            |> Parser.map FoodGetPackagingList
+        , (s "GET" </> s "food" <?> Query.parseFoodQuery db)
+            |> Parser.map FoodGetRecipe
+        , (s "POST" </> s "food")
+            |> Parser.map (FoodPostRecipe (decodeFoodQueryBody body))
 
         -- Textile
-        , Parser.map TextileGetCountryList (s "GET" </> s "textile" </> s "countries")
-        , Parser.map TextileGetMaterialList (s "GET" </> s "textile" </> s "materials")
-        , Parser.map TextileGetProductList (s "GET" </> s "textile" </> s "products")
-        , Parser.map TextileGetSimulator (s "GET" </> s "textile" </> s "simulator" <?> Query.parseTextileQuery countries textile)
-        , Parser.map TextileGetSimulatorDetailed (s "GET" </> s "textile" </> s "simulator" </> s "detailed" <?> Query.parseTextileQuery countries textile)
-        , Parser.map TextileGetSimulatorSingle (s "GET" </> s "textile" </> s "simulator" </> Impact.parseTrigram <?> Query.parseTextileQuery countries textile)
-        , Parser.map TextilePostSimulator (s "POST" </> s "textile" </> s "simulator")
-        , Parser.map TextilePostSimulatorDetailed (s "POST" </> s "textile" </> s "simulator" </> s "detailed")
-        , Parser.map TextilePostSimulatorSingle (s "POST" </> s "textile" </> s "simulator" </> Impact.parseTrigram)
+        , (s "GET" </> s "textile" </> s "countries")
+            |> Parser.map TextileGetCountryList
+        , (s "GET" </> s "textile" </> s "materials")
+            |> Parser.map TextileGetMaterialList
+        , (s "GET" </> s "textile" </> s "products")
+            |> Parser.map TextileGetProductList
+        , (s "GET" </> s "textile" </> s "simulator" <?> Query.parseTextileQuery db)
+            |> Parser.map TextileGetSimulator
+        , (s "GET" </> s "textile" </> s "simulator" </> s "detailed" <?> Query.parseTextileQuery db)
+            |> Parser.map TextileGetSimulatorDetailed
+        , (s "GET" </> s "textile" </> s "simulator" </> Impact.parseTrigram <?> Query.parseTextileQuery db)
+            |> Parser.map TextileGetSimulatorSingle
+        , (s "POST" </> s "textile" </> s "simulator")
+            |> Parser.map (TextilePostSimulator (decodeTextileQueryBody db body))
+        , (s "POST" </> s "textile" </> s "simulator" </> s "detailed")
+            |> Parser.map (TextilePostSimulatorDetailed (decodeTextileQueryBody db body))
+        , (s "POST" </> s "textile" </> s "simulator" </> Impact.parseTrigram)
+            |> Parser.map (TextilePostSimulatorSingle (decodeTextileQueryBody db body))
         ]
 
 
+decodeFoodQueryBody : Encode.Value -> Result String BuilderQuery.Query
+decodeFoodQueryBody =
+    Decode.decodeValue BuilderQuery.decode
+        >> Result.mapError Decode.errorToString
+
+
+decodeTextileQueryBody : Db -> Encode.Value -> Result String TextileQuery.Query
+decodeTextileQueryBody db =
+    Decode.decodeValue TextileQuery.decode
+        >> Result.mapError Decode.errorToString
+        -- Note: Using inputs mapping to act as query validation
+        >> Result.andThen (Inputs.fromQuery db)
+        >> Result.map Inputs.toQuery
+
+
 endpoint : Db -> Request -> Maybe Route
-endpoint { countries, food, textile } { method, url } =
+endpoint db { body, method, url } =
     -- Notes:
     -- - Url.fromString can't build a Url without a fully qualified URL, so as we only have the
     --   request path from Express, we build a fake URL with a fake protocol and hostname.
     -- - We update the path appending the HTTP method to it, for simpler, cheaper route parsing.
     Url.fromString ("http://x/" ++ method ++ url)
-        |> Maybe.andThen (Parser.parse (parser food textile countries))
+        |> Maybe.andThen (Parser.parse (parser db body))