Servant Haskell library issue with Optional ReqBody fix demonstration

issue-fix-demo.hs

#! /usr/bin/env nix-shell
#! nix-shell --pure -i runhaskell -E "import ./shell.nix {}"

{-
  This is a demonstration of the fix of the issue
  https://github.com/haskell-servant/servant/issues/1346

  Run server (make sure there’s “shell.nix” in the same directory):
    ./issue-fix-demo.hs

  Both requests should work for “/test” route:
    curl --fail --verbose http://127.0.0.1:8088/test -XPUT
    curl --fail --verbose http://127.0.0.1:8088/test -XPUT --data '[1,2]'

  But only this one should for for “/test2”:
    curl --fail --verbose http://127.0.0.1:8088/test2 -XPUT --data '[1,2]'
-}

{-# LANGUAGE UnicodeSyntax, DataKinds, TypeOperators, TypeApplications #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings #-}

import Data.Proxy
import Control.Monad.IO.Class (liftIO)
import Servant
import Servant.Server
import Network.Wai.Handler.Warp

type TestApi =
  "test"
  :> ReqBody' '[Optional, Strict] '[JSON] [Integer]
  :> Put '[JSON] ()
  :<|>
  "test2"
  :> ReqBody' '[Required, Strict] '[JSON] [Integer]
  :> Put '[JSON] ()

server ∷ Server TestApi
server = testHandler :<|> test2Handler where
  -- Fixed: [Integer] wrapped into Maybe since it’s optional
  testHandler ∷ Maybe [Integer] → Handler ()
  testHandler = liftIO . print

  test2Handler ∷ [Integer] → Handler ()
  test2Handler = liftIO . print

app ∷ Application
app = serve (Proxy @TestApi) server

main ∷ IO ()
main = putStrLn "Running server..." >> run 8088 app

shell.nix

{ pkgs ?
    let
      src = fetchTarball {
        url =
          "https://github.com/NixOS/nixpkgs/archive/" +
          "a9226f2b3a52fcbbc5587d2fa030729e714f40fe.tar.gz";
        sha256 = "0xlzkymfrkj7z7b6hwliq2zn6pbjw08zka0qyv5bbnkhnv16x1dh";
      };

      servantSrc = fetchTarball {
        url =
          "https://github.com/unclechu/servant/archive/" +
          "50b50fa0e6f7798d6b766e59edda64b12d6179e8.tar.gz";
        sha256 = "0a9z2j3ralqh0300apmqpg8az33bjqahpcbwcmrzcxknik6l9rps";
      };

      servantPkg = super: name:
        super.haskellPackages.callCabal2nix name "${servantSrc}/${name}" {};

      servantOverlay = self: super: {
        haskellPackages = super.haskellPackages.override {
          overrides = hsSelf: hsSuper: {
            servant = servantPkg super "servant";
          };
        };
      };

      # servant-server depends on servant 0.18 so apply first servant overlay
      # and only then servant-server.
      servantServerOverlay = self: super: {
        haskellPackages = super.haskellPackages.override {
          overrides = hsSelf: hsSuper: {
            servant-server = servantPkg super "servant-server";
          };
        };
      };
    in
      import src { overlays = [ servantOverlay servantServerOverlay ]; }
}:
let
  haskellDeps = p: [ p.servant p.servant-server p.warp p.http-media ];
  ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
in
pkgs.mkShell { buildInputs = [ ghc ]; }