have defaults for method and status

zachary822 · Dec 5, 2024 · 3ccd84a · 3ccd84a
1 parent dde5dc6
commit 3ccd84a
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 6 deletions.
diff --git a/app/Lib/Types.hs b/app/Lib/Types.hs
@@ -16,8 +16,8 @@ import Network.HTTP.Types.Status
 type Paths = Map String PathConfig
 
 data PathConfig = PathConfig
-  { responseMethod :: HTTPMethod
-  , responseStatus :: !HTTPStatus
+  { responseMethod :: !(Maybe HTTPMethod)
+  , responseStatus :: !(Maybe HTTPStatus)
   , responseDelay :: !(Maybe Int)
   , responseBody :: !(Maybe Value)
   , responseHeaders :: !(Maybe (Map TL.Text TL.Text))
@@ -27,8 +27,8 @@ data PathConfig = PathConfig
 instance FromJSON PathConfig where
   parseJSON = withObject "PathConfig" $ \o ->
     PathConfig
-      <$> o .: "method"
-      <*> o .: "status"
+      <$> o .:? "method"
+      <*> o .:? "status"
       <*> o .:? "delay"
       <*> o .:? "body"
       <*> o .:? "headers"

diff --git a/app/Main.hs b/app/Main.hs
@@ -47,8 +47,11 @@ main = do
     middleware logStdoutDev
 
     forM_ (M.toList pc) $ \(path, PathConfig{..}) -> do
-      addroute (unMethod responseMethod) (fromString path) $ do
-        status (unStatus responseStatus)
+      let addroute' = maybe matchAny (addroute . unMethod) responseMethod
+      addroute' (fromString path) $ do
+        case responseStatus of
+          Nothing -> mempty
+          Just s -> status $ unStatus s
 
         case responseDelay of
           Nothing -> mempty