Skip to content

Instantly share code, notes, and snippets.

@unclechu
Created October 3, 2020 15:09
Show Gist options
  • Save unclechu/347bbc386e0659242de80e8ff38b0ec6 to your computer and use it in GitHub Desktop.
Save unclechu/347bbc386e0659242de80e8ff38b0ec6 to your computer and use it in GitHub Desktop.
Servant Haskell library issue with Optional ReqBody demonstration
#! /usr/bin/env nix-shell
#! nix-shell --pure -i runhaskell -E "import ./shell.nix {}"
{-
This a demonstration of the issue with Servant library.
ReqBody' '[Optional] doesn’t make the value be optional,
the value of ReqBody isn’t wrapped into Maybe as it supposed to.
Run server (make sure there’s “shell.nix” in the same directory):
./issue-demo.hs
Both requests should work:
curl --fail --verbose http://127.0.0.1:8088/test -XPUT
curl --fail --verbose http://127.0.0.1:8088/test -XPUT \
-H 'Content-Type: application/json' --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
import Network.HTTP.Media ((//))
data Nope = Nope
type TestApi =
"test"
:> ReqBody' '[Optional, Strict] '[Nope, JSON] [Integer]
:> Put '[JSON] ()
instance Accept Nope where
-- Servant defaults to application/octet-stream when Content-Type header isn’t
-- provided
contentType Proxy = "application" // "octet-stream"
-- A hack in order to default the value into mempty to make it be optional
instance Monoid m ⇒ MimeUnrender Nope m where
mimeUnrender Proxy _ = Right mempty
server ∷ Server TestApi
server = testHandler where
-- As you can see here the ReqBody type [Integer] wasn’t wrapped into Maybe
-- even though it is Optional.
testHandler ∷ [Integer] → Handler ()
testHandler = liftIO . print
app ∷ Application
app = serve (Proxy @TestApi) server
main ∷ IO ()
main = putStrLn "Running server..." >> run 8088 app
{ pkgs ?
let
src = fetchTarball {
url =
"https://github.com/NixOS/nixpkgs/archive/" +
"a9226f2b3a52fcbbc5587d2fa030729e714f40fe.tar.gz";
sha256 = "0xlzkymfrkj7z7b6hwliq2zn6pbjw08zka0qyv5bbnkhnv16x1dh";
};
# In nixpkgs latest default version of Servant is 0.16.2.
# Overriding here version to 0.18.
servantOverlay = self: super: {
haskellPackages = super.haskellPackages.override {
overrides = hsSelf: hsSuper: {
servant = hsSuper.servant_0_18;
servant-server = hsSuper.servant-server_0_18;
};
};
};
in
import src { overlays = [ servantOverlay ]; }
}:
let
haskellDeps = p: [ p.servant p.servant-server p.warp p.http-media ];
ghc = pkgs.haskellPackages.ghcWithPackages haskellDeps;
shell = pkgs.mkShell { buildInputs = [ ghc ]; };
info = {
"GHC version" = ghc.version; # 8.8.4
"Servant version" = pkgs.haskellPackages.servant.version; # 0.18
};
renderedInfo =
builtins.concatStringsSep "\n" (
builtins.map (k: "${k} = ${info.${k}}") (builtins.attrNames info)
);
in
builtins.trace ("\n${renderedInfo}") shell
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment