Created
October 3, 2020 15:09
-
-
Save unclechu/347bbc386e0659242de80e8ff38b0ec6 to your computer and use it in GitHub Desktop.
Servant Haskell library issue with Optional ReqBody demonstration
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#! /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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{ 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