digital-asset/daml
1
1
Fork 0
mirror of https://github.com/digital-asset/daml.git synced 2024-09-17 15:57:21 +03:00
Code Issues Projects Releases Wiki Activity

Move to using proto3-wire from upstream (#480)

Browse Source 
* Move to using proto3-wire from upstream

* Move to upstream proto3-suite, with some custom patches in my fork

* Delete the BUILD.bazel for hte proto3 stuff, not used and the test was failing

* Delete the old proto3-wire and proto3-suite forks

* Delete proto3-wire

* Prettify BUILD.bazel files, sort the deps

* Remove some special cases from the license checker

* Delete unused Nix files from grpc-haskell

* Switch to upstream proto3-suite

* Make old-time work on Windows

* Formatting

* Patch rules_haskell to use a response file for -optP to avoid overflowing argument size limits on Windows

* Update 3rdparty/haskell/BUILD.old-time

Co-Authored-By: neil-da <35463327+neil-da@users.noreply.github.com>

* Update the comments in old-time

* Use the revised location of proto3-suite
This commit is contained in:
Neil Mitchell 2019-04-24 16:59:08 +01:00 committed by mergify[bot]
parent 40f196f7f6
commit 85c72f87d1
121 changed files with 265 additions and 12935 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
3rdparty/haskell/BUILD vendored
View File

@ -2,4 +2,5 @@
exports_files([
"network-package.bzl",
"c2hs-package.bzl",
"old-time-package.bzl",
])

48
3rdparty/haskell/BUILD.old-time vendored Normal file
View File

@ -0,0 +1,48 @@
# vim: ft=python
# By default 'old-time' fails to build on Windows and is very much inhermetic on
# Linux/Darwin. The reasons are described here: https://github.com/FormationAI/hazel/issues/80
#
# In order to work around this we use a cabal-like 'package.bzl' generated on
# Linux ('old-time-package.bzl') and tweak it to introduce a C dependency on
# the generated network headers. Those are generated by 'configure' using the
# proper Bazel CC toolchain.
load("@ai_formation_hazel//third_party/cabal2bazel:bzl/cabal_package.bzl",
"cabal_haskell_package",
"hazel_symlink")
load("@hazel_base_repository//:extra-libs.bzl",
"extra_libs",
)
load("@os_info//:os_info.bzl", "is_windows")
load("@com_github_digital_asset_daml//3rdparty/haskell:old-time-package.bzl", "package")
genrule(
name = "old-time-include-gen",
cmd = "PATH=`dirname $(CC)`:$${PATH} $(location configure) && cp include/HsTimeConfig.h $@",
outs = [ "include/HsTimeConfig.h"],
srcs = [ "configure", "include/HsTimeConfig.h.in", "install-sh", "config.sub", "config.guess"],
toolchains = ["@bazel_tools//tools/cpp:current_cc_toolchain"],
)
cc_library(
name = "old-time-include",
srcs = [ ":old-time-include-gen"],
)
extra_libs_with_headers = extra_libs + {"old-time-headers": ":old-time-include"}
# Make a buildable target for easier debugging of the package.bzl file
hazel_symlink(
name = "bzl",
src = "@com_github_digital_asset_daml//3rdparty/haskell:old-time-package.bzl",
out = "package-bzl",
)
cabal_haskell_package(
package,
"8.6.4",
"@io_tweag_rules_haskell_ghc_windows_amd64" if is_windows else "@io_tweag_rules_haskell_ghc-nixpkgs",
extra_libs_with_headers,
)

126
3rdparty/haskell/old-time-package.bzl vendored Normal file
View File

@ -0,0 +1,126 @@
# This file was partly generated. See 3rdparty/haskell/BUILD.old-time for more
# details.
load(
"@ai_formation_hazel//third_party/cabal2bazel:bzl/cabal_package.bzl",
"cabal_haskell_package",
)
package = (
struct(
specVersionRaw = None,
package = struct(pkgName = "old-time", pkgVersion = "1.1.0.3"),
licenseRaw = None,
licenseFiles = ["LICENSE"],
copyright = "",
maintainer = "libraries@haskell.org",
author = "",
stability = "",
testedWith = [],
homepage = "",
pkgUrl = "",
bugReports = "https://github.com/haskell/old-time/issues",
sourceRepos =
[
struct(
repoKind = "RepoHead",
repoType = "Git",
repoLocation = "https://github.com/haskell/old-time.git",
repoModule = None,
repoBranch = None,
repoTag = None,
repoSubdir = None,
),
],
synopsis = "Time library",
description =
"This package provides the old time library.\n\nFor new projects, the newer\n<http://hackage.haskell.org/package/time time library>\nis recommended.",
category = "System",
customFieldsPD = [],
buildTypeRaw = "Configure",
setupBuildInfo = None,
library =
struct(
libName = None,
exposedModules = ["System.Time"],
reexportedModules = [],
signatures = [],
libExposed = True,
libBuildInfo =
struct(
buildable = True,
buildTools = [],
buildToolDepends = [],
cppOptions = [],
asmOptions = [],
cmmOptions = [],
ccOptions = [],
cxxOptions = [],
ldOptions = [],
pkgconfigDepends = [],
frameworks = [],
extraFrameworkDirs = [],
asmSources = [],
cmmSources = [],
cSources = ["cbits/timeUtils.c"],
cxxSources = [],
jsSources = [],
hsSourceDirs = [],
otherModules = [],
virtualModules = [],
autogenModules = [],
defaultLanguage = "Haskell2010",
otherLanguages = [],
defaultExtensions = [],
otherExtensions = ["Trustworthy"],
oldExtensions = [],
extraLibs = ["old-time-headers"],
extraGHCiLibs = [],
extraBundledLibs = [],
extraLibFlavours = [],
extraLibDirs = [],
includeDirs = ["include"],
includes = ["HsTime.h"],
installIncludes = ["HsTimeConfig.h", "HsTime.h"],
options = [("ghc", ["-Wall"])],
profOptions = [],
sharedOptions = [],
staticOptions = [],
customFieldsBI = [],
targetBuildDepends =
[
struct(name = "base", version = ">=4.7 && <4.9"),
struct(name = "old-locale", version = "==1.0.*"),
],
mixins = [],
),
),
subLibraries = [],
executables = [],
foreignLibs = [],
testSuites = [],
benchmarks = [],
dataFiles = [],
dataDir = "",
extraSrcFiles =
[
"aclocal.m4",
"changelog.md",
"config.guess",
"config.sub",
"configure",
"configure.ac",
"include/HsTimeConfig.h.in",
"install-sh",
"old-time.buildinfo",
],
extraTmpFiles =
[
"autom4te.cache",
"config.log",
"config.status",
"include/HsTimeConfig.h",
],
extraDocFiles = [],
)
)

11
WORKSPACE
View File

@ -1,6 +1,6 @@
workspace(name = "com_github_digital_asset_daml")
load("//:util.bzl", "hazel_ghclibs", "hazel_github", "hazel_hackage")
load("//:util.bzl", "hazel_ghclibs", "hazel_github", "hazel_github_external", "hazel_hackage")
# NOTE(JM): Load external dependencies from deps.bzl.
# Do not put "http_archive" and similar rules into this file. Put them into
@ -406,6 +406,8 @@ hazel_repositories(
# Read [Working on ghc-lib] for ghc-lib update instructions at
# https://github.com/DACH-NY/daml/blob/master/ghc-lib/working-on-ghc-lib.md
hazel_ghclibs("0.20190417.1", "3ba013ab8707aa9bd357b7c38cce45eda3b4ede89528ffaf89c31439bc4a9ad9", "0c5206a842e26f9283181d69a820e1f9abda6d4a617a1c14fd42e29a2ebb594f") +
hazel_github_external("awakesecurity", "proto3-wire", "43d8220dbc64ef7cc7681887741833a47b61070f", "1c3a7fbf4ab3308776675c6202583f9750de496757f3ad4815e81edd122d75e1") +
hazel_github_external("awakesecurity", "proto3-suite", "dd01df7a3f6d0f1ea36125a67ac3c16936b53da0", "59ea7b876b14991347918eefefe24e7f0e064b5c2cc14574ac4ab5d6af6413ca") +
hazel_hackage("bytestring-nums", "0.3.6", "bdca97600d91f00bb3c0f654784e3fbd2d62fcf4671820578105487cdf39e7cd") +
hazel_hackage("unix-time", "0.4.5", "fe7805c62ad682589567afeee265e6e230170c3941cdce479a2318d1c5088faf") +
hazel_hackage("zip-archive", "0.3.3", "988adee77c806e0b497929b24d5526ea68bd3297427da0d0b30b99c094efc84d") +
@ -438,6 +440,13 @@ hazel_custom_package_hackage(
version = "2.8.0.0",
) if is_windows else None
hazel_custom_package_hackage(
package_name = "old-time",
build_file = "//3rdparty/haskell:BUILD.old-time",
sha256 = "1ccb158b0f7851715d36b757c523b026ca1541e2030d02239802ba39b4112bc1",
version = "1.1.0.3",
) if is_windows else None
hazel_custom_package_hackage(
package_name = "zlib",
build_file = "//3rdparty/haskell:BUILD.zlib",

1
bazel_tools/BUILD.bazel
View File

@ -8,6 +8,7 @@ exports_files(
"scala.bzl",
"haskell-c2hs.patch",
"haskell-static-linking.patch",
"haskell-optp-response.patch",
"haskell-arx.patch",
"haskell-win-sys-includes.patch",
"haskell-drop-fake-static.patch",

32
bazel_tools/haskell-optp-response.patch Normal file
View File

@ -0,0 +1,32 @@
Some targets use a lot of space for -optP flags, so put them in a response file
diff --git a/haskell/private/actions/compile.bzl b/haskell/private/actions/compile.bzl
index 20c8720..7fca51c 100644
--- a/haskell/private/actions/compile.bzl
+++ b/haskell/private/actions/compile.bzl
@@ -213,7 +213,17 @@ def _compilation_defaults(hs, cc, java, dep_info, plugin_dep_info, srcs, import_
set.mutable_insert(import_dirs, idir)
ghc_args += ["-i{0}".format(d) for d in set.to_list(import_dirs)]
- ghc_args += ["-optP" + f for f in cc.cpp_flags]
+
+ # Write the -optP flags to a response because they can be very long on Windows
+ # e.g. 27Kb for grpc-haskell
+ # Equivalent to: ghc_args += ["-optP" + f for f in cc.cpp_flags]
+ optp_args_file = hs.actions.declare_file("optp_args_%s" % hs.name)
+ optp_args = hs.actions.args()
+ optp_args.add_all(cc.cpp_flags)
+ optp_args.set_param_file_format("multiline")
+ hs.actions.write(optp_args_file, optp_args)
+ ghc_args += ["-optP@" + optp_args_file.path]
+
ghc_args += cc.include_args
locale_archive_depset = (
@@ -326,6 +336,7 @@ def _compilation_defaults(hs, cc, java, dep_info, plugin_dep_info, srcs, import_
java.inputs,
locale_archive_depset,
depset(transitive = plugin_tool_inputs),
+ depset([optp_args_file]),
]),
input_manifests = plugin_tool_input_manifests,
objects_dir = objects_dir,

2
compiler/daml-lf-proto/BUILD.bazel
View File

@ -15,6 +15,7 @@ da_haskell_library(
"either",
"lens",
"memory",
"proto3-suite",
"scientific",
"template-haskell",
"text",
@ -27,6 +28,5 @@ da_haskell_library(
"//daml-lf/archive:daml_lf_haskell_proto",
"//libs-haskell/da-hs-base",
"//libs-haskell/da-hs-pretty",
"//nix/third-party/proto3-suite",
],
)

2
compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs
View File

@ -443,7 +443,7 @@ decodePrimLit (LF1.PrimLit mbSum) = mayDecode "primLitSum" mbSum $ \case
LF1.PrimLitSumDecimal sDec -> case readMay (TL.unpack sDec) of
Nothing -> Left $ ParseError ("bad fixed while decoding Decimal: '" <> TL.unpack sDec <> "'")
Just dec -> return (BEDecimal dec)
LF1.PrimLitSumTimestamp (Proto.Fixed sTime) -> pure $ BETimestamp sTime
LF1.PrimLitSumTimestamp sTime -> pure $ BETimestamp sTime
LF1.PrimLitSumText x -> pure $ BEText $ TL.toStrict x
LF1.PrimLitSumParty p -> pure $ BEParty (taggedT p)
LF1.PrimLitSumDate days -> pure $ BEDate days

2
compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeVDev.hs
View File

@ -430,7 +430,7 @@ decodePrimLit (LF1.PrimLit mbSum) = mayDecode "primLitSum" mbSum $ \case
LF1.PrimLitSumDecimal sDec -> case readMay (TL.unpack sDec) of
Nothing -> Left $ ParseError ("bad fixed while decoding Decimal: '" <> TL.unpack sDec <> "'")
Just dec -> return (BEDecimal dec)
LF1.PrimLitSumTimestamp (Proto.Fixed sTime) -> pure $ BETimestamp sTime
LF1.PrimLitSumTimestamp sTime -> pure $ BETimestamp sTime
LF1.PrimLitSumText x -> pure $ BEText $ TL.toStrict x
LF1.PrimLitSumParty p -> pure $ BEParty (taggedT p)
LF1.PrimLitSumDate days -> pure $ BEDate days

4
compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs
View File

@ -28,7 +28,7 @@ import DA.Daml.LF.Ast
import DA.Daml.LF.Mangling
import qualified Da.DamlLf1 as P
import qualified Proto3.Suite as P (Enumerated (..), Fixed(..))
import qualified Proto3.Suite as P (Enumerated (..))
-- | Encoding 'from' to type 'to'
class Encode from to | from -> to where
@ -218,7 +218,7 @@ instance Encode BuiltinExpr P.ExprSum where
BEInt64 x -> lit $ P.PrimLitSumInt64 x
BEDecimal dec -> lit $ P.PrimLitSumDecimal (TL.pack (show dec))
BEText x -> lit $ P.PrimLitSumText (TL.fromStrict x)
BETimestamp x -> lit $ P.PrimLitSumTimestamp (P.Fixed x)
BETimestamp x -> lit $ P.PrimLitSumTimestamp x
BEParty x -> lit $ P.PrimLitSumParty (encode version x)
BEDate x -> lit $ P.PrimLitSumDate x

4
compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeVDev.hs
View File

@ -27,7 +27,7 @@ import DA.Daml.LF.Ast
import DA.Daml.LF.Mangling
import qualified Da.DamlLfDev as P
import qualified Proto3.Suite as P (Enumerated (..), Fixed(..))
import qualified Proto3.Suite as P (Enumerated (..))
-- | Encoding 'from' to type 'to'
class Encode from to | from -> to where
@ -211,7 +211,7 @@ instance Encode BuiltinExpr P.ExprSum where
BEInt64 x -> lit $ P.PrimLitSumInt64 x
BEDecimal dec -> lit $ P.PrimLitSumDecimal (TL.pack (show dec))
BEText x -> lit $ P.PrimLitSumText (TL.fromStrict x)
BETimestamp x -> lit $ P.PrimLitSumTimestamp (P.Fixed x)
BETimestamp x -> lit $ P.PrimLitSumTimestamp x
BEParty x -> lit $ P.PrimLitSumParty (encode x)
BEDate x -> lit $ P.PrimLitSumDate x

8
compiler/scenario-service/client/BUILD.bazel
View File

@ -9,11 +9,11 @@ da_haskell_library(
hazel_deps = [
"async",
"base",
"blaze-html",
"binary",
"blaze-html",
"bytestring",
"conduit",
"conduit-extra",
"conduit",
"containers",
"cryptonite",
"deepseq",
@ -25,6 +25,8 @@ da_haskell_library(
"managed",
"mtl",
"process",
"proto3-suite",
"proto3-wire",
"split",
"stm",
"system-filepath",
@ -46,7 +48,5 @@ da_haskell_library(
"//libs-haskell/da-hs-pretty",
"//nix/third-party/gRPC-haskell:grpc-haskell",
"//nix/third-party/gRPC-haskell/core:grpc-haskell-core",
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)

5
compiler/scenario-service/client/src/DA/Daml/LF/PrettyScenario.hs
View File

@ -35,7 +35,6 @@ import qualified Data.Time.Clock.POSIX as CP
import qualified Data.Time.Format as TF
import qualified Data.Vector as V
import qualified Network.URI.Encode
import qualified Proto3.Suite.Types as PT
import ScenarioService
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
@ -414,8 +413,8 @@ prettyScenarioStep (ScenarioStep stepId (Just step)) = do
dt = show (abs micros)
n = length dt
prettyTimestamp :: PT.Fixed Int64 -> Doc SyntaxClass
prettyTimestamp = prettyUtcTime . toUtcTime . fromIntegral . PT.fixed
prettyTimestamp :: Int64 -> Doc SyntaxClass
prettyTimestamp = prettyUtcTime . toUtcTime . fromIntegral
where
prettyUtcTime =
string . TF.formatTime TF.defaultTimeLocale "%FT%T%QZ"

9
compiler/scenario-service/protos/BUILD.bazel
View File

@ -54,11 +54,11 @@ genrule(
cmd = """
ORIGPWD=$$PWD
cd compiler/scenario-service/protos
$$ORIGPWD/$(location //nix/third-party/proto3-suite:compile-proto-file) \
$$ORIGPWD/$(location @haskell_proto3__suite//:compile-proto-file) \
--proto scenario_service.proto --out "$$ORIGPWD/$(@D)"
""",
tools = [
"//nix/third-party/proto3-suite:compile-proto-file",
"@haskell_proto3__suite//:compile-proto-file",
],
)
@ -68,7 +68,10 @@ da_haskell_library(
hazel_deps = [
"base",
"bytestring",
"containers",
"deepseq",
"proto3-suite",
"proto3-wire",
"text",
"vector",
],
@ -76,7 +79,5 @@ da_haskell_library(
deps = [
"//nix/third-party/gRPC-haskell:grpc-haskell",
"//nix/third-party/gRPC-haskell/core:grpc-haskell-core",
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)

10
daml-foundations/daml-ghc/BUILD.bazel
View File

@ -21,8 +21,8 @@ da_haskell_library(
"src/Development/IDE/**/*.hs",
]),
hazel_deps = [
"aeson",
"aeson-pretty",
"aeson",
"async",
"base",
"binary",
@ -37,8 +37,8 @@ da_haskell_library(
"extra",
"filepath",
"filepattern",
"ghc-lib",
"ghc-lib-parser",
"ghc-lib",
"hashable",
"http-types",
"lens",
@ -47,9 +47,10 @@ da_haskell_library(
"network-uri",
"prettyprinter",
"process",
"proto3-suite",
"recursion-schemes",
"safe",
"safe-exceptions",
"safe",
"shake",
"stm",
"syb",
@ -57,8 +58,8 @@ da_haskell_library(
"temporary",
"text",
"time",
"transformers",
"transformers-base",
"transformers",
"uniplate",
"unordered-containers",
"uri-encode",
@ -79,7 +80,6 @@ da_haskell_library(
"//libs-haskell/da-hs-language-server",
"//libs-haskell/da-hs-pretty",
"//libs-haskell/prettyprinter-syntax",
"//nix/third-party/proto3-suite",
],
)

8
daml-foundations/daml-tools/da-hs-daml-cli/BUILD.bazel
View File

@ -10,8 +10,8 @@ da_haskell_library(
"//daml-foundations/daml-tools/docs/daml-licenses/licenses:licensing.md",
],
hazel_deps = [
"aeson",
"aeson-pretty",
"aeson",
"ansi-wl-pprint",
"base",
"bytestring",
@ -23,8 +23,8 @@ da_haskell_library(
"filepath",
"ghc-lib",
"gitrev",
"lens",
"lens-aeson",
"lens",
"managed",
"memory",
"mtl",
@ -32,12 +32,13 @@ da_haskell_library(
"optparse-applicative",
"prettyprinter",
"process",
"proto3-suite",
"safe-exceptions",
"shake",
"split",
"tasty",
"tasty-ant-xml",
"tasty-hunit",
"tasty",
"text",
"vector",
"xml",
@ -59,7 +60,6 @@ da_haskell_library(
"//libs-haskell/da-hs-base",
"//libs-haskell/da-hs-pretty",
"//libs-haskell/prettyprinter-syntax",
"//nix/third-party/proto3-suite",
],
)

4
daml-foundations/daml-tools/docs/daml-licenses/licenses/extract.py
View File

@ -45,10 +45,6 @@ def substitute_license(package, version):
# Forked libraries, under nix/third-party.
elif package == "grpc-haskell" or package == "grpc-haskell-core":
return read_license("../../../../../nix/third-party/gRPC-haskell/LICENSE")
elif package == "proto3-suite":
return read_license("../../../../../nix/third-party/proto3-suite/LICENSE")
elif package == "proto3-wire":
return read_license("../../../../../nix/third-party/proto3-wire/LICENSE")
# For the rest, retrieve the license from Hackage.
else:

11
daml-lf/archive/BUILD.bazel
View File

@ -65,12 +65,12 @@ genrule(
"ORIGPWD=`pwd`\ncd daml-lf/archive\n" +
"\n".join(
[
"$$ORIGPWD/$(location //nix/third-party/proto3-suite:compile-proto-file) --proto da/daml_lf%s.proto --out $$ORIGPWD/$(@D)" % vx
"$$ORIGPWD/$(location @haskell_proto3__suite//:compile-proto-file) --proto da/daml_lf%s.proto --out $$ORIGPWD/$(@D)" % vx
for vx in [""] + ["_%s" % v for v in LF_MAJOR_VERSIONS]
],
),
tools = [
"//nix/third-party/proto3-suite:compile-proto-file",
"@haskell_proto3__suite//:compile-proto-file",
],
)
@ -81,15 +81,14 @@ da_haskell_library(
hazel_deps = [
"base",
"bytestring",
"containers",
"deepseq",
"proto3-suite",
"proto3-wire",
"text",
"vector",
],
visibility = ["//visibility:public"],
deps = [
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)
da_scala_library(

1
deps.bzl
View File

@ -42,6 +42,7 @@ def daml_deps():
urls = ["https://github.com/tweag/rules_haskell/archive/%s.tar.gz" % rules_haskell_version],
patches = [
"@com_github_digital_asset_daml//bazel_tools:haskell-static-linking.patch",
"@com_github_digital_asset_daml//bazel_tools:haskell-optp-response.patch",
"@com_github_digital_asset_daml//bazel_tools:haskell-win-sys-includes.patch",
"@com_github_digital_asset_daml//bazel_tools:haskell-drop-fake-static.patch",
],

4
ledger-api/grpc-definitions/BUILD.bazel
View File

@ -128,7 +128,7 @@ genrule(
well_known=$$(dirname $$(dirname $$(dirname $$(echo $(locations @com_google_protobuf//:well_known_protos) | cut -d ' ' -f1))))
rpc_status=$$(dirname $$(dirname $$(dirname $$(echo $(location @com_github_googleapis_googleapis//google/rpc:status.proto)))))
for src in $(locations :ledger-api-protos-fg); do
$(location //nix/third-party/proto3-suite:compile-proto-file) \
$(location @haskell_proto3__suite//:compile-proto-file) \
--includeDir $$here \
--includeDir $$well_known \
--includeDir $$rpc_status \
@ -137,7 +137,7 @@ genrule(
done
""",
tools = [
"//nix/third-party/proto3-suite:compile-proto-file",
"@haskell_proto3__suite//:compile-proto-file",
],
)

18
nix/third-party/gRPC-haskell/BUILD.bazel vendored
View File

@ -4,16 +4,16 @@ da_haskell_library(
name = "grpc-haskell",
srcs = glob(["src/**/*.hs"]),
hazel_deps = [
"async",
"base",
"bytestring",
"async",
"proto3-suite",
"proto3-wire",
],
src_strip_prefix = "src",
visibility = ["//visibility:public"],
deps = [
"//nix/third-party/gRPC-haskell/core:grpc-haskell-core",
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)
@ -21,10 +21,12 @@ da_haskell_binary(
name = "hellos-server",
srcs = glob(["examples/hellos/hellos-server/*.hs"]),
hazel_deps = [
"base",
"async",
"base",
"bytestring",
"containers",
"proto3-suite",
"proto3-wire",
"text",
"transformers",
],
@ -32,8 +34,6 @@ da_haskell_binary(
deps = [
":grpc-haskell",
"//nix/third-party/gRPC-haskell/core:grpc-haskell-core",
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)
@ -41,10 +41,12 @@ da_haskell_binary(
name = "hellos-client",
srcs = glob(["examples/hellos/hellos-client/*.hs"]),
hazel_deps = [
"base",
"async",
"base",
"bytestring",
"containers",
"proto3-suite",
"proto3-wire",
"text",
"transformers",
],
@ -52,7 +54,5 @@ da_haskell_binary(
deps = [
":grpc-haskell",
"//nix/third-party/gRPC-haskell/core:grpc-haskell-core",
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)

6
nix/third-party/gRPC-haskell/core/BUILD.bazel vendored
View File

@ -28,20 +28,20 @@ da_haskell_library(
"containers",
"managed",
"pipes",
"proto3-suite",
"proto3-wire",
"safe",
"sorted-list",
"stm",
"tasty",
"tasty-hunit",
"tasty-quickcheck",
"tasty",
"transformers",
"vector",
],
visibility = ["//visibility:public"],
deps = [
":fat_cbits",
"//nix/third-party/proto3-suite",
"//nix/third-party/proto3-wire",
],
)

26
nix/third-party/gRPC-haskell/core/default.nix vendored
View File

@ -1,26 +0,0 @@
{ mkDerivation, async, base, bytestring, c2hs, clock, containers
, grpc, managed, pipes, proto3-suite, proto3-wire, QuickCheck, safe
, sorted-list, stdenv, stm, tasty, tasty-hunit, tasty-quickcheck
, text, time, transformers, turtle, unix, vector, openssl, c-ares
, zlib, libcxx, libcxxabi
}:
mkDerivation {
pname = "grpc-haskell-core";
version = "0.0.0.0";
src = ./.;
libraryHaskellDepends = [
async base bytestring clock containers managed pipes proto3-suite
proto3-wire safe sorted-list stm tasty tasty-hunit tasty-quickcheck
transformers vector
];
librarySystemDepends = [ grpc openssl c-ares zlib libcxx libcxxabi ];
libraryToolDepends = [ c2hs ];
testHaskellDepends = [
async base bytestring clock containers managed pipes proto3-suite
QuickCheck safe tasty tasty-hunit tasty-quickcheck text time
transformers turtle unix
];
homepage = "https://github.com/awakenetworks/gRPC-haskell";
description = "Haskell implementation of gRPC layered on shared C library";
license = stdenv.lib.licenses.asl20;
}

31
nix/third-party/gRPC-haskell/default.nix vendored
View File

@ -1,31 +0,0 @@
{ mkDerivation, async, base, bytestring, c2hs, clock, containers
, criterion, grpc-haskell-core, managed, pipes, proto3-suite
, proto3-wire, QuickCheck, random, safe, sorted-list, stdenv, stm
, tasty, tasty-hunit, tasty-quickcheck, text, time, transformers
, turtle, unix, vector
}:
mkDerivation {
pname = "grpc-haskell";
version = "0.0.0.0";
src = ./.;
isLibrary = true;
isExecutable = true;
libraryHaskellDepends = [
async base bytestring clock containers grpc-haskell-core managed
pipes proto3-suite proto3-wire safe sorted-list stm tasty
tasty-hunit tasty-quickcheck transformers vector
];
doCheck = false;
libraryToolDepends = [ c2hs ];
testHaskellDepends = [
async base bytestring clock containers managed pipes proto3-suite
QuickCheck safe tasty tasty-hunit tasty-quickcheck text time
transformers turtle unix
];
benchmarkHaskellDepends = [
async base bytestring criterion proto3-suite random
];
homepage = "https://github.com/awakenetworks/gRPC-haskell";
description = "Haskell implementation of gRPC layered on shared C library";
license = stdenv.lib.licenses.asl20;
}

60
nix/third-party/gRPC-haskell/fetch-nixpkgs.nix vendored
View File

@ -1,60 +0,0 @@
{ rev # The Git revision of nixpkgs to fetch
, sha256 # The SHA256 of the downloaded data
, outputSha256 ? null # The SHA256 output hash
, system ? builtins.currentSystem # This is overridable if necessary
}:
with {
ifThenElse = { bool, thenValue, elseValue }: (
if bool then thenValue else elseValue);
};
ifThenElse {
bool = (0 <= builtins.compareVersions builtins.nixVersion "1.12");
# In Nix 1.12, we can just give a `sha256` to `builtins.fetchTarball`.
thenValue = (
builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
# builtins.fetchTarball does not need the sha256 hash of the
# packed and compressed tarball but it _does_ need the
# fixed-output sha256 hash.
sha256 = outputSha256;
});
# This hack should at least work for Nix 1.11
elseValue = (
(rec {
tarball = import <nix/fetchurl.nix> {
url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
inherit sha256;
};
builtin-paths = import <nix/config.nix>;
script = builtins.toFile "nixpkgs-unpacker" ''
"$coreutils/mkdir" "$out"
cd "$out"
"$gzip" --decompress < "$tarball" | "$tar" -x --strip-components=1
'';
nixpkgs = builtins.derivation ({
name = "nixpkgs-${builtins.substring 0 6 rev}";
builder = builtins.storePath builtin-paths.shell;
args = [ script ];
inherit tarball system;
tar = builtins.storePath builtin-paths.tar;
gzip = builtins.storePath builtin-paths.gzip;
coreutils = builtins.storePath builtin-paths.coreutils;
} // (if null == outputSha256 then { } else {
outputHashMode = "recursive";
outputHashAlgo = "sha256";
outputHash = outputSha256;
}));
}).nixpkgs);
}

32
nix/third-party/gRPC-haskell/nix/aeson.nix vendored
View File

@ -1,32 +0,0 @@
{ mkDerivation, attoparsec, base, base-compat, base-orphans
, base16-bytestring, bytestring, containers, deepseq, directory
, dlist, filepath, generic-deriving, ghc-prim, hashable
, hashable-time, HUnit, integer-logarithms, QuickCheck
, quickcheck-instances, scientific, stdenv, tagged
, template-haskell, test-framework, test-framework-hunit
, test-framework-quickcheck2, text, time, time-locale-compat
, unordered-containers, uuid-types, vector
}:
mkDerivation {
pname = "aeson";
version = "1.1.1.0";
sha256 = "1mkj4a09x9psmgq9sg5nz9va76756zfm97ds2gk2qpgxc7nr2dq8";
revision = "2";
editedCabalFile = "10bc20f8807990e71f5db74a1b7029f81f888c6f9d1c03e93883555fd1291e84";
libraryHaskellDepends = [
attoparsec base base-compat bytestring containers deepseq dlist
ghc-prim hashable scientific tagged template-haskell text time
time-locale-compat unordered-containers uuid-types vector
];
testHaskellDepends = [
attoparsec base base-compat base-orphans base16-bytestring
bytestring containers directory dlist filepath generic-deriving
ghc-prim hashable hashable-time HUnit integer-logarithms QuickCheck
quickcheck-instances scientific tagged template-haskell
test-framework test-framework-hunit test-framework-quickcheck2 text
time time-locale-compat unordered-containers uuid-types vector
];
homepage = "https://github.com/bos/aeson";
description = "Fast JSON parsing and encoding";
license = stdenv.lib.licenses.bsd3;
}

10
nix/third-party/gRPC-haskell/nix/cabal-doctest.nix vendored
View File

@ -1,10 +0,0 @@
{ mkDerivation, base, Cabal, directory, filepath, stdenv }:
mkDerivation {
pname = "cabal-doctest";
version = "1.0.2";
sha256 = "0h3wsjf2mg8kw1zvxc0f9nzchj5kzvza9z0arcyixkd9rkgqq6sa";
libraryHaskellDepends = [ base Cabal directory filepath ];
homepage = "https://github.com/phadej/cabal-doctest";
description = "A Setup.hs helper for doctests running";
license = stdenv.lib.licenses.bsd3;
}

40
nix/third-party/gRPC-haskell/nix/grpc.nix vendored
View File

@ -1,40 +0,0 @@
{ darwin, stdenv, lib, fetchgit, autoconf, automake, libtool, which, zlib
, openssl
}:
stdenv.mkDerivation rec {
name = "grpc-${version}";
version = "1.2.0-${lib.strings.substring 0 7 rev}";
rev = "e2cfe9df79c4eda4e376222df064c4c65e616352";
src = fetchgit {
inherit rev;
url = "https://github.com/grpc/grpc.git";
sha256 = "19ldbjlnbc287hkaylsigm8w9fai2bjdbfxk6315kl75cq54iprr";
};
# `grpc`'s `Makefile` does some magic to detect the correct `ld` and `strip`
# to use along with their flags, too. If Nix supplies `$LD` and `$STRIP` then
# this auto-detection fails and the build fails, which is why we unset the
# environment variables here and let the `Makefile` set them.
preBuild = ''
unset LD
unset STRIP
'';
preInstall = "export prefix";
buildInputs = [
autoconf
automake
libtool
which
zlib
openssl
];
# Some versions of `ar` (such as the one provided by OS X) require an explicit
# `-r` flag, whereas other versions assume `-r` is the default if no mode is
# specified. For example, OS X requires the `-r` flag, so as a precaution we
# always specify the flag.
AROPTS = "-r";
}

23
nix/third-party/gRPC-haskell/nix/insert-ordered-containers.nix vendored
View File

@ -1,23 +0,0 @@
{ mkDerivation, aeson, base, base-compat, hashable, lens
, QuickCheck, semigroupoids, semigroups, stdenv, tasty
, tasty-quickcheck, text, transformers, unordered-containers
}:
mkDerivation {
pname = "insert-ordered-containers";
version = "0.2.1.0";
sha256 = "1612f455dw37da9g7bsd1s5kyi84mnr1ifnjw69892amyimi47fp";
revision = "3";
editedCabalFile = "6fdce987672b006226243aa17522b57ec7a9e1cab247802eddbdaa9dc5b06446";
libraryHaskellDepends = [
aeson base base-compat hashable lens semigroupoids semigroups text
transformers unordered-containers
];
testHaskellDepends = [
aeson base base-compat hashable lens QuickCheck semigroupoids
semigroups tasty tasty-quickcheck text transformers
unordered-containers
];
homepage = "https://github.com/phadej/insert-ordered-containers#readme";
description = "Associative containers retating insertion order for traversals";
license = stdenv.lib.licenses.bsd3;
}

15
nix/third-party/gRPC-haskell/nix/optparse-applicative.nix vendored
View File

@ -1,15 +0,0 @@
{ mkDerivation, ansi-wl-pprint, base, bytestring, process
, QuickCheck, stdenv, transformers, transformers-compat
}:
mkDerivation {
pname = "optparse-applicative";
version = "0.14.0.0";
sha256 = "06iwp1qsq0gjhnhxwyhdhldwvhlgcik6lx5jxpbb40fispyk4nxm";
libraryHaskellDepends = [
ansi-wl-pprint base process transformers transformers-compat
];
testHaskellDepends = [ base bytestring QuickCheck ];
homepage = "https://github.com/pcapriotti/optparse-applicative";
description = "Utilities and combinators for parsing command line options";
license = stdenv.lib.licenses.bsd3;
}

14
nix/third-party/gRPC-haskell/nix/optparse-generic.nix vendored
View File

@ -1,14 +0,0 @@
{ mkDerivation, base, bytestring, optparse-applicative, semigroups
, stdenv, system-filepath, text, time, transformers, void
}:
mkDerivation {
pname = "optparse-generic";
version = "1.2.1";
sha256 = "1dk945dp98mwk1v4y0cky3z0ngmd29nbg6fbaaxnigcrgpbvkjml";
libraryHaskellDepends = [
base bytestring optparse-applicative semigroups system-filepath
text time transformers void
];
description = "Auto-generate a command-line parser for your datatype";
license = stdenv.lib.licenses.bsd3;
}

39
nix/third-party/gRPC-haskell/nix/proto3-suite.nix vendored
View File

@ -1,39 +0,0 @@
{ mkDerivation, aeson, aeson-pretty, attoparsec, base
, base64-bytestring, binary, bytestring, cereal, containers
, deepseq, doctest, fetchgit, foldl, hashable, haskell-src
, insert-ordered-containers, lens, mtl, neat-interpolation
, optparse-generic, parsec, parsers, pretty, pretty-show
, proto3-wire, QuickCheck, range-set-list, safe, semigroups, stdenv
, swagger2, system-filepath, tasty, tasty-hunit, tasty-quickcheck
, text, transformers, turtle, vector
}:
mkDerivation {
pname = "proto3-suite";
version = "0.2.0.0";
src = fetchgit {
url = "https://github.com/awakesecurity/proto3-suite.git";
sha256 = "1khix03a4hwaqc192s523rjlsk1iq923ndmrj5myh61fr1fpcbaq";
rev = "c103a8c6d3c16515fe2e9ea7f932d54729db2f5f";
};
isLibrary = true;
isExecutable = true;
enableSeparateDataOutput = true;
libraryHaskellDepends = [
aeson aeson-pretty attoparsec base base64-bytestring binary
bytestring cereal containers deepseq foldl hashable haskell-src
insert-ordered-containers lens mtl neat-interpolation parsec
parsers pretty pretty-show proto3-wire QuickCheck safe semigroups
swagger2 system-filepath text transformers turtle vector
];
executableHaskellDepends = [
base containers optparse-generic proto3-wire range-set-list
system-filepath text turtle
];
testHaskellDepends = [
aeson attoparsec base base64-bytestring bytestring cereal doctest
pretty-show proto3-wire QuickCheck semigroups swagger2 tasty
tasty-hunit tasty-quickcheck text transformers turtle vector
];
description = "A low level library for writing out data in the Protocol Buffers wire format";
license = stdenv.lib.licenses.asl20;
}

23
nix/third-party/gRPC-haskell/nix/proto3-wire.nix vendored
View File

@ -1,23 +0,0 @@
{ mkDerivation, base, bytestring, cereal, containers, deepseq
, doctest, fetchgit, hashable, QuickCheck, safe, stdenv, tasty
, tasty-hunit, tasty-quickcheck, text, unordered-containers
}:
mkDerivation {
pname = "proto3-wire";
version = "1.0.0";
src = fetchgit {
url = "https://github.com/awakenetworks/proto3-wire.git";
sha256 = "14n0d16an782ayipirm5v2mvp58jgf65xvffqzp08p50sksil3gi";
rev = "a938330bf794cf3fa05591d03906915df98d157c";
};
libraryHaskellDepends = [
base bytestring cereal containers deepseq hashable QuickCheck safe
text unordered-containers
];
testHaskellDepends = [
base bytestring cereal doctest QuickCheck tasty tasty-hunit
tasty-quickcheck text
];
description = "A low-level implementation of the Protocol Buffers (version 3) wire format";
license = stdenv.lib.licenses.asl20;
}

27
nix/third-party/gRPC-haskell/nix/swagger2.nix vendored
View File

@ -1,27 +0,0 @@
{ mkDerivation, aeson, aeson-qq, base, base-compat, bytestring
, Cabal, cabal-doctest, containers, doctest, generics-sop, Glob
, hashable, hspec, http-media, HUnit, insert-ordered-containers
, lens, mtl, network, QuickCheck, scientific, stdenv
, template-haskell, text, time, transformers, transformers-compat
, unordered-containers, uuid-types, vector
}:
mkDerivation {
pname = "swagger2";
version = "2.1.6";
sha256 = "01a29h56vfyw0ilij1pn6qwy50ca90kyj884vs1q52vvh572758j";
setupHaskellDepends = [ base Cabal cabal-doctest ];
libraryHaskellDepends = [
aeson base base-compat bytestring containers generics-sop hashable
http-media insert-ordered-containers lens mtl network scientific
template-haskell text time transformers transformers-compat
unordered-containers uuid-types vector
];
testHaskellDepends = [
aeson aeson-qq base base-compat bytestring containers doctest Glob
hashable hspec HUnit insert-ordered-containers lens mtl QuickCheck
text time unordered-containers vector
];
homepage = "https://github.com/GetShopTV/swagger2";
description = "Swagger 2.0 data model";
license = stdenv.lib.licenses.bsd3;
}

20
nix/third-party/gRPC-haskell/nix/turtle.nix vendored
View File

@ -1,20 +0,0 @@
{ mkDerivation, ansi-wl-pprint, async, base, bytestring, clock
, directory, doctest, foldl, hostname, managed, optional-args
, optparse-applicative, process, semigroups, stdenv, stm
, system-fileio, system-filepath, temporary, text, time
, transformers, unix, unix-compat
}:
mkDerivation {
pname = "turtle";
version = "1.3.6";
sha256 = "0fr8p6rnk2lrsgbfh60jlqcjr0nxrh3ywxsj5d4psck0kgyhvg1m";
libraryHaskellDepends = [
ansi-wl-pprint async base bytestring clock directory foldl hostname
managed optional-args optparse-applicative process semigroups stm
system-fileio system-filepath temporary text time transformers unix
unix-compat
];
testHaskellDepends = [ base doctest system-filepath temporary ];
description = "Shell programming, Haskell-style";
license = stdenv.lib.licenses.bsd3;
}

13
nix/third-party/gRPC-haskell/nixpkgs.nix vendored
View File

@ -1,13 +0,0 @@
# Given a Git revision hash `<rev>`, you get the new SHA256 by running:
#
# ```bash
# $ nix-prefetch-url "https://github.com/NixOS/nixpkgs/archive/<rev>.tar.gz"
# ```
#
# The SHA256 will be printed as the last line of stdout.
import ./fetch-nixpkgs.nix {
rev = "74286ec9e76be7cd00c4247b9acb430c4bd9f1ce";
sha256 = "0njb3qd2wxj7gil8y61lwh7zacmvr6zklv67w5zmvifi1fvalvdg";
outputSha256 = "13ydgpzl5nix4gc358iy9zjd5nrrpbpwpxmfhis4aai2zmkja3ak";
}

309
nix/third-party/gRPC-haskell/release.nix vendored
View File

@ -1,309 +0,0 @@
# If you would like to test and build changes quickly using `cabal`, run:
#
# $ # Consider adding the following command to your `~/.profile`
# $ NIX_PATH="${NIX_PATH}:ssh-config-file=${HOME}/.ssh/config:ssh-auth-sock=${SSH_AUTH_SOCK}"
# $ nix-shell -A grpc-haskell.env release.nix
# [nix-shell]$ cabal configure --enable-tests && cabal build && cabal test
#
# This will open up a Nix shell where all of your Haskell tools will work like
# normal, except that all dependencies (including C libraries) are managed by
# Nix. The only thing that won't work is running tests inside this shell
# (although you can still build them). Fixing the test suite requires
# extensive patching of the test scripts (see `postPatch` below)
#
# Note that this will compile the library once without tests using Nix. This
# is due to the fact that `grpc-haskell`'s test suite cannot test code
# generation without the library being built at least once.
#
# If you want to build and test this repository using `nix`, you can run the
# following command:
#
# $ nix-build -A grpc-haskell release.nix
#
# ... but this is not recommended for normal development because this will
# rebuild the repository from scratch every time, which is extremely slow. Only
# do this if you want to exactly reproduce our continuous integration build.
#
# If you update the `grpc-haskell.cabal` file (such as changing dependencies or
# adding new library/executable/test/benchmark sections), then update the
# `default.nix` expression by running:
#
# $ cabal2nix . > default.nix
#
# By default, Nix will pick a version for each one of your Haskell dependencies.
# If you would like to select a different version then, run:
#
# $ cabal2nix cabal://${package-name}-${version} > nix/${package-name}.nix
#
# ... and then add this line below in the Haskell package overrides section:
#
# ${package-name} =
# haskellPackagesNew.callPackage ./nix/${package-name}.nix { };
#
# ... replacing `${package-name}` with the name of the package that you would
# like to upgrade and `${version}` with the version you want to upgrade to.
#
# You can also add private Git dependencies in the same way, except supplying
# the `git` URL to clone:
#
# $ cabal2nix <your private git url>/${package-name}.git > ./nix/${package-name}.nix
#
# ...but also be sure to supply `fetchgit = pkgs.fetchgitPrivate` in the
# `haskellPackagesNew.callPackage` invocation for your private package.
#
# Note that `cabal2nix` also takes an optional `--revision` flag if you want to
# pick a revision other than the latest to depend on.
#
# Finally, if you want to test a local source checkout of a dependency, then
# run:
#
# $ cabal2nix path/to/dependency/repo > nix/${package-name}.nix
let
nixpkgs = import ./nixpkgs.nix;
config = {
packageOverrides = pkgs: rec {
protobuf3_2NoCheck =
pkgs.stdenv.lib.overrideDerivation
pkgs.pythonPackages.protobuf3_2
(oldAttrs : {doCheck = false; doInstallCheck = false;});
cython = pkgs.pythonPackages.buildPythonPackage rec {
name = "Cython-${version}";
version = "0.24.1";
src = pkgs.fetchurl {
url = "mirror://pypi/C/Cython/${name}.tar.gz";
sha256 = "84808fda00508757928e1feadcf41c9f78e9a9b7167b6649ab0933b76f75e7b9";
};
# This workaround was taken from https://github.com/NixOS/nixpkgs/issues/18729
# This was fixed in `nixpkgs-unstable` so we can get rid of this workaround
# when that fix is stabilized
NIX_CFLAGS_COMPILE =
pkgs.stdenv.lib.optionalString (pkgs.stdenv.cc.isClang or false)
"-I${pkgs.libcxx}/include/c++/v1";
buildInputs =
pkgs.stdenv.lib.optional (pkgs.stdenv.cc.isClang or false) pkgs.libcxx
++ [ pkgs.pkgconfig pkgs.gdb ];
doCheck = false;
doHaddock = false;
doHoogle = false;
meta = {
description = "An optimising static compiler for both the Python programming language and the extended Cython programming language";
platforms = pkgs.stdenv.lib.platforms.all;
homepage = http://cython.org;
license = pkgs.stdenv.lib.licenses.asl20;
maintainers = with pkgs.stdenv.lib.maintainers; [ fridh ];
};
};
grpc = pkgs.callPackage ./nix/grpc.nix { };
grpcio = pkgs.pythonPackages.buildPythonPackage rec {
name = "grpc-${version}";
version = "1.0";
src = pkgs.fetchgit {
url = "https://github.com/grpc/grpc.git";
rev = "e2cfe9df79c4eda4e376222df064c4c65e616352";
sha256 = "19ldbjlnbc287hkaylsigm8w9fai2bjdbfxk6315kl75cq54iprr";
};
preConfigure = ''
export GRPC_PYTHON_BUILD_WITH_CYTHON=1
'';
# This workaround was taken from https://github.com/NixOS/nixpkgs/issues/18729
# This was fixed in `nixpkgs-unstable` so we can get rid of this workaround
# when that fix is stabilized
NIX_CFLAGS_COMPILE =
pkgs.stdenv.lib.optionalString (pkgs.stdenv.cc.isClang or false)
"-I${pkgs.libcxx}/include/c++/v1";
buildInputs =
pkgs.stdenv.lib.optional (pkgs.stdenv.cc.isClang or false) pkgs.libcxx;
propagatedBuildInputs = [
cython
pkgs.pythonPackages.futures
protobuf3_2NoCheck
pkgs.pythonPackages.enum34
];
};
grpcio-tools = pkgs.pythonPackages.buildPythonPackage rec {
name = "grpc-${version}";
version = "1.0";
src = pkgs.fetchgit {
url = "https://github.com/grpc/grpc.git";
rev = "e2cfe9df79c4eda4e376222df064c4c65e616352";
sha256 = "19ldbjlnbc287hkaylsigm8w9fai2bjdbfxk6315kl75cq54iprr";
};
preConfigure = ''
export GRPC_PYTHON_BUILD_WITH_CYTHON=1
cd tools/distrib/python/grpcio_tools
python ../make_grpcio_tools.py
'';
# This workaround was taken from https://github.com/NixOS/nixpkgs/issues/18729
# This was fixed in `nixpkgs-unstable` so we can get rid of this workaround
# when that fix is stabilized
NIX_CFLAGS_COMPILE =
pkgs.stdenv.lib.optionalString (pkgs.stdenv.cc.isClang or false)
"-I${pkgs.libcxx}/include/c++/v1";
buildInputs =
pkgs.stdenv.lib.optional (pkgs.stdenv.cc.isClang or false) pkgs.libcxx;
propagatedBuildInputs = [
cython
pkgs.pythonPackages.futures
protobuf3_2NoCheck
pkgs.pythonPackages.enum34
grpcio
];
};
usesGRPC = haskellPackage:
pkgs.haskell.lib.overrideCabal haskellPackage (oldAttributes: {
preBuild = (oldAttributes.preBuild or "") +
pkgs.lib.optionalString pkgs.stdenv.isDarwin ''
export DYLD_LIBRARY_PATH=${grpc}/lib''${DYLD_LIBRARY_PATH:+:}$DYLD_LIBRARY_PATH
'';
shellHook = (oldAttributes.shellHook or "") +
pkgs.lib.optionalString pkgs.stdenv.isDarwin ''
export DYLD_LIBRARY_PATH=${grpc}/lib''${DYLD_LIBRARY_PATH:+:}$DYLD_LIBRARY_PATH
'';
}
);
haskellPackages = pkgs.haskellPackages.override {
overrides = haskellPackagesNew: haskellPackagesOld: rec {
aeson =
pkgs.haskell.lib.dontCheck
(haskellPackagesNew.callPackage ./nix/aeson.nix {});
cabal-doctest =
haskellPackagesNew.callPackage ./nix/cabal-doctest.nix { };
insert-ordered-containers =
haskellPackagesNew.callPackage ./nix/insert-ordered-containers.nix { };
optparse-applicative =
haskellPackagesNew.callPackage ./nix/optparse-applicative.nix { };
optparse-generic =
haskellPackagesNew.callPackage ./nix/optparse-generic.nix { };
proto3-wire =
haskellPackagesNew.callPackage ./nix/proto3-wire.nix { };
proto3-suite =
pkgs.haskell.lib.dontCheck
(haskellPackagesNew.callPackage ./nix/proto3-suite.nix {});
grpc-haskell-core =
usesGRPC (haskellPackagesNew.callPackage ./core { });
grpc-haskell-no-tests =
usesGRPC
(pkgs.haskell.lib.dontCheck
(haskellPackagesNew.callPackage ./default.nix { })
);
grpc-haskell =
usesGRPC
(pkgs.haskell.lib.overrideCabal
(haskellPackagesNew.callPackage ./default.nix { })
(oldDerivation:
let
ghc =
haskellPackagesNew.ghcWithPackages (pkgs: [
pkgs.grpc-haskell-no-tests
# Include some additional packages in this custom ghc for
# running tests in the nix-shell environment.
pkgs.tasty-quickcheck
pkgs.turtle
]);
python = pkgs.python.withPackages (pkgs: [
# pkgs.protobuf3_0
grpcio-tools
]);
in rec {
buildDepends = [
pkgs.makeWrapper
# Give our nix-shell its own cabal so we don't pick up one
# from the user's environment by accident.
haskellPackagesNew.cabal-install
];
patches = [ tests/tests.patch ];
postPatch = ''
patchShebangs tests
substituteInPlace tests/simple-client.sh \
--replace @makeWrapper@ ${pkgs.makeWrapper} \
--replace @grpc@ ${grpc}
substituteInPlace tests/simple-server.sh \
--replace @makeWrapper@ ${pkgs.makeWrapper} \
--replace @grpc@ ${grpc}
wrapProgram tests/protoc.sh \
--prefix PATH : ${python}/bin
wrapProgram tests/test-client.sh \
--prefix PATH : ${python}/bin
wrapProgram tests/test-server.sh \
--prefix PATH : ${python}/bin
wrapProgram tests/simple-client.sh \
--prefix PATH : ${ghc}/bin
wrapProgram tests/simple-server.sh \
--prefix PATH : ${ghc}/bin
'';
shellHook = (oldDerivation.shellHook or "") + ''
# This lets us use our custom ghc and python environments in the shell.
export PATH=${ghc}/bin:${python}/bin''${PATH:+:}$PATH
'';
})
);
swagger2 =
pkgs.haskell.lib.dontCheck (pkgs.haskell.lib.dontHaddock (haskellPackagesNew.callPackage ./nix/swagger2.nix { }));
turtle =
haskellPackagesNew.callPackage ./nix/turtle.nix { };
};
};
};
allowUnfree = true;
};
in
let
linuxPkgs = import nixpkgs { inherit config; system = "x86_64-linux" ; };
darwinPkgs = import nixpkgs { inherit config; system = "x86_64-darwin"; };
pkgs = import nixpkgs { inherit config; };
in
{ grpc-haskell-linux = linuxPkgs.haskellPackages.grpc-haskell;
grpc-haskell-darwin = darwinPkgs.haskellPackages.grpc-haskell;
grpc-haskell = pkgs.haskellPackages.grpc-haskell;
grpc-haskell-no-tests = pkgs.haskellPackages.grpc-haskell-no-tests;
grpc-linux = linuxPkgs.grpc;
grpc-darwin = darwinPkgs.grpc;
grpc = pkgs.grpc;
}

16
nix/third-party/proto3-suite/.gitignore vendored
View File

@ -1,16 +0,0 @@
.stack-work/
.cabal-sandbox/
Setup.hs
cabal.sandbox.config
dist/
.stack-work/
result
*.pyc
# This should be auto-generated by protoc
test-files/test_proto_pb2.py
test-files/test_proto_import_pb2.py
# Auto-generated when creating test .bins
test-files/test_files/
*.hi
# Ignore Emacs backup files
*~

2
nix/third-party/proto3-suite/.travis.yml vendored
View File

@ -1,2 +0,0 @@
language: nix
script: nix-build --attr proto3-suite-linux release.nix

93
nix/third-party/proto3-suite/BUILD.bazel vendored
View File

@ -1,93 +0,0 @@
load("//bazel_tools:haskell.bzl", "da_haskell_binary", "da_haskell_library", "da_haskell_test")
da_haskell_library(
name = "proto3-suite",
srcs = glob(["src/**/*.hs"]),
hazel_deps = [
"aeson",
"aeson-pretty",
"attoparsec",
"base",
"base64-bytestring",
"bytestring",
"containers",
"deepseq",
"directory",
"filepath",
"foldl",
"haskell-src",
"lens",
"mtl",
"neat-interpolation",
"parsec",
"parsers",
"pretty",
"pretty-show",
"QuickCheck",
"safe",
"semigroups",
"swagger2",
"system-filepath",
"text",
"transformers",
"turtle",
"vector",
],
src_strip_prefix = "src",
visibility = ["//visibility:public"],
deps = [
"//nix/third-party/proto3-wire",
],
)
da_haskell_test(
name = "test",
srcs = glob([
"tests/Main.hs",
"tests/Arb*.hs",
"tests/Test*.hs",
]),
data = glob(["test-files/*"]),
hazel_deps = [
"base",
"QuickCheck",
"aeson",
"attoparsec",
"directory",
"base64-bytestring",
"bytestring",
"cereal",
"pretty-show",
"semigroups",
"tasty",
"tasty-hunit",
"tasty-quickcheck",
"text",
"transformers",
"turtle",
"vector",
],
src_strip_prefix = "test",
visibility = ["//visibility:public"],
deps = [
":proto3-suite",
"//nix/third-party/proto3-wire",
],
)
da_haskell_binary(
name = "compile-proto-file",
srcs = glob(["tools/compile-proto-file/*.hs"]),
hazel_deps = [
"base",
"turtle",
"text",
"optparse-generic",
"system-filepath",
],
src_strip_prefix = "tools/compile-proto-file",
visibility = ["//visibility:public"],
deps = [
":proto3-suite",
],
)

13
nix/third-party/proto3-suite/LICENSE vendored
View File

@ -1,13 +0,0 @@
Copyright 2017 Awake Networks
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

0
nix/third-party/proto3-suite/NO_AUTO_COPYRIGHT vendored
View File

7
nix/third-party/proto3-suite/README.DA vendored
View File

@ -1,7 +0,0 @@
This is the vendored library from github.com/awakesecurity/proto3-suite,
commit revision 94a87913eac90b38dec110b753f75476d6d33193.
For the Bazel based builds of this library some of the test cases needed
to be disabled as they invoked GHC from within the test, which in Bazel will not
have the proto3-suite/proto3-wire as a registered package.

154
nix/third-party/proto3-suite/README.md vendored
View File

@ -1,154 +0,0 @@
# `proto3-suite`
[![Build Status](https://travis-ci.org/awakesecurity/proto3-suite.svg?branch=master)](https://travis-ci.org/awakesecurity/proto3-suite)
This package defines tools for working with protocol buffers version 3 in Haskell.
This library provides a higher-level API to
[the `proto3-wire` library](https://github.com/awakenetworks/proto3-wire) that supports:
- Type classes for encoding and decoding messages, and instances for all
wire formats identified in the specification
- A higher-level approach to encoding and decoding, based on `GHC.Generics`
- A way of creating `.proto` files from Haskell types.
See the `Proto3.Suite.Tutorial` module for more details.
## Running the language interop tests
We test inter-language interop using protoc's built-in Python code generation. In
order to successfully run these tests, you'll need to install the google protobuf
Python library. It's best to create a virtualenv and then use pip to install the
right version (virtualenv is a python utility which can be installed with pip).
```bash
$ virtualenv pyenv
$ source pyenv/bin/activate
$ pip install protobuf==3.0.0b3 # Need the latest version for the newest protoc
```
`brew install python` may also work.
Alternately, the `nix-shell` environment provides an incremental build
environment (but see below for testing). From the root of this repository:
```bash
$ nix-shell release.nix -A proto3-suite-no-tests.env
[nix-shell]$ cabal configure
[nix-shell]$ cabal build
```
Once your source code compiles and you want to test, do this instead:
```bash
$ nix-shell release.nix -A proto3-suite.env
[nix-shell]$ cabal configure --enable-tests
[nix-shell]$ cabal build
[nix-shell]$ cabal test
```
The above steps will work only if your Haskell source compiles, because
some of the tests require the current `compile-proto-file` executable.
## `compile-proto-file` and `canonicalize-proto-file` installation
Run the following commmand from the root of this repository to install
the `compile-proto-file` and `canonicalize-proto-file` executables:
```bash
$ nix-env --install --attr proto3-suite -f release.nix
```
To remove it from your nix user profile path, use:
```bash
$ nix-env --uninstall proto3-suite
```
## `compile-proto-file` usage
```bash
$ compile-proto-file --help
Compiles a .proto file to a Haskell module
Usage: compile-proto-file --out FILEPATH [--includeDir FILEPATH]...
--proto FILEPATH
Available options:
-h,--help Show this help text
--out FILEPATH Output directory path where generated Haskell modules
will be written (directory is created if it does not
exist; note that files in the output directory may be
overwritten!)
--includeDir FILEPATH... Path to search for included .proto files (can be
repeated, and paths will be searched in order; the
current directory is used if this option is not
provided)
--proto FILEPATH Path to input .proto file
```
`compile-proto-file` bases the name (and hence, path) of the generated Haskell
module on the filename of the input `.proto` file, _relative_ to the include
path where it was found, snake-to-cameling as needed.
As an example, let's assume this is our current directory structure before
performing any code generation:
```
.
├── my_protos
│   └── my_package.proto
└── other_protos
└── google
└── protobuf
├── duration.proto
└── timestamp.proto
```
where `my_package.proto` is:
```
syntax = "proto3";
package some_package_name;
import "google/protobuf/timestamp.proto";
import "google/protobuf/duration.proto";
message MyMessage {
Timestamp timestamp = 1;
Duration duration = 2;
}
```
Then, after the following commands:
```bash
$ compile-proto-file --out gen --includeDir my_protos --includeDir other_protos --proto google/protobuf/duration.proto
$ compile-proto-file --out gen --includeDir my_protos --includeDir other_protos --proto google/protobuf/timestamp.proto
$ compile-proto-file --out gen --includeDir my_protos --includeDir other_protos --proto my_package.proto
```
the directory tree will look like this:
```
.
├── gen
│   ├── Google
│   │   └── Protobuf
│   │   ├── Duration.hs
│   │   └── Timestamp.hs
│   └── MyPackage.hs
├── my_protos
│   └── my_package.proto
└── other_protos
└── google
└── protobuf
├── duration.proto
└── timestamp.proto
```
Finally, note that delimiting `.` characters in the input `.proto` basename are
treated as `/` characters, so the input filenames
`google.protobuf.timestamp.proto` and `google/protobuf/timestamp.proto` would
produce the same generated Haskell module name and path.
This is essentially the same module naming scheme as the `protoc` Python plugin
uses when compiling `.proto` files.

34
nix/third-party/proto3-suite/default.nix vendored
View File

@ -1,34 +0,0 @@
{ mkDerivation, aeson, aeson-pretty, attoparsec, base
, base64-bytestring, bytestring, cereal, containers, deepseq
, doctest, foldl, haskell-src, lens, mtl, neat-interpolation
, optparse-generic, parsec, parsers, pretty, pretty-show
, proto3-wire, QuickCheck, range-set-list, safe, semigroups, stdenv
, swagger2, system-filepath, tasty, tasty-hunit, tasty-quickcheck
, text, transformers, turtle, vector
}:
mkDerivation {
pname = "proto3-suite";
version = "0.1.0.0";
src = ./.;
isLibrary = true;
isExecutable = true;
enableSeparateDataOutput = true;
libraryHaskellDepends = [
aeson aeson-pretty attoparsec base base64-bytestring bytestring
cereal containers deepseq foldl haskell-src lens mtl
neat-interpolation parsec parsers pretty pretty-show proto3-wire
QuickCheck safe semigroups swagger2 system-filepath text
transformers turtle vector
];
executableHaskellDepends = [
base containers optparse-generic proto3-wire range-set-list
system-filepath text turtle
];
testHaskellDepends = [
aeson attoparsec base base64-bytestring bytestring cereal doctest
pretty-show proto3-wire QuickCheck semigroups tasty tasty-hunit
tasty-quickcheck text transformers turtle vector
];
description = "A low level library for writing out data in the Protocol Buffers wire format";
license = stdenv.lib.licenses.asl20;
}

23
nix/third-party/proto3-suite/nix/proto3-wire.nix vendored
View File

@ -1,23 +0,0 @@
{ mkDerivation, base, bytestring, cereal, containers, deepseq
, doctest, fetchgit, hashable, QuickCheck, safe, stdenv, tasty
, tasty-hunit, tasty-quickcheck, text, unordered-containers
}:
mkDerivation {
pname = "proto3-wire";
version = "1.0.0";
src = fetchgit {
url = "https://github.com/awakenetworks/proto3-wire.git";
sha256 = "0nlar9zwy7k47nm395h11ivmhhfhip5bhyazwa2gnffn5lhsyv3i";
rev = "d492fa3034724b46f23fb2c73780c9dd7ecb4d04";
};
libraryHaskellDepends = [
base bytestring cereal containers deepseq hashable QuickCheck safe
text unordered-containers
];
testHaskellDepends = [
base bytestring cereal doctest QuickCheck tasty tasty-hunit
tasty-quickcheck text
];
description = "A low-level implementation of the Protocol Buffers (version 3) wire format";
license = stdenv.lib.licenses.asl20;
}

27
nix/third-party/proto3-suite/nix/swagger2.nix vendored
View File

@ -1,27 +0,0 @@
{ mkDerivation, aeson, aeson-qq, base, base-compat, bytestring
, Cabal, cabal-doctest, containers, doctest, generics-sop, Glob
, hashable, hspec, http-media, HUnit, insert-ordered-containers
, lens, mtl, network, QuickCheck, scientific, stdenv
, template-haskell, text, time, transformers, transformers-compat
, unordered-containers, uuid-types, vector
}:
mkDerivation {
pname = "swagger2";
version = "2.1.6";
sha256 = "01a29h56vfyw0ilij1pn6qwy50ca90kyj884vs1q52vvh572758j";
setupHaskellDepends = [ base Cabal cabal-doctest ];
libraryHaskellDepends = [
aeson base base-compat bytestring containers generics-sop hashable
http-media insert-ordered-containers lens mtl network scientific
template-haskell text time transformers transformers-compat
unordered-containers uuid-types vector
];
testHaskellDepends = [
aeson aeson-qq base base-compat bytestring containers doctest Glob
hashable hspec HUnit insert-ordered-containers lens mtl QuickCheck
text time unordered-containers vector
];
homepage = "https://github.com/GetShopTV/swagger2";
description = "Swagger 2.0 data model";
license = stdenv.lib.licenses.bsd3;
}

12
nix/third-party/proto3-suite/nixpkgs/17_09.nix vendored
View File

@ -1,12 +0,0 @@
# Given a Git revision hash `<rev>`, you get the new SHA256 by running:
#
# ```bash
# $ nix-prefetch-url "https://github.com/NixOS/nixpkgs/archive/<rev>.tar.gz"
# ```
#
# The SHA256 will be printed as the last line of stdout.
import ./fetch-nixpkgs.nix {
rev = "74286ec9e76be7cd00c4247b9acb430c4bd9f1ce";
sha256 = "0njb3qd2wxj7gil8y61lwh7zacmvr6zklv67w5zmvifi1fvalvdg";
}

51
nix/third-party/proto3-suite/nixpkgs/fetch-nixpkgs.nix vendored
View File

@ -1,51 +0,0 @@
{ rev # The Git revision of nixpkgs to fetch
, sha256 # The SHA256 of the downloaded data
, system ? builtins.currentSystem # This is overridable if necessary
}:
with {
ifThenElse = { bool, thenValue, elseValue }: (
if bool then thenValue else elseValue);
};
ifThenElse {
bool = (0 <= builtins.compareVersions builtins.nixVersion "1.12");
# In Nix 1.12, we can just give a `sha256` to `builtins.fetchTarball`.
thenValue = (
builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
inherit sha256;
});
# This hack should at least work for Nix 1.11
elseValue = (
(rec {
tarball = import <nix/fetchurl.nix> {
url = "https://github.com/NixOS/nixpkgs/archive/${rev}.tar.gz";
inherit sha256;
};
builtin-paths = import <nix/config.nix>;
script = builtins.toFile "nixpkgs-unpacker" ''
"$coreutils/mkdir" "$out"
cd "$out"
"$gzip" --decompress < "$tarball" | "$tar" -x --strip-components=1
'';
nixpkgs = builtins.derivation {
name = "nixpkgs-${builtins.substring 0 6 rev}";
builder = builtins.storePath builtin-paths.shell;
args = [ script ];
inherit tarball system;
tar = builtins.storePath builtin-paths.tar;
gzip = builtins.storePath builtin-paths.gzip;
coreutils = builtins.storePath builtin-paths.coreutils;
};
}).nixpkgs);
}

98
nix/third-party/proto3-suite/proto3-suite.cabal vendored
View File

@ -1,98 +0,0 @@
name: proto3-suite
version: 0.1.0.0
synopsis: A low level library for writing out data in the Protocol Buffers wire format
license: Apache-2.0
author: Awake Networks
maintainer: opensource@awakenetworks.com
copyright: 2017 Awake Networks
category: Codec
build-type: Simple
cabal-version: >=1.10
data-files: test-files/*.bin tests/encode.sh tests/decode.sh
library
exposed-modules: Proto3.Suite
Proto3.Suite.Class
Proto3.Suite.DotProto
Proto3.Suite.DotProto.Generate
Proto3.Suite.DotProto.AST
Proto3.Suite.DotProto.Parsing
Proto3.Suite.DotProto.Rendering
Proto3.Suite.JSONPB
Proto3.Suite.Tutorial
Proto3.Suite.Types
other-modules: Proto3.Suite.DotProto.Internal
Proto3.Suite.DotProto.Generate.Swagger
Proto3.Suite.JSONPB.Class
build-depends: aeson,
aeson-pretty,
attoparsec >= 0.13.0.1,
base >=4.8 && <5.0,
base64-bytestring >= 1.0.0.1 && < 1.1,
bytestring >=0.10.6.0 && <0.11.0,
containers >= 0.5,
deepseq ==1.4.*,
foldl,
haskell-src ==1.0.*,
lens,
mtl ==2.2.*,
neat-interpolation,
parsec >= 3.1.9 && <3.2.0,
parsers >= 0.12 && <0.13,
pretty ==1.1.*,
pretty-show,
proto3-wire == 1.0.*,
QuickCheck,
safe ==0.3.*,
semigroups ==0.18.*,
swagger2,
system-filepath,
text >= 0.2 && <1.3,
transformers >=0.4 && <0.6,
turtle,
filepath,
directory,
vector >=0.11 && < 0.13
hs-source-dirs: src
default-language: Haskell2010
ghc-options: -O2 -Wall
test-suite tests
type: exitcode-stdio-1.0
main-is: Main.hs
other-modules: TestProto
TestCodeGen
hs-source-dirs: tests
default-language: Haskell2010
build-depends: base >=4.8 && <5.0,
QuickCheck >=2.8 && <2.10,
aeson >= 1.1.1.0 && < 1.2,
attoparsec >= 0.13.0.1,
base >=4.8 && <5.0,
base64-bytestring >= 1.0.0.1 && < 1.1,
bytestring >=0.10.6.0 && <0.11.0,
cereal >= 0.5.1 && <0.6,
doctest,
pretty-show,
proto3-suite,
proto3-wire == 1.0.*,
semigroups ==0.18.*,
tasty >= 0.11 && <0.12,
tasty-hunit >= 0.9 && <0.10,
tasty-quickcheck >= 0.8.4 && <0.9,
text >= 0.2 && <1.3,
transformers >=0.4 && <0.6,
turtle,
vector >=0.11 && < 0.13
executable compile-proto-file
main-is: Main.hs
hs-source-dirs: tools/compile-proto-file
default-language: Haskell2010
build-depends: base >=4.8 && <5.0
, optparse-generic
, proto3-suite
, system-filepath
, text
, turtle

93
nix/third-party/proto3-suite/release.nix vendored
View File

@ -1,93 +0,0 @@
# To develop iteratively within this repository, open a Nix shell via:
#
# $ nix-shell -A proto3-suite.env release.nix
#
# ... and then use `cabal` to build and test:
#
# [nix-shell]$ cabal configure --enable-tests
# [nix-shell]$ cabal build
# [nix-shell]$ cabal test
let
nixpkgs = import ./nixpkgs/17_09.nix;
config = {
allowUnfree = true;
packageOverrides = pkgs: {
haskellPackages = pkgs.haskellPackages.override {
overrides = self: super: rec {
# The test suite for proto3-suite requires:
#
# - a GHC with `proto3-suite` installed, since our code generation
# tests compile and run generated code; since this custom GHC is
# also used inside the nix-shell environment for iterative
# development, we ensure that it is available on $PATH and that
# all test suite deps are available to it
#
# - a Python interpreter with a protobuf package installed, which we
# use as a reference implementation; we also put expose this on
# the `nix-shell` $PATH
#
# Finally, we make `cabal` available in the `nix-shell`, intentionally
# occluding any globally-installed versions of the tool.
proto3-suite =
pkgs.haskell.lib.overrideCabal
(self.callPackage ./default.nix { })
(drv:
let
python = pkgs.python.withPackages (pkgs: [ pkgs.protobuf3_0 ]);
in
{
shellHook = (drv.shellHook or "") +
(let
ghc = self.ghcWithPackages (pkgs:
drv.testHaskellDepends ++ [ pkgs.proto3-suite-boot ]
);
in ''
export PATH=${self.cabal-install}/bin:${ghc}/bin:${python}/bin''${PATH:+:}$PATH
'');
testHaskellDepends = drv.testHaskellDepends ++ [
pkgs.ghc
proto3-suite-boot
python
];
}
);
# A proto3-suite sans tests, for bootstrapping
proto3-suite-boot =
pkgs.haskell.lib.overrideCabal
(self.callPackage ./default.nix { })
(_: {
configureFlags = [ "--disable-optimization" ];
doCheck = false;
doHaddock = false;
});
proto3-wire =
self.callPackage ./nix/proto3-wire.nix { };
swagger2 =
pkgs.haskell.lib.dontCheck
(pkgs.haskell.lib.dontHaddock
(self.callPackage ./nix/swagger2.nix { }));
};
};
};
};
in
let
linuxPkgs = import nixpkgs { inherit config; system = "x86_64-linux" ; };
darwinPkgs = import nixpkgs { inherit config; system = "x86_64-darwin"; };
pkgs = import nixpkgs { inherit config; };
in
{ proto3-suite-linux = linuxPkgs.haskellPackages.proto3-suite;
proto3-suite-darwin = darwinPkgs.haskellPackages.proto3-suite;
proto3-suite = pkgs.haskellPackages.proto3-suite;
proto3-suite-no-tests = pkgs.haskellPackages.proto3-suite-no-tests;
}

57
nix/third-party/proto3-suite/src/Proto3/Suite.hs vendored
View File

@ -1,57 +0,0 @@
-- |
-- = Protocol Buffers v3 for Haskell
--
-- This package defines tools for working with protocol buffers version 3 in
-- Haskell.
--
-- Specifically, it provides:
--
-- * Low-level functions for encoding and decoding messages
-- * Type classes for encoding and decoding messages, and instances for all
-- wire formats identified in the specification
-- * A higher-level approach to encoding and decoding, based on "GHC.Generics"
-- * A way of creating .proto files from Haskell types.
--
-- See the "Proto3.Suite.Tutorial" module for more details.
{-# LANGUAGE ExplicitNamespaces #-}
module Proto3.Suite
(
-- * Message Encoding/Decoding
toLazyByteString
, fromByteString
, fromB64
, Message(..)
, MessageField(..)
, Primitive(..)
, HasDefault(..)
, FieldNumber(..)
, fieldNumber
-- * Documentation
, message
, enum
, RenderingOptions(..)
, Named(..)
, Finite(..)
-- * Wire Formats
, Fixed(..)
, Signed(..)
, Enumerated(..)
, Nested(..)
, UnpackedVec(..)
, PackedVec(..)
, NestedVec(..)
, Commented(..)
, type (//)()
-- * AST
, module DotProto
) where
import Proto3.Suite.Class
import Proto3.Suite.DotProto as DotProto
import Proto3.Suite.Types
import Proto3.Wire.Types

666
nix/third-party/proto3-suite/src/Proto3/Suite/Class.hs vendored
View File

@ -1,666 +0,0 @@
-- | This module provides type classes for encoding and decoding protocol
-- buffers message, as well as a safer alternative to the raw 'Proto3.Wire'
-- library based on 'GHC.Generics'.
--
-- = Classes
--
-- The 'Primitive' class captures those types which correspond to primitive field
-- types, as defined by the protocol buffers specification. A 'Primitive' type is
-- one which can always be encoded as a single key/value pair in the wire format.
--
-- The 'MessageField' class captures those types which are encoded under a single
-- key in the wire format, i.e. primitives, packed and unpacked lists, and
-- embedded messages.
--
-- The 'Message' class captures types which correspond to protocol buffers messages.
-- Instances of 'Message' can be written by hand for your types by using the
-- functions in the 'Proto3.Suite.Encode' and 'Proto3.Suite.Decode'
-- modules. In the case where the message format is determined by your Haskell code,
-- you might prefer to derive your 'Message' instances using generic deriving.
--
-- = Generic Instances
--
-- Using the 'GHC.Generics' approach, instead of generating Haskell code from a
-- .proto file, we write our message formats as Haskell types, and generate a
-- serializer/deserializer pair.
--
-- To use this library, simply derive a 'Generic' instance for your type(s), and
-- use the default `Message` instance.
--
-- For generic 'Message' instances, field numbers are automatically generated,
-- starting at 1. Therefore, adding new fields is a compatible change only at the
-- end of a record. Renaming fields is also safe. You should not use the generic
-- instances if you are starting from an existing .proto file.
--
-- = Strings
--
-- Use 'TL.Text' instead of 'String' for string types inside messages.
--
-- = Example
--
-- > data MultipleFields =
-- > MultipleFields { multiFieldDouble :: Double
-- > , multiFieldFloat :: Float
-- > , multiFieldInt32 :: Int32
-- > , multiFieldInt64 :: Int64
-- > , multiFieldString :: TL.Text
-- > , multiFieldBool :: Bool
-- > } deriving (Show, Generic, Eq)
-- >
-- > instance Message MultipleFields
-- >
-- > serialized = toLazyByteString $ MultipleFields 1.0 1.0 1 1 "hi" True
-- >
-- > deserialized :: MultipleFields
-- > deserialized = case parse (toStrict serialized) of
-- > Left e -> error e
-- > Right msg -> msg
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Proto3.Suite.Class
( Primitive(..)
, MessageField(..)
, Message(..)
-- * Encoding
, toLazyByteString
-- * Decoding
, HasDefault(..)
, fromByteString
, fromB64
-- * Documentation
, Named(..)
, Finite(..)
, message
, Proto3.Suite.Class.enum
-- * Generic Classes
, GenericMessage(..)
) where
import Control.Applicative (liftA2)
import Control.Monad
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BL
import qualified Data.Foldable as F
import Data.Functor (($>))
import Data.Int (Int32, Int64)
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid ((<>))
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Traversable as TR
import Data.Vector (Vector)
import Data.Word (Word32, Word64)
import GHC.Exts (fromList)
import GHC.Generics
import GHC.TypeLits
import Proto3.Suite.DotProto as DotProto
import Proto3.Suite.Types as Wire
import Proto3.Wire
import Proto3.Wire.Decode (ParseError, Parser (..), RawField,
RawMessage, RawPrimitive, runParser)
import qualified Proto3.Wire.Decode as Decode
import qualified Proto3.Wire.Encode as Encode
import Safe (toEnumMay)
-- | A class for types with default values per the protocol buffers spec.
class HasDefault a where
-- | The default value for this type.
def :: a
-- | Numeric types default to zero
default def :: Num a => a
def = 0
isDefault :: a -> Bool
default isDefault :: Eq a => a -> Bool
isDefault = (== def)
-- | Do not encode the default value
omittingDefault
:: HasDefault a
=> (a -> Encode.MessageBuilder)
-> a
-> Encode.MessageBuilder
omittingDefault f p
| isDefault p = mempty
| otherwise = f p
instance HasDefault Int32
instance HasDefault Int64
instance HasDefault Word32
instance HasDefault Word64
instance HasDefault (Signed Int32)
instance HasDefault (Signed Int64)
instance HasDefault (Fixed Word32)
instance HasDefault (Fixed Word64)
instance HasDefault (Signed (Fixed Int32))
instance HasDefault (Signed (Fixed Int64))
instance HasDefault Float
instance HasDefault Double
instance HasDefault Bool where
def = False
instance HasDefault T.Text where
def = mempty
instance HasDefault TL.Text where
def = mempty
instance HasDefault B.ByteString where
def = mempty
instance HasDefault BL.ByteString where
def = mempty
instance (Bounded e, Enum e) => HasDefault (Enumerated e) where
def =
case toEnumMay 0 of
Nothing -> Enumerated (Left 0)
Just x -> Enumerated (Right x)
isDefault = (== 0) . either id fromEnum . enumerated
instance HasDefault (UnpackedVec a) where
def = mempty
isDefault = null . unpackedvec
instance HasDefault (PackedVec a) where
def = mempty
isDefault = null . packedvec
instance HasDefault (NestedVec a) where
def = mempty
isDefault = null . nestedvec
instance HasDefault (Nested a) where
def = Nested Nothing
isDefault = isNothing . nested
instance (HasDefault a) => HasDefault (ForceEmit a) where
def = ForceEmit def
isDefault = isDefault . forceEmit
-- | Used in fields of generated records to represent an unwrapped
-- 'PackedVec'/'UnpackedVec'
instance HasDefault (Vector a) where
def = mempty
isDefault = null
-- | Used in generated records to represent an unwrapped 'Nested'
instance HasDefault (Maybe a) where
def = Nothing
isDefault = isNothing
-- TODO: Determine if we have a reason for rendering fixed32/sfixed as Fixed
-- Word32/Int32 in generated datatypes; for other field types, we omit the
-- newtype wrappers in the type signature but un/wrap them as needed in the
-- encode/decodeMessage implementations. These Fixed wrappers can probably be
-- removed and the type interface would be more consistent with other types, but
-- until that occurs, the following two instances are needed.
--
-- Tracked by https://github.com/awakesecurity/proto3-suite/issues/30.
-- | Used in generated records to represent @sfixed32@
instance HasDefault (Fixed Int32)
-- | Used in generated records to represent @sfixed64@
instance HasDefault (Fixed Int64)
-- | This class captures those types whose names need to appear in .proto files.
--
-- It has a default implementation for any data type which is an instance of the
-- 'Generic' class, which will extract the name of the type constructor.
class Named a where
-- | Get the name of a type constructor
nameOf :: IsString string => Proxy a -> string
default nameOf :: (IsString string, GenericNamed (Rep a)) => Proxy a -> string
nameOf _ = genericNameOf (Proxy @(Rep a))
class GenericNamed (f :: * -> *) where
genericNameOf :: IsString string => Proxy f -> string
instance Datatype d => GenericNamed (M1 D d f) where
genericNameOf _ = fromString (datatypeName (undefined :: M1 D d f ()))
-- | Enumerable types with finitely many values.
--
-- This class can be derived whenever a sum type is an instance of 'Generic',
-- and only consists of zero-argument constructors. The derived instance should
-- be compatible with derived `Enum` instances, in the sense that
--
-- > map (toEnum . fst) enumerate
--
-- should enumerate all values of the type without runtime errors.
class Enum a => Finite a where
-- | Enumerate values of a finite type, along with names of constructors.
enumerate :: IsString string => Proxy a -> [(string, Int)]
default enumerate :: (IsString string, GenericFinite (Rep a)) => Proxy a -> [(string, Int)]
enumerate _ = snd (genericEnumerate (Proxy @(Rep a)) 0)
-- | Generate metadata for an enum type.
enum :: (Finite e, Named e) => Proxy e -> DotProtoDefinition
enum pr = DotProtoEnum (Single $ nameOf pr) (map enumField $ enumerate pr)
where
enumField (name, value) = DotProtoEnumField (Single name) value []
class GenericFinite (f :: * -> *) where
genericEnumerate :: IsString string => Proxy f -> Int -> (Int, [(string, Int)])
instance ( GenericFinite f
, GenericFinite g
) => GenericFinite (f :+: g) where
genericEnumerate _ i =
let (j, e1) = genericEnumerate (Proxy @f) i
(k, e2) = genericEnumerate (Proxy @g) j
in (k, e1 <> e2)
instance Constructor c => GenericFinite (M1 C c f) where
genericEnumerate _ i = (i + 1, [ (fromString name, i) ])
where
name = conName (undefined :: M1 C c f ())
instance GenericFinite f => GenericFinite (M1 D t f) where
genericEnumerate _ = genericEnumerate (Proxy @f)
instance GenericFinite f => GenericFinite (M1 S t f) where
genericEnumerate _ = genericEnumerate (Proxy @f)
-- | This class captures those types which correspond to primitives in
-- the protocol buffers specification.
--
-- It should be possible to fully reconstruct values of these types from
-- a single 'RawPrimitive'. Notably, then, `Nested` is not `Primitive` even
-- though it can be 'embedded', since a nested message may by split up over
-- multiple 'embedded' fields.
class Primitive a where
-- | Encode a primitive value
encodePrimitive :: FieldNumber -> a -> Encode.MessageBuilder
-- | Decode a primitive value
decodePrimitive :: Parser RawPrimitive a
-- | Get the type which represents this type inside another message.
primType :: Proxy a -> DotProtoPrimType
default primType :: Named a => Proxy a -> DotProtoPrimType
primType pr = Named (Single (nameOf pr))
-- | Serialize a message as a lazy 'BL.ByteString'.
toLazyByteString :: Message a => a -> BL.ByteString
toLazyByteString = Encode.toLazyByteString . encodeMessage (fieldNumber 1)
-- | Parse any message that can be decoded.
fromByteString :: Message a => B.ByteString -> Either ParseError a
fromByteString = Decode.parse (decodeMessage (fieldNumber 1))
-- | As 'fromByteString', except the input bytestring is base64-encoded.
fromB64 :: Message a => B.ByteString -> Either ParseError a
fromB64 = fromByteString . B64.decodeLenient
instance Primitive Int32 where
encodePrimitive = Encode.int32
decodePrimitive = Decode.int32
primType _ = Int32
instance Primitive Int64 where
encodePrimitive = Encode.int64
decodePrimitive = Decode.int64
primType _ = Int64
instance Primitive Word32 where
encodePrimitive = Encode.uint32
decodePrimitive = Decode.uint32
primType _ = UInt32
instance Primitive Word64 where
encodePrimitive = Encode.uint64
decodePrimitive = Decode.uint64
primType _ = UInt64
instance Primitive (Signed Int32) where
encodePrimitive num = Encode.sint32 num . signed
decodePrimitive = fmap Signed Decode.sint32
primType _ = SInt32
instance Primitive (Signed Int64) where
encodePrimitive num = Encode.sint64 num . signed
decodePrimitive = fmap Signed Decode.sint64
primType _ = SInt64
instance Primitive (Fixed Word32) where
encodePrimitive num = Encode.fixed32 num . fixed
decodePrimitive = fmap Fixed Decode.fixed32
primType _ = DotProto.Fixed32
instance Primitive (Fixed Word64) where
encodePrimitive num = Encode.fixed64 num . fixed
decodePrimitive = fmap Fixed Decode.fixed64
primType _ = DotProto.Fixed64
instance Primitive (Signed (Fixed Int32)) where
encodePrimitive num = Encode.sfixed32 num . fixed . signed
decodePrimitive = fmap (Signed . Fixed) Decode.sfixed32
primType _ = SFixed32
instance Primitive (Signed (Fixed Int64)) where
encodePrimitive num = Encode.sfixed64 num . fixed . signed
decodePrimitive = fmap (Signed . Fixed) Decode.sfixed64
primType _ = SFixed64
instance Primitive Bool where
encodePrimitive = Encode.enum
decodePrimitive = Decode.bool
primType _ = Bool
instance Primitive Float where
encodePrimitive = Encode.float
decodePrimitive = Decode.float
primType _ = Float
instance Primitive Double where
encodePrimitive = Encode.double
decodePrimitive = Decode.double
primType _ = Double
instance Primitive T.Text where
encodePrimitive fn = Encode.text fn . TL.fromStrict
decodePrimitive = fmap TL.toStrict Decode.text
primType _ = String
instance Primitive TL.Text where
encodePrimitive = Encode.text
decodePrimitive = Decode.text
primType _ = String
instance Primitive B.ByteString where
encodePrimitive = Encode.byteString
decodePrimitive = Decode.byteString
primType _ = Bytes
instance Primitive BL.ByteString where
encodePrimitive = Encode.lazyByteString
decodePrimitive = Decode.lazyByteString
primType _ = Bytes
instance forall e. (Bounded e, Named e, Enum e) => Primitive (Enumerated e) where
encodePrimitive num = Encode.enum num . enumify . enumerated
where enumify (Left i) = i
enumify (Right x) = fromEnum x
decodePrimitive = fmap Enumerated Decode.enum
primType _ = Named (Single (nameOf (Proxy @e)))
instance (Primitive a) => Primitive (ForceEmit a) where
encodePrimitive num = encodePrimitive num . forceEmit
decodePrimitive = fmap ForceEmit decodePrimitive
primType _ = primType (Proxy @a)
-- | This class captures those types which can appear as message fields in
-- the protocol buffers specification, i.e. 'Primitive' types, or lists of
-- 'Primitive' types
class MessageField a where
-- | Encode a message field
encodeMessageField :: FieldNumber -> a -> Encode.MessageBuilder
-- | Decode a message field
decodeMessageField :: Parser RawField a
default encodeMessageField :: (HasDefault a, Primitive a) => FieldNumber -> a -> Encode.MessageBuilder
encodeMessageField num x
| isDefault x = mempty
| otherwise = encodePrimitive num x
default decodeMessageField :: (HasDefault a, Primitive a) => Parser RawField a
decodeMessageField = one decodePrimitive def
-- | Get the type which represents this type inside another message.
protoType :: Proxy a -> DotProtoField
default protoType :: Primitive a => Proxy a -> DotProtoField
protoType p = messageField (Prim $ primType p) Nothing
messageField :: DotProtoType -> Maybe DotProto.Packing -> DotProtoField
messageField ty packing = DotProtoField (fieldNumber 1) ty Anonymous
(case packing of
(Just DotProto.PackedField) -> [DotProtoOption (Single "packed") (BoolLit True)]
(Just DotProto.UnpackedField) -> [DotProtoOption (Single "packed") (BoolLit False)]
Nothing -> [])
Nothing
-- [todo] what were these intended for?
-- primDotProto :: DotProtoMessagePart -> DotProtoDefinition
-- primDotProto field = DotProtoMessage generateMessagePartName [ field ]
-- generateMessagePartName :: DotProtoIdentifier
-- generateMessagePartName = Single ""
instance MessageField Int32
instance MessageField Int64
instance MessageField Word32
instance MessageField Word64
instance MessageField (Signed Int32)
instance MessageField (Signed Int64)
instance MessageField (Fixed Word32)
instance MessageField (Fixed Word64)
instance MessageField (Signed (Fixed Int32))
instance MessageField (Signed (Fixed Int64))
instance MessageField Bool
instance MessageField Float
instance MessageField Double
instance MessageField T.Text
instance MessageField TL.Text
instance MessageField B.ByteString
instance MessageField BL.ByteString
instance (Bounded e, Named e, Enum e) => MessageField (Enumerated e)
instance (HasDefault a, Primitive a) => MessageField (ForceEmit a) where
encodeMessageField = encodePrimitive
instance (Named a, Message a) => MessageField (Nested a) where
encodeMessageField num = foldMap (Encode.embedded num . encodeMessage (fieldNumber 1)) . nested
decodeMessageField = fmap Nested (Decode.embedded (decodeMessage (fieldNumber 1)))
protoType _ = messageField (Prim $ Named (Single (nameOf (Proxy @a)))) Nothing
instance Primitive a => MessageField (UnpackedVec a) where
encodeMessageField fn = foldMap (encodePrimitive fn)
decodeMessageField = fmap (UnpackedVec . fromList) $ repeated decodePrimitive
protoType _ = messageField (Repeated $ primType (Proxy @a)) (Just DotProto.UnpackedField)
instance forall a. (Named a, Message a) => MessageField (NestedVec a) where
encodeMessageField fn = foldMap (Encode.embedded fn . encodeMessage (fieldNumber 1))
. nestedvec
decodeMessageField = fmap (NestedVec . fromList)
(repeated (Decode.embedded' oneMsg))
where
oneMsg :: Parser RawMessage a
oneMsg = decodeMessage (fieldNumber 1)
protoType _ = messageField (NestedRepeated (Named (Single (nameOf (Proxy @a))))) Nothing
instance (Bounded e, Enum e, Named e) => MessageField (PackedVec (Enumerated e)) where
encodeMessageField fn = omittingDefault (Encode.packedVarints fn) . foldMap omit
where
-- omit values which are outside the enum range
omit :: Enumerated e -> PackedVec Word64
omit (Enumerated (Right e)) = pure . fromIntegral . fromEnum $ e
omit _ = mempty
decodeMessageField = decodePacked (foldMap retain <$> Decode.packedVarints @Word64)
where
-- retain only those values which are inside the enum range
retain = foldMap (pure . Enumerated. Right) . toEnumMay . fromIntegral
protoType _ = messageField (Repeated (Named (Single (nameOf (Proxy @e))))) (Just DotProto.PackedField)
instance MessageField (PackedVec Bool) where
encodeMessageField fn = omittingDefault (Encode.packedVarints fn) . fmap fromBool
where
fromBool False = 0
fromBool True = 1
decodeMessageField = fmap (fmap toBool) (decodePacked Decode.packedVarints)
where
toBool :: Word64 -> Bool
toBool 1 = True
toBool _ = False
protoType _ = messageField (Repeated Bool) (Just DotProto.PackedField)
instance MessageField (PackedVec Word32) where
encodeMessageField fn = omittingDefault (Encode.packedVarints fn) . fmap fromIntegral
decodeMessageField = decodePacked Decode.packedVarints
protoType _ = messageField (Repeated UInt32) (Just DotProto.PackedField)
instance MessageField (PackedVec Word64) where
encodeMessageField fn = omittingDefault (Encode.packedVarints fn) . fmap fromIntegral
decodeMessageField = decodePacked Decode.packedVarints
protoType _ = messageField (Repeated UInt64) (Just DotProto.PackedField)
instance MessageField (PackedVec Int32) where
encodeMessageField fn = omittingDefault (Encode.packedVarints fn) . fmap fromIntegral
decodeMessageField = decodePacked Decode.packedVarints
protoType _ = messageField (Repeated Int32) (Just DotProto.PackedField)
instance MessageField (PackedVec Int64) where
encodeMessageField fn = omittingDefault (Encode.packedVarints fn) . fmap fromIntegral
decodeMessageField = decodePacked Decode.packedVarints
protoType _ = messageField (Repeated Int64) (Just DotProto.PackedField)
instance MessageField (PackedVec (Fixed Word32)) where
encodeMessageField fn = omittingDefault (Encode.packedFixed32 fn) . fmap fixed
decodeMessageField = fmap (fmap Fixed) (decodePacked Decode.packedFixed32)
protoType _ = messageField (Repeated DotProto.Fixed32) (Just DotProto.PackedField)
instance MessageField (PackedVec (Fixed Word64)) where
encodeMessageField fn = omittingDefault (Encode.packedFixed64 fn) . fmap fixed
decodeMessageField = fmap (fmap Fixed) (decodePacked Decode.packedFixed64)
protoType _ = messageField (Repeated DotProto.Fixed64) (Just DotProto.PackedField)
instance MessageField (PackedVec (Signed (Fixed Int32))) where
encodeMessageField fn = omittingDefault (Encode.packedFixed32 fn) . fmap (fromIntegral . fixed . signed)
decodeMessageField = fmap (fmap (Signed . Fixed)) (decodePacked Decode.packedFixed32)
protoType _ = messageField (Repeated SFixed32) (Just DotProto.PackedField)
instance MessageField (PackedVec (Signed (Fixed Int64))) where
encodeMessageField fn = omittingDefault (Encode.packedFixed64 fn) . fmap (fromIntegral . fixed . signed)
decodeMessageField = fmap (fmap (Signed . Fixed)) (decodePacked Decode.packedFixed64)
protoType _ = messageField (Repeated SFixed64) (Just DotProto.PackedField)
instance MessageField (PackedVec Float) where
encodeMessageField fn = omittingDefault (Encode.packedFloats fn)
decodeMessageField = decodePacked Decode.packedFloats
protoType _ = messageField (Repeated Float) (Just DotProto.PackedField)
instance MessageField (PackedVec Double) where
encodeMessageField fn = omittingDefault (Encode.packedDoubles fn)
decodeMessageField = decodePacked Decode.packedDoubles
protoType _ = messageField (Repeated Double) (Just DotProto.PackedField)
instance (MessageField e, KnownSymbol comments) => MessageField (e // comments) where
encodeMessageField fn = encodeMessageField fn . unCommented
decodeMessageField = fmap Commented decodeMessageField
protoType p = (protoType (lowerProxy1 p))
{ dotProtoFieldComment = Just (symbolVal (lowerProxy2 p)) }
where
lowerProxy1 :: forall f (a :: k). Proxy (f a) -> Proxy a
lowerProxy1 _ = Proxy
lowerProxy2 :: forall f (a :: k) b. Proxy (f a b) -> Proxy a
lowerProxy2 _ = Proxy
decodePacked
:: Parser RawPrimitive [a]
-> Parser RawField (PackedVec a)
decodePacked p = Parser $ \fs -> fmap (fromList . join . F.toList) $ TR.sequence $ fmap (runParser p) fs
-- | This class captures those types which correspond to protocol buffer messages.
class Message a where
-- | Encode a message
encodeMessage :: FieldNumber -> a -> Encode.MessageBuilder
-- | Decode a message
decodeMessage :: FieldNumber -> Parser RawMessage a
-- | Generate a .proto message from the type information.
dotProto :: Proxy a -> [DotProtoField]
default encodeMessage :: (Generic a, GenericMessage (Rep a)) => FieldNumber -> a -> Encode.MessageBuilder
encodeMessage num = genericEncodeMessage num . from
default decodeMessage :: (Generic a, GenericMessage (Rep a)) => FieldNumber -> Parser RawMessage a
decodeMessage = (fmap to .) genericDecodeMessage
default dotProto :: GenericMessage (Rep a) => Proxy a -> [DotProtoField]
dotProto _ = genericDotProto (Proxy @(Rep a))
-- | Generate metadata for a message type.
message :: (Message a, Named a) => Proxy a -> DotProtoDefinition
message pr = DotProtoMessage (Single $ nameOf pr) $ DotProtoMessageField <$> (dotProto pr)
-- * Generic Instances
class GenericMessage (f :: * -> *) where
type GenericFieldCount f :: Nat
genericEncodeMessage :: FieldNumber -> f a -> Encode.MessageBuilder
genericDecodeMessage :: FieldNumber -> Parser RawMessage (f a)
genericDotProto :: Proxy f -> [DotProtoField]
instance GenericMessage U1 where
type GenericFieldCount U1 = 0
genericEncodeMessage _ = mempty
genericDecodeMessage _ = pure U1
genericDotProto _ = mempty
instance (KnownNat (GenericFieldCount f), GenericMessage f, GenericMessage g) => GenericMessage (f :*: g) where
type GenericFieldCount (f :*: g) = GenericFieldCount f + GenericFieldCount g
genericEncodeMessage num (x :*: y) = genericEncodeMessage num x <> genericEncodeMessage (FieldNumber (getFieldNumber num + offset)) y
where
offset = fromIntegral $ natVal (Proxy @(GenericFieldCount f))
genericDecodeMessage num = liftA2 (:*:) (genericDecodeMessage num) (genericDecodeMessage num2)
where num2 = FieldNumber $ getFieldNumber num + offset
offset = fromIntegral $ natVal (Proxy @(GenericFieldCount f))
genericDotProto _ = genericDotProto (Proxy @f) <> adjust (genericDotProto (Proxy @g))
where
offset = fromIntegral $ natVal (Proxy @(GenericFieldCount f))
adjust = map adjustPart
adjustPart part = part { dotProtoFieldNumber = (FieldNumber . (offset +) . getFieldNumber . dotProtoFieldNumber) part }
instance MessageField c => GenericMessage (K1 i c) where
type GenericFieldCount (K1 i c) = 1
genericEncodeMessage num (K1 x) = encodeMessageField num x
genericDecodeMessage num = fmap K1 (at decodeMessageField num)
genericDotProto _ = [protoType (Proxy @c)]
instance (Selector s, GenericMessage f) => GenericMessage (M1 S s f) where
type GenericFieldCount (M1 S s f) = GenericFieldCount f
genericEncodeMessage num (M1 x) = genericEncodeMessage num x
genericDecodeMessage num = fmap M1 $ genericDecodeMessage num
genericDotProto _ = map applyName $ genericDotProto (Proxy @f)
where
applyName :: DotProtoField -> DotProtoField
applyName mp = mp { dotProtoFieldName = fromMaybe Anonymous newName} -- [issue] this probably doesn't match the intended name generating semantics
newName :: Maybe DotProtoIdentifier
newName = guard (not (null name)) $> Single name
where
name = selName (undefined :: S1 s f ())
instance GenericMessage f => GenericMessage (M1 C t f) where
type GenericFieldCount (M1 C t f) = GenericFieldCount f
genericEncodeMessage num (M1 x) = genericEncodeMessage num x
genericDecodeMessage num = fmap M1 $ genericDecodeMessage num
genericDotProto _ = genericDotProto (Proxy @f)
instance GenericMessage f => GenericMessage (M1 D t f) where
type GenericFieldCount (M1 D t f) = GenericFieldCount f
genericEncodeMessage num (M1 x) = genericEncodeMessage num x
genericDecodeMessage num = fmap M1 $ genericDecodeMessage num
genericDotProto _ = genericDotProto (Proxy @f)

5
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto.hs vendored
View File

@ -1,5 +0,0 @@
module Proto3.Suite.DotProto (module M) where
import Proto3.Suite.DotProto.AST as M
import Proto3.Suite.DotProto.Parsing as M
import Proto3.Suite.DotProto.Rendering as M

443
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto/AST.hs vendored
View File

@ -1,443 +0,0 @@
-- | Fairly straightforward AST encoding of the .proto grammar
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
module Proto3.Suite.DotProto.AST
( -- * Types
MessageName(..)
, FieldName(..)
, PackageName(..)
, DotProtoIdentifier(..)
, DotProtoImport(..)
, DotProtoImportQualifier(..)
, DotProtoPackageSpec(..)
, DotProtoOption(..)
, DotProtoDefinition(..)
, DotProtoMeta(..)
, DotProto(..)
, DotProtoValue(..)
, DotProtoPrimType(..)
, Packing(..)
, Path(..)
, DotProtoType(..)
, DotProtoEnumValue
, DotProtoEnumPart(..)
, Streaming(..)
, DotProtoServicePart(..)
, DotProtoMessagePart(..)
, DotProtoField(..)
, DotProtoReservedField(..)
) where
import Data.String (IsString)
import qualified Filesystem.Path.CurrentOS as FP
import Numeric.Natural
import Prelude hiding (FilePath)
import Proto3.Wire.Types (FieldNumber (..))
import Test.QuickCheck
import Turtle (FilePath)
-- | The name of a message
newtype MessageName = MessageName
{ getMessageName :: String
} deriving (Eq, Ord, IsString)
instance Show MessageName where
show = show . getMessageName
-- | The name of some field
newtype FieldName = FieldName
{ getFieldName :: String
} deriving (Eq, Ord, IsString)
instance Show FieldName where
show = show . getFieldName
-- | The name of the package
newtype PackageName = PackageName
{ getPackageName :: String
} deriving (Eq, Ord, IsString)
instance Show PackageName where
show = show . getPackageName
newtype Path = Path [String] deriving (Show, Eq, Ord)
data DotProtoIdentifier
= Single String
| Dots Path
| Qualified DotProtoIdentifier DotProtoIdentifier
| Anonymous -- [recheck] is there a better way to represent unnamed things
deriving (Show, Eq, Ord)
-- | Top-level import declaration
data DotProtoImport = DotProtoImport
{ dotProtoImportQualifier :: DotProtoImportQualifier
, dotProtoImportPath :: FilePath
} deriving (Show, Eq, Ord)
instance Arbitrary DotProtoImport where
arbitrary = do
dotProtoImportQualifier <- arbitrary
let dotProtoImportPath = FP.empty
return (DotProtoImport {..})
data DotProtoImportQualifier
= DotProtoImportPublic
| DotProtoImportWeak
| DotProtoImportDefault
deriving (Show, Eq, Ord)
instance Arbitrary DotProtoImportQualifier where
arbitrary = elements
[ DotProtoImportDefault
, DotProtoImportWeak
, DotProtoImportPublic
]
-- | The namespace declaration
data DotProtoPackageSpec
= DotProtoPackageSpec DotProtoIdentifier
| DotProtoNoPackage
deriving (Show, Eq)
instance Arbitrary DotProtoPackageSpec where
arbitrary = oneof
[ return DotProtoNoPackage
, fmap DotProtoPackageSpec arbitrarySingleIdentifier
, fmap DotProtoPackageSpec arbitraryPathIdentifier
]
-- | An option id/value pair, can be attached to many types of statements
data DotProtoOption = DotProtoOption
{ dotProtoOptionIdentifier :: DotProtoIdentifier
, dotProtoOptionValue :: DotProtoValue
} deriving (Show, Eq, Ord)
instance Arbitrary DotProtoOption where
arbitrary = do
dotProtoOptionIdentifier <- oneof
[ arbitraryPathIdentifier
, arbitraryNestedIdentifier
]
dotProtoOptionValue <- arbitrary
return (DotProtoOption {..})
-- | Top-level protocol definitions
data DotProtoDefinition
= DotProtoMessage DotProtoIdentifier [DotProtoMessagePart]
| DotProtoEnum DotProtoIdentifier [DotProtoEnumPart]
| DotProtoService DotProtoIdentifier [DotProtoServicePart]
deriving (Show, Eq)
instance Arbitrary DotProtoDefinition where
arbitrary = oneof [arbitraryMessage, arbitraryEnum]
where
arbitraryMessage = do
identifier <- arbitrarySingleIdentifier
parts <- smallListOf arbitrary
return (DotProtoMessage identifier parts)
arbitraryEnum = do
identifier <- arbitrarySingleIdentifier
parts <- smallListOf arbitrary
return (DotProtoEnum identifier parts)
-- | Tracks misc metadata about the AST
data DotProtoMeta = DotProtoMeta
{ metaModulePath :: Path
-- ^ The "module path" associated with the .proto file from which this AST
-- was parsed. The "module path" is derived from the `--includeDir`-relative
-- .proto filename passed to 'parseProtoFile'. See
-- 'Proto3.Suite.DotProto.Internal.toModulePath' for details on how module
-- path values are constructed. See
-- 'Proto3.Suite.DotProto.Generate.modulePathModName' to see how it is used
-- during code generation.
} deriving (Show, Eq)
instance Arbitrary DotProtoMeta where
arbitrary = pure . DotProtoMeta . Path $ []
-- | This data structure represents a .proto file
-- The actual source order of protobuf statements isn't meaningful so statements are sorted by type during parsing
-- A .proto file with more than one package declaration is considered invalid
data DotProto = DotProto
{ protoImports :: [DotProtoImport]
, protoOptions :: [DotProtoOption]
, protoPackage :: DotProtoPackageSpec
, protoDefinitions :: [DotProtoDefinition]
, protoMeta :: DotProtoMeta
} deriving (Show, Eq)
instance Arbitrary DotProto where
arbitrary = do
protoImports <- smallListOf arbitrary
protoOptions <- smallListOf arbitrary
protoPackage <- arbitrary
protoDefinitions <- smallListOf arbitrary
protoMeta <- arbitrary
return (DotProto {..})
-- | Matches the definition of `constant` in the proto3 language spec
-- These are only used as rvalues
data DotProtoValue
= Identifier DotProtoIdentifier
| StringLit String
| IntLit Int
| FloatLit Double
| BoolLit Bool
deriving (Show, Eq, Ord)
instance Arbitrary DotProtoValue where
arbitrary = oneof
[ fmap Identifier arbitrarySingleIdentifier
, fmap StringLit (return "")
, fmap IntLit arbitrary
, fmap FloatLit arbitrary
, fmap BoolLit arbitrary
]
data DotProtoPrimType
= Int32
| Int64
| SInt32
| SInt64
| UInt32
| UInt64
| Fixed32
| Fixed64
| SFixed32
| SFixed64
| String
| Bytes
| Bool
| Float
| Double
| Named DotProtoIdentifier -- ^ A named type, referring to another message or enum defined in the same file
deriving (Show, Eq)
instance Arbitrary DotProtoPrimType where
arbitrary = oneof
[ elements
[ Int32
, Int64
, SInt32
, SInt64
, UInt32
, UInt64
, Fixed32
, Fixed64
, SFixed32
, SFixed64
, String
, Bytes
, Bool
, Float
, Double
]
, fmap Named arbitrarySingleIdentifier
]
data Packing
= PackedField
| UnpackedField
deriving (Show, Eq)
instance Arbitrary Packing where
arbitrary = elements [PackedField, UnpackedField]
-- | This type is an almagamation of the modifiers used in types
-- It corresponds to a syntax role but not a semantic role, not all modifiers are meaningful in every type context
data DotProtoType
= Prim DotProtoPrimType
| Optional DotProtoPrimType
| Repeated DotProtoPrimType
| NestedRepeated DotProtoPrimType
| Map DotProtoPrimType DotProtoPrimType
deriving (Show, Eq)
instance Arbitrary DotProtoType where
arbitrary = oneof [fmap Prim arbitrary]
type DotProtoEnumValue = Int
data DotProtoEnumPart
= DotProtoEnumField DotProtoIdentifier DotProtoEnumValue [DotProtoOption]
| DotProtoEnumOption DotProtoOption
| DotProtoEnumEmpty
deriving (Show, Eq)
instance Arbitrary DotProtoEnumPart where
arbitrary = oneof [arbitraryField, arbitraryOption]
where
arbitraryField = do
identifier <- arbitraryIdentifier
enumValue <- arbitrary
opts <- arbitrary
return (DotProtoEnumField identifier enumValue opts)
arbitraryOption = do
option <- arbitrary
return (DotProtoEnumOption option)
data Streaming
= Streaming
| NonStreaming
deriving (Show, Eq)
instance Arbitrary Streaming where
arbitrary = elements [Streaming, NonStreaming]
-- [refactor] add named accessors to ServiceRPC
-- break this into two types
data DotProtoServicePart
= DotProtoServiceRPC DotProtoIdentifier (DotProtoIdentifier, Streaming) (DotProtoIdentifier, Streaming) [DotProtoOption]
| DotProtoServiceOption DotProtoOption
| DotProtoServiceEmpty
deriving (Show, Eq)
instance Arbitrary DotProtoServicePart where
arbitrary = oneof
[ arbitraryServiceRPC
, arbitraryServiceOption
]
where
arbitraryServiceRPC = do
identifier <- arbitrarySingleIdentifier
rpcClause0 <- arbitraryRPCClause
rpcClause1 <- arbitraryRPCClause
options <- smallListOf arbitrary
return (DotProtoServiceRPC identifier rpcClause0 rpcClause1 options)
where
arbitraryRPCClause = do
identifier <- arbitraryIdentifier
streaming <- arbitrary
return (identifier, streaming)
arbitraryServiceOption = do
option <- arbitrary
return (DotProtoServiceOption option)
data DotProtoMessagePart
= DotProtoMessageField DotProtoField
| DotProtoMessageOneOf
{ dotProtoOneOfName :: DotProtoIdentifier
, dotProtoOneOfFields :: [DotProtoField]
}
| DotProtoMessageDefinition DotProtoDefinition
| DotProtoMessageReserved [DotProtoReservedField]
deriving (Show, Eq)
instance Arbitrary DotProtoMessagePart where
arbitrary = oneof
[ arbitraryField
, arbitraryOneOf
, arbitraryDefinition
, arbitraryReserved
]
where
arbitraryField = do
field <- arbitrary
return (DotProtoMessageField field)
arbitraryOneOf = do
dotProtoOneOfName <- arbitrarySingleIdentifier
dotProtoOneOfFields <- smallListOf arbitrary
return (DotProtoMessageOneOf {..})
arbitraryDefinition = do
definition <- arbitrary
return (DotProtoMessageDefinition definition)
arbitraryReserved = do
fields <- oneof [smallListOf1 arbitrary, arbitraryReservedLabels]
return (DotProtoMessageReserved fields)
arbitraryReservedLabels :: Gen [DotProtoReservedField]
arbitraryReservedLabels = smallListOf1 (ReservedIdentifier <$> return "")
data DotProtoField = DotProtoField
{ dotProtoFieldNumber :: FieldNumber
, dotProtoFieldType :: DotProtoType
, dotProtoFieldName :: DotProtoIdentifier
, dotProtoFieldOptions :: [DotProtoOption]
, dotProtoFieldComment :: Maybe String
}
| DotProtoEmptyField
deriving (Show, Eq)
instance Arbitrary DotProtoField where
arbitrary = do
dotProtoFieldNumber <- arbitrary
dotProtoFieldType <- arbitrary
dotProtoFieldName <- arbitraryIdentifier
dotProtoFieldOptions <- smallListOf arbitrary
-- TODO: Generate random comments once the parser supports comments
let dotProtoFieldComment = Nothing
return (DotProtoField {..})
data DotProtoReservedField
= SingleField Int
| FieldRange Int Int
| ReservedIdentifier String
deriving (Show, Eq)
instance Arbitrary DotProtoReservedField where
arbitrary =
oneof [arbitrarySingleField, arbitraryFieldRange]
where
arbitraryFieldNumber = do
natural <- arbitrarySizedNatural
return (fromIntegral (natural :: Natural))
arbitrarySingleField = do
fieldNumber <- arbitraryFieldNumber
return (SingleField fieldNumber)
arbitraryFieldRange = do
begin <- arbitraryFieldNumber
end <- arbitraryFieldNumber
return (FieldRange begin end)
--------------------------------------------------------------------------------
-- | QC Arbitrary instance for generating random protobuf
_arbitraryService :: Gen DotProtoDefinition
_arbitraryService = do
identifier <- arbitrarySingleIdentifier
parts <- smallListOf arbitrary
return (DotProtoService identifier parts)
arbitraryIdentifierName :: Gen String
arbitraryIdentifierName = do
c <- elements (['a'..'z'] ++ ['A'..'Z'])
cs <- smallListOf (elements (['a'..'z'] ++ ['A'..'Z'] ++ ['_']))
return (c:cs)
arbitrarySingleIdentifier :: Gen DotProtoIdentifier
arbitrarySingleIdentifier = fmap Single arbitraryIdentifierName
arbitraryPathIdentifier :: Gen DotProtoIdentifier
arbitraryPathIdentifier = do
name <- arbitraryIdentifierName
names <- smallListOf1 arbitraryIdentifierName
pure . Dots . Path $ name:names
arbitraryNestedIdentifier :: Gen DotProtoIdentifier
arbitraryNestedIdentifier = do
identifier0 <- arbitraryIdentifier
identifier1 <- arbitrarySingleIdentifier
return (Qualified identifier0 identifier1)
-- these two kinds of identifiers are usually interchangeable, the others are not
arbitraryIdentifier :: Gen DotProtoIdentifier
arbitraryIdentifier = oneof [arbitrarySingleIdentifier, arbitraryPathIdentifier]
-- [note] quickcheck's default scaling generates *extremely* large asts past 20 iterations
-- the parser is not particularly slow but it does have noticeable delay on megabyte-large .proto files
smallListOf :: Gen a -> Gen [a]
smallListOf x = choose (0, 5) >>= \n -> vectorOf n x
smallListOf1 :: Gen a -> Gen [a]
smallListOf1 x = choose (1, 5) >>= \n -> vectorOf n x

1597
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto/Generate.hs vendored
View File

File diff suppressed because it is too large Load Diff

103
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto/Generate/Swagger.hs vendored
View File

@ -1,103 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | This module provides helper functions to generate Swagger schemas that
-- describe JSONPB encodings for protobuf types.
module Proto3.Suite.DotProto.Generate.Swagger
( ToSchema(..)
, genericDeclareNamedSchemaJSONPB
, ppSchema
)
where
import Control.Lens (over, set, (&), (.~), (?~))
import Control.Lens.Cons (_head)
import Data.Aeson (Value (String))
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LC8
import Data.Char (toLower)
import Data.Functor.Identity (Identity)
import Data.Swagger
import qualified Data.Swagger.Declare as Swagger
import qualified Data.Swagger.Internal.Schema as Swagger.Internal
import qualified Data.Swagger.Internal.TypeShape as Swagger.Internal
import qualified Data.Text as T
import Data.Proxy
import qualified Data.Vector as V
import GHC.Generics
import GHC.Int
import GHC.Word
import Proto3.Suite (Enumerated (..), Finite (..),
Fixed (..), Named (..), enumerate)
genericDeclareNamedSchemaJSONPB :: forall a proxy.
( Generic a
, Named a
, Swagger.Internal.GenericHasSimpleShape a
"genericDeclareNamedSchemaUnrestricted"
(Swagger.Internal.GenericShape (Rep a))
, Swagger.Internal.GToSchema (Rep a)
)
=> proxy a
-> Swagger.DeclareT (Definitions Schema) Identity NamedSchema
genericDeclareNamedSchemaJSONPB proxy =
over schema (set required []) <$> genericDeclareNamedSchema opts proxy
where
opts = defaultSchemaOptions{
fieldLabelModifier = over _head toLower
. drop (T.length (nameOf (Proxy @a)))
}
-- | Pretty-prints a schema. Useful when playing around with schemas in the
-- REPL.
ppSchema :: ToSchema a => proxy a -> IO ()
ppSchema = LC8.putStrLn . encodePretty . toSchema
-- | This orphan instance prevents Generic-based deriving mechanism from
-- throwing error on 'ToSchema' for 'ByteString' and instead defaults to
-- 'byteSchema'. It is a damn dirty hack, but very handy, as per:
-- https://github.com/GetShopTV/swagger2/issues/51
instance Swagger.Internal.GToSchema (K1 i BS.ByteString) where
gdeclareNamedSchema _ _ _ = pure
$ NamedSchema Nothing
$ byteSchema
-- | This orphan instance prevents Generic-based deriving mechanism from
-- throwing error on 'ToSchema' for 'V.Vector ByteString' and instead defaults
-- to (an array of) 'byteSchema'. It is a damn dirty hack, but very handy, as
-- per: https://github.com/GetShopTV/swagger2/issues/51
instance Swagger.Internal.GToSchema (K1 i (V.Vector BS.ByteString)) where
gdeclareNamedSchema _ _ _ = pure
$ NamedSchema Nothing
$ mempty
& type_ .~ SwaggerArray
& items ?~ SwaggerItemsObject (Inline byteSchema)
-- | JSONPB schemas for protobuf enumerations
instance (Finite e, Named e) => ToSchema (Enumerated e) where
declareNamedSchema _ = do
let enumName = nameOf (Proxy @e)
let dropPrefix = T.drop (T.length enumName)
let enumMemberNames = dropPrefix . fst <$> enumerate (Proxy @e)
return $ NamedSchema (Just enumName)
$ mempty
& type_ .~ SwaggerString
& enum_ ?~ fmap String enumMemberNames
instance ToSchema (Fixed Int32) where
declareNamedSchema _ = declareNamedSchema (Proxy @Int32)
instance ToSchema (Fixed Int64) where
declareNamedSchema _ = declareNamedSchema (Proxy @Int64)
instance ToSchema (Fixed Word32) where
declareNamedSchema _ = declareNamedSchema (Proxy @Word32)
instance ToSchema (Fixed Word64) where
declareNamedSchema _ = declareNamedSchema (Proxy @Word64)

174
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto/Internal.hs vendored
View File

@ -1,174 +0,0 @@
-- | This module provides misc internal helpers and utilities
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ViewPatterns #-}
module Proto3.Suite.DotProto.Internal where
import qualified Control.Foldl as FL
import Control.Lens (over)
import Control.Lens.Cons (_head)
import Data.Char (toUpper)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import System.FilePath (isPathSeparator)
import qualified Filesystem.Path.CurrentOS as FP
import Filesystem.Path.CurrentOS ((</>))
import qualified NeatInterpolation as Neat
import Prelude hiding (FilePath)
import Proto3.Suite.DotProto
import Text.Parsec (ParseError)
import Turtle (ExitCode (..), FilePath, MonadIO,
Text)
import qualified Turtle
import Turtle.Format ((%))
import qualified Turtle.Format as F
-- $setup
-- >>> :set -XOverloadedStrings
dieLines :: MonadIO m => Text -> m a
dieLines (Turtle.textToLines -> msg) = do
mapM_ Turtle.err msg
Turtle.exit (ExitFailure 1)
-- | toModulePath takes an include-relative path to a .proto file and produces a
-- "module path" which is used during code generation.
--
-- Note that, with the exception of the '.proto' portion of the input filepath,
-- this function interprets '.' in the filename components as if they were
-- additional slashes (assuming that the '.' is not the first character, which
-- is merely ignored). So e.g. "google/protobuf/timestamp.proto" and
-- "google.protobuf.timestamp.proto" map to the same module path.
--
-- >>> toModulePath "/absolute/path/fails.proto"
-- Left "expected include-relative path"
--
-- >>> toModulePath "relative/path/to/file_without_proto_suffix_fails"
-- Left "expected .proto suffix"
--
-- >>> toModulePath "relative/path/to/file_without_proto_suffix_fails.txt"
-- Left "expected .proto suffix"
--
-- >>> toModulePath "../foo.proto"
-- Left "expected include-relative path, but the path started with ../"
--
-- >>> toModulePath "foo..proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
--
-- >>> toModulePath "foo/bar/baz..proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
--
-- >>> toModulePath "foo.bar../baz.proto"
-- Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
--
-- >>> toModulePath "google/protobuf/timestamp.proto"
-- Right (Path ["Google","Protobuf","Timestamp"])
--
-- >>> toModulePath "a/b/c/google.protobuf.timestamp.proto"
-- Right (Path ["A","B","C","Google","Protobuf","Timestamp"])
--
-- >>> toModulePath "foo/FiLeName_underscore.and.then.some.dots.proto"
-- Right (Path ["Foo","FiLeName_underscore","And","Then","Some","Dots"])
--
-- >>> toModulePath "foo/bar/././baz/../boggle.proto"
-- Right (Path ["Foo","Bar","Boggle"])
--
-- >>> toModulePath "./foo.proto"
-- Right (Path ["Foo"])
--
-- NB: We ignore preceding single '.' characters
-- >>> toModulePath ".foo.proto"
-- Right (Path ["Foo"])
toModulePath :: FilePath -> Either String Path
toModulePath fp0@(fromMaybe fp0 . FP.stripPrefix "./" -> fp)
| Turtle.absolute fp
= Left "expected include-relative path"
| Turtle.extension fp /= Just "proto"
= Left "expected .proto suffix"
| otherwise
= case FP.stripPrefix "../" fp of
Just{} -> Left "expected include-relative path, but the path started with ../"
Nothing
| T.isInfixOf ".." (Turtle.format F.fp . FP.collapse $ fp)
-> Left "path contained unexpected .. after canonicalization, please use form x.y.z.proto"
| otherwise
-> Right
. Path
. dropWhile null -- Remove a potential preceding empty component which
-- arose from a preceding '.' in the input path, which we
-- want to ignore. E.g. ".foo.proto" => ["","Foo"].
. fmap (T.unpack . over _head toUpper)
. concatMap (T.splitOn ".")
. T.split isPathSeparator
. Turtle.format F.fp
. FP.collapse
. Turtle.dropExtension
$ fp
fatalBadModulePath :: MonadIO m => FilePath -> String -> m a
fatalBadModulePath (Turtle.format F.fp -> fp) (T.pack -> rsn) =
dieLines [Neat.text|
Error: failed when computing the "module path" for "${fp}": ${rsn}
Please ensure that the provided path to a .proto file is specified as
relative to some --includeDir path and that it has the .proto suffix.
|]
-- | @importProto searchPaths toplevel inc@ attempts to import include-relative
-- @inc@ after locating it somewhere in the @searchPaths@; @toplevel@ is simply
-- the path of toplevel .proto being processed so we can report it in an error
-- message. This function terminates the program if it cannot find the file to
-- import or if it cannot construct a valid module path from it.
importProto :: MonadIO m
=> [FilePath] -> FilePath -> FilePath -> m (Either ParseError DotProto)
importProto paths (Turtle.format F.fp -> toplevelProtoText) protoFP =
findProto paths protoFP >>= \case
Found mp fp -> parseProtoFile mp fp
BadModulePath e -> fatalBadModulePath protoFP e
NotFound -> dieLines [Neat.text|
Error: while processing include statements in "${toplevelProtoText}", failed
to find the imported file "${protoFPText}", after looking in the following
locations (controlled via the --includeDir switch(es)):
$pathsText
|]
where
pathsText = T.unlines (Turtle.format (" "%F.fp) . (</> protoFP) <$> paths)
protoFPText = Turtle.format F.fp protoFP
data FindProtoResult
= Found Path FilePath
| NotFound
| BadModulePath String
deriving (Eq, Show)
-- | Attempts to locate the first (if any) filename that exists on the given
-- search paths, and constructs the "module path" from the given
-- include-relative filename (2nd parameter). Terminates the program with an
-- error if the given pathname is not relative.
findProto :: MonadIO m => [FilePath] -> FilePath -> m FindProtoResult
findProto searchPaths protoFP
| Turtle.absolute protoFP = dieLines [Neat.text|
Error: Absolute paths to .proto files, whether on the command line or
in include directives, are not currently permitted; rather, all .proto
filenames must be relative to the current directory, or relative to some
search path specified via --includeDir.
This is because we currently use the include-relative name to decide
the structure of the Haskell module tree that we emit during code
generation.
|]
| otherwise = case toModulePath protoFP of
Left e -> pure (BadModulePath e)
Right mp -> do
mfp <- flip Turtle.fold FL.head $ do
sp <- Turtle.select searchPaths
let fp = sp </> protoFP
True <- Turtle.testfile fp
pure fp
case mfp of
Nothing -> pure NotFound
Just fp -> pure (Found mp fp)

451
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto/Parsing.hs vendored
View File

@ -1,451 +0,0 @@
-- | This module contains a near-direct translation of the proto3 grammar
-- It uses String for easier compatibility with DotProto.Generator, which needs it for not very good reasons
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module Proto3.Suite.DotProto.Parsing
( parseProto
, parseProtoFile
) where
import Control.Applicative hiding (empty)
import Data.Functor
import qualified Data.Text as T
import qualified Filesystem.Path.CurrentOS as FP
import Proto3.Suite.DotProto.AST
import Proto3.Wire.Types (FieldNumber(..))
import Text.Parsec (parse, ParseError)
import Text.Parsec.String (Parser)
import Text.Parser.Char
import Text.Parser.Combinators
import Text.Parser.LookAhead
import Text.Parser.Token
import qualified Turtle
----------------------------------------
-- interfaces
-- | @parseProto mp inp@ attempts to parse @inp@ as a 'DotProto'. @mp@ is the
-- module path to be injected into the AST as part of 'DotProtoMeta' metadata on
-- a successful parse.
parseProto :: Path -> String -> Either ParseError DotProto
parseProto modulePath = parse (topLevel modulePath) "" . stripComments
-- | @parseProtoFile mp fp@ reads and parses the .proto file found at @fp@. @mp@
-- is used downstream during code generation when we need to generate names
-- which are a function of the source .proto file's filename and its path
-- relative to some @--includeDir@.
parseProtoFile :: Turtle.MonadIO m
=> Path -> Turtle.FilePath -> m (Either ParseError DotProto)
parseProtoFile modulePath =
fmap (parseProto modulePath) . Turtle.liftIO . readFile . FP.encodeString
----------------------------------------
-- convenience
listSep :: Parser ()
listSep = whiteSpace >> text "," >> whiteSpace
empty :: Parser ()
empty = whiteSpace >> text ";" >> return ()
fieldNumber :: Parser FieldNumber
fieldNumber = FieldNumber . fromInteger <$> integer
-- [issue] this is a terrible, naive way to strip comments
-- any string that contains "//" breaks
-- a regex would be better, but the best thing to do is to just replace all the string logic with a lexer
_stripComments :: String -> String
_stripComments ('/':'/':rest) = _stripComments (dropWhile (/= '\n') rest)
_stripComments (x:rest) = x:_stripComments rest
_stripComments [] = []
-- [issue] This is still a terrible and naive way to strip comments, was written
-- hastily, and has been only lightly tested. However, it improves upon
-- `_stripComments` above: it handles /* block comments /* with nesting */ */,
-- "// string lits with comments in them", etc., and thus is closer to the
-- protobuf3 grammar. The right solution is still to replace this with a proper
-- lexer, but since we might switch to using the `protoc`-based `FileDescriptor`
-- parsing instead, we should hold off. If we do decide to stick with this
-- parser, we should also inject comments into the AST so that they can be
-- marshaled into the generated code, and ensure that line numbers reported in
-- errors are still correct. Although this implementation is handy to toss out
-- in the interests of getting some more .protos parsable, it's probably not
-- worth maintaining, and has an ad-hoc smell. If we find ourselves mucking with
-- this much at all in the very near short term, let's just pay the freight and
-- use `Text.Parsec.Token` or somesuch.
data StripCommentState
-- | starts | ends | error on? |
= BC -- block comment | "/*" | "*/" | mismatch |
| DQ -- double quote | '"' | '"' | mismatch |
| LC -- line comment | "//" | '\n' | mismatch ('\n') |
deriving Show
stripComments :: String -> String
stripComments = go [] where
go [] ('/':'*':cs) = go [BC] cs
go st@(BC:_) ('/':'*':cs) = go (BC:st) cs
go [] ('*':'/':_) = error "*/ without preceding /*"
go (BC:st) ('*':'/':cs) = go st cs
go st@(BC:_) (_:cs) = go st cs
go [] ('/':'/':cs) = go [LC] cs
go [] ('"':cs) = '"' : go [DQ] cs
go (LC:st) cs@('\n':_) = go st cs
go st@(LC:_) (_:cs) = go st cs
go (DQ:st) ('"':cs) = '"' : go st cs
go st (c:cs) = c : go st cs
go [] [] = []
go (BC:_) [] = error "unterminated block comment"
go (DQ:_) [] = error "unterminated double-quote"
go (LC:_) [] = error "unterminated line comment (missing newline)"
----------------------------------------
-- identifiers
identifierName :: Parser String
identifierName = do h <- letter
t <- many (alphaNum <|> char '_')
return $ h:t
identifier :: Parser DotProtoIdentifier
identifier = do is <- identifierName `sepBy1` string "."
return $ case is of
[i] -> Single i
_ -> Dots (Path is)
-- [note] message and enum types are defined by the proto3 spec to have an optional leading period (messageType and enumType in the spec)
-- what this indicates is, as far as i can tell, not documented, and i haven't found this syntax used in practice
-- it's ommitted but can be fairly easily added if there is in fact a use for it
-- [update] the leading dot denotes that the identifier path starts in global scope
-- i still haven't seen a use case for this but i can add it upon request
nestedIdentifier :: Parser DotProtoIdentifier
nestedIdentifier = do h <- parens identifier
string "."
t <- identifier
return $ Qualified h t
----------------------------------------
-- values
-- [issue] these string parsers are weak to \" and \000 octal codes
stringLit :: Parser String
stringLit = stringLiteral <|> stringLiteral'
bool :: Parser Bool
bool = (string "true" >> (notFollowedBy $ alphaNum <|> char '_') $> True) -- used to distinguish "true_" (Identifier) from "true" (BoolLit)
<|> (string "false" >> (notFollowedBy $ alphaNum <|> char '_') $> False)
-- the `parsers` package actually does not expose a parser for signed fractional values
floatLit :: Parser Double
floatLit = do sign <- char '-' $> negate <|> char '+' $> id <|> pure id
sign <$> double
value :: Parser DotProtoValue
value = try (BoolLit <$> bool)
<|> try (StringLit <$> stringLit)
<|> try (FloatLit <$> floatLit)
<|> try (IntLit . fromInteger <$> integer)
<|> try (Identifier <$> identifier)
----------------------------------------
-- types
primType :: Parser DotProtoPrimType
primType = try (string "double" $> Double)
<|> try (string "float" $> Float)
<|> try (string "int32" $> Int32)
<|> try (string "int64" $> Int64)
<|> try (string "sint32" $> SInt32)
<|> try (string "sint64" $> SInt64)
<|> try (string "uint32" $> UInt32)
<|> try (string "uint64" $> UInt64)
<|> try (string "fixed32" $> Fixed32)
<|> try (string "fixed64" $> Fixed64)
<|> try (string "sfixed32" $> SFixed32)
<|> try (string "sfixed64" $> SFixed64)
<|> try (string "string" $> String)
<|> try (string "bytes" $> Bytes)
<|> try (string "bool" $> Bool)
<|> Named <$> identifier
--------------------------------------------------------------------------------
-- top-level parser and version annotation
syntaxSpec :: Parser ()
syntaxSpec = do string "syntax"
whiteSpace
string "="
whiteSpace
string "'proto3'" <|> string "\"proto3\""
whiteSpace
string ";"
whiteSpace
data DotProtoStatement
= DPSOption DotProtoOption
| DPSPackage DotProtoPackageSpec
| DPSImport DotProtoImport
| DPSDefinition DotProtoDefinition
| DPSEmpty
deriving Show
sortStatements :: Path -> [DotProtoStatement] -> DotProto
sortStatements modulePath statements
= DotProto { protoOptions = [ x | DPSOption x <- statements]
, protoImports = [ x | DPSImport x <- statements]
, protoPackage = adapt [ x | DPSPackage x <- statements]
, protoDefinitions = [ x | DPSDefinition x <- statements]
, protoMeta = DotProtoMeta modulePath
}
where
adapt (x:_) = x
adapt _ = DotProtoNoPackage
topLevel :: Path -> Parser DotProto
topLevel modulePath = do whiteSpace
syntaxSpec
whiteSpace
sortStatements modulePath <$> topStatement `sepBy` whiteSpace
--------------------------------------------------------------------------------
-- top-level statements
topStatement :: Parser DotProtoStatement
topStatement = (DPSImport <$> import_)
<|> (DPSPackage <$> package)
<|> (DPSOption <$> topOption)
<|> (DPSDefinition <$> definition)
<|> empty $> DPSEmpty
import_ :: Parser DotProtoImport
import_ = do string "import"
whiteSpace
qualifier <- option DotProtoImportDefault ((string "weak" $> DotProtoImportWeak) <|> (string "public" $> DotProtoImportPublic))
whiteSpace
target <- FP.fromText . T.pack <$> stringLit
string ";"
return $ DotProtoImport qualifier target
package :: Parser DotProtoPackageSpec
package = do string "package"
whiteSpace
p <- identifier
whiteSpace
string ";"
return $ DotProtoPackageSpec p
definition :: Parser DotProtoDefinition
definition = message
<|> enum
<|> service
--------------------------------------------------------------------------------
-- options
optionName :: Parser DotProtoIdentifier
optionName = do ohead <- nestedIdentifier <|> identifier -- this permits the (p.p2).p3 option identifier form
-- i'm not actually sure if this form is used in non-option statements
whiteSpace
string "="
return ohead
optionValue :: Parser DotProtoValue
optionValue = do whiteSpace
v <- value
return v
inlineOption :: Parser DotProtoOption
inlineOption = DotProtoOption <$> optionName <*> optionValue
optionAnnotation :: Parser [DotProtoOption]
optionAnnotation = (brackets $ inlineOption `sepBy1` listSep) <|> pure []
topOption :: Parser DotProtoOption
topOption = do string "option"
whiteSpace
v <- DotProtoOption <$> optionName <*> optionValue
whiteSpace
string ";"
whiteSpace
return v
--------------------------------------------------------------------------------
-- service statements
servicePart :: Parser DotProtoServicePart
servicePart = rpc
<|> (DotProtoServiceOption <$> topOption)
<|> empty $> DotProtoServiceEmpty
rpcOptions :: Parser [DotProtoOption]
rpcOptions = braces $ many topOption
rpcClause :: Parser (DotProtoIdentifier, Streaming)
rpcClause = do
let sid ctx = (,ctx) <$> identifier
-- NB: Distinguish "stream stream.foo" from "stream.foo"
try (string "stream" *> whiteSpace *> sid Streaming) <|> sid NonStreaming
rpc :: Parser DotProtoServicePart
rpc = do string "rpc"
whiteSpace
name <- Single <$> identifierName
whiteSpace
subjecttype <- parens rpcClause
whiteSpace
string "returns"
whiteSpace
returntype <- parens rpcClause
whiteSpace
options <- rpcOptions <|> (string ";" $> [])
return $ DotProtoServiceRPC name subjecttype returntype options
service :: Parser DotProtoDefinition
service = do string "service"
whiteSpace
name <- Single <$> identifierName
whiteSpace
statements <- braces (servicePart `sepEndBy` whiteSpace)
return $ DotProtoService name statements
--------------------------------------------------------------------------------
-- message definitions
message :: Parser DotProtoDefinition
message = do string "message"
whiteSpace
name <- Single <$> identifierName
whiteSpace
body <- braces (messagePart `sepEndBy` whiteSpace)
return $ DotProtoMessage name body
messagePart :: Parser DotProtoMessagePart
messagePart = try (DotProtoMessageDefinition <$> enum)
<|> try (DotProtoMessageReserved <$> reservedField)
<|> try (DotProtoMessageDefinition <$> message)
<|> try messageOneOf
<|> try (DotProtoMessageField <$> messageMapField)
<|> (DotProtoMessageField <$> messageField)
messageField :: Parser DotProtoField
messageField = do ctor <- (try $ string "repeated" $> Repeated) <|> pure Prim
whiteSpace
mtype <- primType
whiteSpace
mname <- identifier
whiteSpace
string "="
whiteSpace
mnumber <- fieldNumber
whiteSpace
moptions <- optionAnnotation
whiteSpace
string ";"
-- TODO: parse comments
return $ DotProtoField mnumber (ctor mtype) mname moptions Nothing
messageMapField :: Parser DotProtoField
messageMapField = do string "map"
whiteSpace
string "<"
whiteSpace
ktype <- primType
whiteSpace
string ","
whiteSpace
vtype <- primType
whiteSpace
string ">"
whiteSpace
mname <- identifier
whiteSpace
string "="
fpos <- fieldNumber
whiteSpace
fos <- optionAnnotation
whiteSpace
string ";"
-- TODO: parse comments
return $ DotProtoField fpos (Map ktype vtype) mname fos Nothing
--------------------------------------------------------------------------------
-- enumerations
enumField :: Parser DotProtoEnumPart
enumField = do fname <- identifier
whiteSpace
string "="
whiteSpace
fpos <- fromInteger <$> integer
whiteSpace
opts <- optionAnnotation
whiteSpace
string ";"
return $ DotProtoEnumField fname fpos opts
enumStatement :: Parser DotProtoEnumPart
enumStatement = try (DotProtoEnumOption <$> topOption)
<|> enumField
<|> empty $> DotProtoEnumEmpty
enum :: Parser DotProtoDefinition
enum = do string "enum"
whiteSpace
ename <- Single <$> identifierName
whiteSpace
ebody <- braces (enumStatement `sepEndBy` whiteSpace)
return $ DotProtoEnum ename ebody
--------------------------------------------------------------------------------
-- oneOf
oneOfField :: Parser DotProtoField
oneOfField = do ftype <- Prim <$> primType
whiteSpace
fname <- identifier
whiteSpace
string "="
whiteSpace
fpos <- fromInteger <$> integer
whiteSpace
fops <- optionAnnotation
whiteSpace
string ";"
-- TODO: parse comments
return $ DotProtoField fpos ftype fname fops Nothing
messageOneOf :: Parser DotProtoMessagePart
messageOneOf = do string "oneof"
whiteSpace
name <- identifier
whiteSpace
body <- braces $ (oneOfField <|> empty $> DotProtoEmptyField) `sepEndBy` whiteSpace
return $ DotProtoMessageOneOf name body
--------------------------------------------------------------------------------
-- field reservations
range :: Parser DotProtoReservedField
range = do lookAhead (integer >> whiteSpace >> string "to") -- [note] parsec commits to this parser too early without this lookahead
s <- fromInteger <$> integer
whiteSpace
string "to"
whiteSpace
e <- fromInteger <$> integer
return $ FieldRange s e
ranges :: Parser [DotProtoReservedField]
ranges = (try range <|> (SingleField . fromInteger <$> integer)) `sepBy1` listSep
reservedField :: Parser [DotProtoReservedField]
reservedField = do string "reserved"
whiteSpace
v <- ranges <|> ((ReservedIdentifier <$> stringLit) `sepBy1` listSep)
whiteSpace
string ";"
return v

218
nix/third-party/proto3-suite/src/Proto3/Suite/DotProto/Rendering.hs vendored
View File

@ -1,218 +0,0 @@
-- | This module provides types and functions to generate .proto files.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Proto3.Suite.DotProto.Rendering
( renderDotProto
, defRenderingOptions
, defSelectorName
, defEnumMemberName
, packageFromDefs
, toProtoFile
, toProtoFileDef
, RenderingOptions(..)
) where
import Data.Char
import qualified Data.Text as T
import Filesystem.Path.CurrentOS (toText)
import Proto3.Suite.DotProto.AST
import Proto3.Wire.Types (FieldNumber (..))
import "pretty" Text.PrettyPrint (($$), (<+>))
import qualified "pretty" Text.PrettyPrint as PP
import "pretty" Text.PrettyPrint.HughesPJClass (Pretty(..))
-- | Options for rendering a @.proto@ file.
data RenderingOptions = RenderingOptions
{ roSelectorName :: DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> PP.Doc
-- ^ This function will be applied to each
-- record selector name to turn it into a protobuf
-- field name (default: uses the selector name, unchanged).
, roEnumMemberName :: DotProtoIdentifier -> DotProtoIdentifier -> PP.Doc
-- ^ This function will be applied to each
-- enum member name to turn it into a protobuf
-- field name (default: uses the field name, unchanged).
}
-- | Default rendering options.
defRenderingOptions :: RenderingOptions
defRenderingOptions =
RenderingOptions { roSelectorName = defSelectorName
, roEnumMemberName = defEnumMemberName
}
-- | The default choice of field name for a selector.
defSelectorName :: DotProtoIdentifier -> DotProtoIdentifier -> FieldNumber -> PP.Doc
defSelectorName _ fieldName _ = pPrint fieldName
-- | The default choice of enum member name for an enum
defEnumMemberName :: DotProtoIdentifier -> DotProtoIdentifier -> PP.Doc
defEnumMemberName = const pPrint
-- | Traverses a DotProto AST and generates a .proto file from it
renderDotProto :: RenderingOptions -> DotProto -> PP.Doc
renderDotProto opts DotProto{..}
= PP.text "syntax = \"proto3\";"
$$ pPrint protoPackage
$$ (PP.vcat $ pPrint <$> protoImports)
$$ (PP.vcat $ topOption <$> protoOptions)
$$ (PP.vcat $ prettyPrintProtoDefinition opts <$> protoDefinitions)
instance Pretty DotProtoPackageSpec where
pPrint (DotProtoPackageSpec p) = PP.text "package" <+> pPrint p PP.<> PP.text ";"
pPrint (DotProtoNoPackage) = PP.empty
instance Pretty DotProtoImport where
pPrint (DotProtoImport q i) =
PP.text "import" <+> pPrint q <+> PP.text fp PP.<> PP.text ";"
where
fp = case T.unpack . either id id . toText $ i of
[] -> show ("" :: String)
x -> x
instance Pretty DotProtoImportQualifier where
pPrint DotProtoImportDefault = PP.empty
pPrint DotProtoImportPublic = PP.text "public"
pPrint DotProtoImportWeak = PP.text "weak"
optionAnnotation :: [DotProtoOption] -> PP.Doc
optionAnnotation [] = PP.empty
optionAnnotation os = PP.brackets
. PP.hcat
. PP.punctuate (PP.text ", ")
$ pPrint <$> os
topOption :: DotProtoOption -> PP.Doc
topOption o = PP.text "option" <+> pPrint o PP.<> PP.text ";"
instance Pretty DotProtoOption where
pPrint (DotProtoOption key value) = pPrint key <+> PP.text "=" <+> pPrint value
prettyPrintProtoDefinition :: RenderingOptions -> DotProtoDefinition -> PP.Doc
prettyPrintProtoDefinition opts = defn where
defn :: DotProtoDefinition -> PP.Doc
defn (DotProtoMessage name parts) = PP.text "message" <+> pPrint name <+> (braces $ PP.vcat $ msgPart name <$> parts)
defn (DotProtoEnum name parts) = PP.text "enum" <+> pPrint name <+> (PP.braces $ PP.vcat $ enumPart name <$> parts)
defn (DotProtoService name parts) = PP.text "service" <+> pPrint name <+> (PP.braces $ PP.vcat $ pPrint <$> parts)
-- Put the final closing brace on the next line.
-- This is important, since the final field might have a comment, and
-- the brace cannot be part of the comment.
-- We could use block comments instead, once the parser/lexer supports them.
braces :: PP.Doc -> PP.Doc
braces = ($$ PP.text "}") . (PP.text "{" <+>)
msgPart :: DotProtoIdentifier -> DotProtoMessagePart -> PP.Doc
msgPart msgName (DotProtoMessageField f) = field msgName f
msgPart _ (DotProtoMessageDefinition definition) = defn definition
msgPart _ (DotProtoMessageReserved reservations)
= PP.text "reserved"
<+> (PP.hcat . PP.punctuate (PP.text ", ") $ pPrint <$> reservations)
PP.<> PP.text ";"
msgPart msgName (DotProtoMessageOneOf name fields) = PP.text "oneof" <+> pPrint name <+> (PP.braces $ PP.vcat $ field msgName <$> fields)
field :: DotProtoIdentifier -> DotProtoField -> PP.Doc
field msgName (DotProtoField number mtype name options comments)
= pPrint mtype
<+> roSelectorName opts msgName name number
<+> PP.text "="
<+> pPrint number
<+> optionAnnotation options
PP.<> PP.text ";"
PP.<> maybe PP.empty (PP.text . (" // " ++)) comments
field _ DotProtoEmptyField = PP.empty
enumPart :: DotProtoIdentifier -> DotProtoEnumPart -> PP.Doc
enumPart msgName (DotProtoEnumField name value options)
= roEnumMemberName opts msgName name
<+> PP.text "="
<+> pPrint value
<+> optionAnnotation options
PP.<> PP.text ";"
enumPart _ (DotProtoEnumOption opt)
= PP.text "option" <+> pPrint opt PP.<> PP.text ";"
enumPart _ DotProtoEnumEmpty
= PP.empty
instance Pretty DotProtoServicePart where
pPrint (DotProtoServiceRPC name (callname, callstrm) (retname, retstrm) options)
= PP.text "rpc"
<+> pPrint name
<+> PP.parens (pPrint callstrm <+> pPrint callname)
<+> PP.text "returns"
<+> PP.parens (pPrint retstrm <+> pPrint retname)
<+> case options of
[] -> PP.text ";"
_ -> PP.braces . PP.vcat $ topOption <$> options
pPrint (DotProtoServiceOption option) = topOption option
pPrint DotProtoServiceEmpty = PP.empty
instance Pretty Streaming where
pPrint Streaming = PP.text "stream"
pPrint NonStreaming = PP.empty
instance Pretty DotProtoIdentifier where
pPrint (Single name) = PP.text name
pPrint (Dots (Path names)) = PP.hcat . PP.punctuate (PP.text ".") $ PP.text <$> names
pPrint (Qualified qualifier identifier) = PP.parens (pPrint qualifier) PP.<> PP.text "." PP.<> pPrint identifier
pPrint Anonymous = PP.empty
instance Pretty DotProtoValue where
pPrint (Identifier value) = pPrint value
pPrint (StringLit value) = PP.text $ show value
pPrint (IntLit value) = PP.text $ show value
pPrint (FloatLit value) = PP.text $ show value
pPrint (BoolLit value) = PP.text $ toLower <$> show value
instance Pretty DotProtoType where
pPrint (Prim ty) = pPrint ty
pPrint (Optional ty) = pPrint ty
pPrint (Repeated ty) = PP.text "repeated" <+> pPrint ty
pPrint (NestedRepeated ty) = PP.text "repeated" <+> pPrint ty
pPrint (Map keyty valuety) = PP.text "<" PP.<> pPrint keyty PP.<> PP.text ", " PP.<> pPrint valuety PP.<> PP.text ">"
instance Pretty DotProtoPrimType where
pPrint (Named i) = pPrint i
pPrint Int32 = PP.text "int32"
pPrint Int64 = PP.text "int64"
pPrint SInt32 = PP.text "sint32"
pPrint SInt64 = PP.text "sint64"
pPrint UInt32 = PP.text "uint32"
pPrint UInt64 = PP.text "uint64"
pPrint Fixed32 = PP.text "fixed32"
pPrint Fixed64 = PP.text "fixed64"
pPrint SFixed32 = PP.text "sfixed32"
pPrint SFixed64 = PP.text "sfixed64"
pPrint String = PP.text "string"
pPrint Bytes = PP.text "bytes"
pPrint Bool = PP.text "bool"
pPrint Float = PP.text "float"
pPrint Double = PP.text "double"
instance Pretty FieldNumber where
pPrint = PP.text . show . getFieldNumber
instance Pretty DotProtoReservedField where
pPrint (SingleField num) = PP.text $ show num
pPrint (FieldRange start end) = (PP.text $ show start) <+> PP.text "to" <+> (PP.text $ show end)
pPrint (ReservedIdentifier i) = PP.text $ show i
-- | Render protobufs metadata as a .proto file stringy
toProtoFile :: RenderingOptions -> DotProto -> String
toProtoFile opts = PP.render . renderDotProto opts
-- | Render protobufs metadata as a .proto file string,
-- using the default rendering options.
toProtoFileDef :: DotProto -> String
toProtoFileDef = toProtoFile defRenderingOptions
packageFromDefs :: String -> [DotProtoDefinition] -> DotProto
packageFromDefs package defs =
DotProto [] [] (DotProtoPackageSpec $ Single package) defs (DotProtoMeta $ Path [])

40
nix/third-party/proto3-suite/src/Proto3/Suite/JSONPB.hs vendored
View File

@ -1,40 +0,0 @@
module Proto3.Suite.JSONPB
( -- * Typeclasses
FromJSONPB(..)
, ToJSONPB(..)
-- * Operators
, (.:)
, (.=)
-- * Options for controlling codec behavior (e.g., emitting default-valued
-- fields in JSON payloads)
, Options(..)
, defaultOptions
-- * JSONPB codec entry points
, eitherDecode
, encode
-- * Helper functions
, enumFieldEncoding
, enumFieldString
, object
, pair
, pairs
, parseField
, toAesonEncoding
, toAesonValue
-- * Aeson re-exports
, A.Value(..)
, A.ToJSON(..)
, A.FromJSON(..)
, A.typeMismatch
, A.withObject
-- * Swagger schema helpers
, Swagger.ToSchema(..)
, Swagger.genericDeclareNamedSchemaJSONPB
,
)
where
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Proto3.Suite.DotProto.Generate.Swagger as Swagger
import Proto3.Suite.JSONPB.Class

425
nix/third-party/proto3-suite/src/Proto3/Suite/JSONPB/Class.hs vendored
View File

@ -1,425 +0,0 @@
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
-- | Support for the "JSONPB" canonical JSON encoding described at
-- https://developers.google.com/protocol-buffers/docs/proto3#json.
--
-- This modules provides 'Data.Aeson'-like helper functions, typeclasses, and
-- instances for converting to and from values of types which have a JSONPB
-- representation and equivalent underlying 'Data.Aeson' representations.
--
-- This module also presents a (very minimal) surface syntax for Aeson-like
-- operations; the idea is that we can write 'ToJSONPB' and 'FromJSONPB'
-- instances in a very similar manner to 'A.ToJSON' and 'A.FromJSON' instances,
-- except that doing so specifies JSONPB codecs instead of vanilla JSON codecs.
--
-- Example use:
--
-- @
-- message Scalar32 {
-- int32 i32 = 1;
-- uint32 u32 = 2;
-- sint32 s32 = 3;
-- fixed32 f32 = 4;
-- sfixed32 sf32 = 5;
-- }
--
-- instance ToJSONPB Scalar32 where
-- toJSONPB (Scalar32 i32 u32 s32 f32 sf32) = object
-- [ "i32" .= i32
-- , "u32" .= u32
-- , "s32" .= s32
-- , "f32" .= f32
-- , "sf32" .= sf32
-- ]
-- toEncodingPB (Scalar32 i32 u32 s32 f32 sf32) = pairs
-- [ "i32" .= i32
-- , "u32" .= u32
-- , "s32" .= s32
-- , "f32" .= f32
-- , "sf32" .= sf32
-- ]
--
-- instance FromJSONPB Scalar32 where
-- parseJSONPB = withObject "Scalar32" $ \obj ->
-- pure Scalar32
-- <*> obj .: "i32"
-- <*> obj .: "u32"
-- <*> obj .: "s32"
-- <*> obj .: "f32"
-- <*> obj .: "sf32"
-- @
module Proto3.Suite.JSONPB.Class where
import qualified Data.Aeson as A (Encoding, FromJSON (..),
FromJSONKey (..),
FromJSONKeyFunction (..),
ToJSON (..), Value (..),
eitherDecode, json,
(.!=))
import qualified Data.Aeson.Encoding as E
import qualified Data.Aeson.Internal as A (formatError, iparse)
import qualified Data.Aeson.Parser as A (eitherDecodeWith)
import qualified Data.Aeson.Types as A (Object, Pair, Parser,
Series,
explicitParseField,
explicitParseFieldMaybe,
object, typeMismatch)
import qualified Data.Attoparsec.ByteString as Atto (skipWhile)
import qualified Data.Attoparsec.ByteString.Char8 as Atto (Parser, endOfInput)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as LBS
import Data.Coerce
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Vector as V
import GHC.Int (Int32, Int64)
import GHC.Word (Word32, Word64)
import Proto3.Suite.Class (HasDefault (def, isDefault),
Named (nameOf))
import Proto3.Suite.Types (Enumerated (..), Fixed (..))
-- * Typeclass definitions
-- | 'A.ToJSON' variant for JSONPB direct encoding via 'A.Encoding'
class ToJSONPB a where
-- | 'A.toJSON' variant for JSONPB encoders.
toJSONPB :: a -> Options -> A.Value
-- | 'A.toEncoding' variant for JSONPB encoders. If an implementation is not
-- provided, uses 'toJSONPB' (which is less efficient since it indirects
-- through the 'A.Value' IR).
toEncodingPB :: a -> Options -> A.Encoding
toEncodingPB x = A.toEncoding . toJSONPB x
-- | 'A.FromJSON' variant for JSONPB decoding from the 'A.Value' IR
class FromJSONPB a where
-- | 'A.parseJSON' variant for JSONPB decoders.
parseJSONPB :: A.Value -> A.Parser a
-- * JSONPB codec entry points
-- | 'Data.Aeson.encode' variant for serializing a JSONPB value as a lazy
-- 'LBS.ByteString'.
encode :: ToJSONPB a => Options -> a -> LBS.ByteString
encode opts x = E.encodingToLazyByteString (toEncodingPB x opts)
{-# INLINE encode #-}
-- | 'Data.Aeson.eitherDecode' variant for deserializing a JSONPB value from a
-- lazy 'LBS.ByteString'.
eitherDecode :: FromJSONPB a => LBS.ByteString -> Either String a
eitherDecode = eitherFormatError . A.eitherDecodeWith jsonEOF (A.iparse parseJSONPB)
where
eitherFormatError = either (Left . uncurry A.formatError) Right
{-# INLINE eitherFormatError #-}
-- NB: cribbed from aeson-1.1.1.0:Data.Aeson.Parser.Internal.jsonEOF, which
-- is not exported. It's simple, so we just inline it here. Might be worth
-- submitting a PR to export this.
jsonEOF :: Atto.Parser A.Value
jsonEOF = A.json <* skipSpace <* Atto.endOfInput
where
skipSpace :: Atto.Parser ()
skipSpace = Atto.skipWhile $ \w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09
{-# INLINE skipSpace #-}
{-# INLINE eitherDecode #-}
-- * Operator definitions
-- | JSONPB-encoded monoidal key-value pairs
class Monoid m => KeyValuePB m where
pair :: ToJSONPB v => Text -> v -> Options -> m
instance KeyValuePB A.Series where pair k v opts = E.pair k (toEncodingPB v opts)
instance KeyValuePB [A.Pair] where pair k v opts = pure (k, toJSONPB v opts)
-- | Construct a monoidal key-value pair, using 'mempty' to represent omission
-- of default values (unless the given 'Options' force their emission).
(.=) :: (HasDefault v, ToJSONPB v, KeyValuePB kvp) => Text -> v -> Options -> kvp
k .= v = mk
where
mk opts@Options{..}
| not optEmitDefaultValuedFields && isDefault v
= mempty
| otherwise
= pair k v opts
-- | 'Data.Aeson..:' variant for JSONPB; if the given key is missing from the
-- object, or if it is present but its value is null, we produce the default
-- protobuf value for the field type
(.:) :: (FromJSONPB a, HasDefault a) => A.Object -> Text -> A.Parser a
obj .: key = obj .:? key A..!= def
where
(.:?) = A.explicitParseFieldMaybe parseJSONPB
parseField :: FromJSONPB a
=> A.Object -> Text -> A.Parser a
parseField = A.explicitParseField parseJSONPB
-- * JSONPB rendering and parsing options
data Options = Options
{ optEmitDefaultValuedFields :: Bool
} deriving Show
-- | Default options for JSONPB encoding. By default, all options are @False@.
defaultOptions :: Options
defaultOptions = Options
{ optEmitDefaultValuedFields = False
}
-- * Helper types and functions
dropNamedPrefix :: Named a => Proxy a -> String -> String
dropNamedPrefix p = drop (length (nameOf p :: String))
object :: [Options -> [A.Pair]] -> Options -> A.Value
object fs = A.object . mconcat fs
pairs :: [Options -> A.Series] -> Options -> E.Encoding
pairs fs = E.pairs . mconcat fs
enumFieldString :: forall a. (Named a, Show a) => a -> A.Value
enumFieldString = A.String . T.pack . dropNamedPrefix (Proxy @a) . show
enumFieldEncoding :: forall a. (Named a, Show a) => a -> A.Encoding
enumFieldEncoding = E.string . dropNamedPrefix (Proxy @a) . show
-- | A 'Data.Aeson' 'A.Value' encoder for values which can be
-- JSONPB-encoded
toAesonValue :: ToJSONPB a => a -> A.Value
toAesonValue = flip toJSONPB defaultOptions
-- | A direct 'A.Encoding' for values which can be JSONPB-encoded
toAesonEncoding :: ToJSONPB a => a -> A.Encoding
toAesonEncoding = flip toEncodingPB defaultOptions
-- | Parse a JSONPB floating point value; first parameter provides context for
-- type mismatches
parseFP :: (A.FromJSON a, A.FromJSONKey a) => String -> A.Value -> A.Parser a
parseFP tyDesc v = case v of
A.Number{} -> A.parseJSON v
A.String t -> case A.fromJSONKey of
A.FromJSONKeyTextParser p
-> p t
_ -> fail "internal: parseKeyPB: unexpected FromJSONKey summand"
_ -> A.typeMismatch tyDesc v
-- | Liberally parse an integer value (e.g. 42 or "42" as 42); first parameter
-- provides context for type mismatches
parseNumOrDecimalString :: (A.FromJSON a) => String -> A.Value -> A.Parser a
parseNumOrDecimalString tyDesc v = case v of
A.Number{} -> A.parseJSON v
A.String t -> either fail pure . A.eitherDecode . TL.encodeUtf8 . TL.fromStrict $ t
_ -> A.typeMismatch tyDesc v
-- * Common instances for jsonpb codec implementations
-- ** Instances for scalar types
--------------------------------------------------------------------------------
-- Boolean scalar type
instance ToJSONPB Bool where
toJSONPB = const . A.toJSON
toEncodingPB = const . A.toEncoding
instance FromJSONPB Bool where
parseJSONPB = A.parseJSON
--------------------------------------------------------------------------------
-- Integer scalar types
--
-- * 32 bit integer values render to JSON decimal numbers; either numbers or
-- strings are accepted.
--
-- * 64 bit integer values render to JSON decimal strings; either numbers
-- or strings are accepted.
--
-- int32 / sint32
instance ToJSONPB Int32 where
toJSONPB = const . A.toJSON
toEncodingPB = const . A.toEncoding
instance FromJSONPB Int32 where
parseJSONPB = parseNumOrDecimalString "int32 / sint32"
-- uint32
instance ToJSONPB Word32 where
toJSONPB = const . A.toJSON
toEncodingPB = const . A.toEncoding
instance FromJSONPB Word32 where
parseJSONPB = parseNumOrDecimalString "uint32"
-- int64 / sint64
instance ToJSONPB Int64 where
toJSONPB x _ = A.String . T.pack . show $ x
toEncodingPB x _ = E.string (show x)
instance FromJSONPB Int64 where
parseJSONPB = parseNumOrDecimalString "int64 / sint64"
-- unit64
instance ToJSONPB Word64 where
toJSONPB x _ = A.String . T.pack . show $ x
toEncodingPB x _ = E.string (show x)
instance FromJSONPB Word64 where
parseJSONPB = parseNumOrDecimalString "int64 / sint64"
-- fixed32
instance ToJSONPB (Fixed Word32) where
toJSONPB = coerce (toJSONPB @Word32)
toEncodingPB = coerce (toEncodingPB @Word32)
instance FromJSONPB (Fixed Word32) where
parseJSONPB = coerce (parseJSONPB @Word32)
-- fixed64
instance ToJSONPB (Fixed Word64) where
toJSONPB = coerce (toJSONPB @Word64)
toEncodingPB = coerce (toEncodingPB @Word64)
instance FromJSONPB (Fixed Word64) where
parseJSONPB = coerce (parseJSONPB @Word64)
-- sfixed32
instance ToJSONPB (Fixed Int32) where
toJSONPB = coerce (toJSONPB @Int32)
toEncodingPB = coerce (toEncodingPB @Int32)
instance FromJSONPB (Fixed Int32) where
parseJSONPB = coerce (parseJSONPB @Int32)
-- sfixed64
instance ToJSONPB (Fixed Int64) where
toJSONPB = coerce (toJSONPB @Int64)
toEncodingPB = coerce (toEncodingPB @Int64)
instance FromJSONPB (Fixed Int64) where
parseJSONPB = coerce (parseJSONPB @Int64)
--------------------------------------------------------------------------------
-- Floating point scalar types
--
-- JSON value will be a number or one of the special string values "NaN",
-- "Infinity", and "-Infinity". Either numbers or strings are accepted. Exponent
-- notation is also accepted.
-- float
instance ToJSONPB Float where
toJSONPB = const . A.toJSON
toEncodingPB = const . A.toEncoding
instance FromJSONPB Float where
parseJSONPB = parseFP "float"
-- double
instance ToJSONPB Double where
toJSONPB = const . A.toJSON
toEncodingPB = const . A.toEncoding
instance FromJSONPB Double where
parseJSONPB = parseFP "double"
--------------------------------------------------------------------------------
-- Stringly types (string and bytes)
-- string
instance ToJSONPB TL.Text where
toJSONPB = const . A.toJSON
toEncodingPB = const . A.toEncoding
instance FromJSONPB TL.Text where
parseJSONPB = A.parseJSON
-- bytes
bsToJSONPB :: BS.ByteString -> A.Value
bsToJSONPB (T.decodeUtf8' . B64.encode -> ebs) = case ebs of
Right bs -> A.toJSON bs
Left e -> error ("internal: failed to encode B64-encoded bytestring: " ++ show e)
-- NB: T.decodeUtf8' should never fail because we B64-encode the
-- incoming bytestring.
instance ToJSONPB BS.ByteString where
toJSONPB bs _ = bsToJSONPB bs
toEncodingPB bs opts = E.value (toJSONPB bs opts)
instance FromJSONPB BS.ByteString where
parseJSONPB (A.String b64enc) = pure . B64.decodeLenient . T.encodeUtf8 $ b64enc
parseJSONPB v = A.typeMismatch "bytes" v
--------------------------------------------------------------------------------
-- Enumerated types
enumToJSONPB :: (e -> Options -> a) -- ^ JSONPB encoder function to use
-> a -- ^ null value to use for out-of-range enums
-> Enumerated e -- ^ the enumerated value to encode
-> Options -- ^ JSONPB encoding options
-> a -- ^ the JSONPB-encoded value
enumToJSONPB enc null_ (Enumerated e) opts = either err (`enc` opts) e
where
err 0 = error "enumToJSONPB: The first enum value must be zero in proto3"
-- TODO: Raise a compilation error when the first enum value in an
-- enumeration is not zero.
--
-- See https://github.com/awakesecurity/proto3-suite/issues/28
--
-- The proto3 spec states that the default value is the first
-- defined enum value, which must be 0. Since we currently don't
-- raise a compilation error for this like we should, we have to
-- handle this case.
--
-- For now, die horribly to mimic what should be a compilation
-- error.
err _ = null_
-- From the JSONPB spec:
--
-- If a value is missing in the JSON-encoded data or if its value
-- is null, it will be interpreted as the appropriate default
-- value when parsed into a protocol buffer.
--
-- Thus, interpreting a wire value out of enum range as "missing",
-- we yield null here to mean the default value.
instance ToJSONPB e => ToJSONPB (Enumerated e) where
toJSONPB = enumToJSONPB toJSONPB A.Null
toEncodingPB = enumToJSONPB toEncodingPB E.null_
instance (Bounded e, Enum e, FromJSONPB e) => FromJSONPB (Enumerated e) where
parseJSONPB A.Null = pure def -- So CG does not have to handle this case in
-- every generated instance
parseJSONPB v = Enumerated . Right <$> parseJSONPB v
-- ** Instances for composite types
--------------------------------------------------------------------------------
-- Instances for repeated messages
--
-- JSON value will be the vector elements encoded as a JSON array. The null
-- value is accepted as the empty list, @[]@.
instance ToJSONPB a => ToJSONPB (V.Vector a) where
toJSONPB v opts = A.Array (V.map (`toJSONPB` opts) v)
toEncodingPB v opts = E.list (`toEncodingPB` opts) (V.toList v)
instance FromJSONPB a => FromJSONPB (V.Vector a) where
parseJSONPB (A.Array vs) = mapM parseJSONPB vs
parseJSONPB A.Null = pure []
parseJSONPB v = A.typeMismatch "repeated" v
--------------------------------------------------------------------------------
-- Instances for nested messages
instance ToJSONPB a => ToJSONPB (Maybe a) where
toJSONPB mx opts = maybe A.Null (`toJSONPB` opts) mx
toEncodingPB mx opts = maybe E.null_ (`toEncodingPB` opts) mx
instance FromJSONPB a => FromJSONPB (Maybe a) where
parseJSONPB A.Null = pure Nothing
parseJSONPB v = fmap Just (parseJSONPB v)

138
nix/third-party/proto3-suite/src/Proto3/Suite/Tutorial.hs vendored
View File

@ -1,138 +0,0 @@
-- |
-- = Tutorial
--
-- >>> :set -XOverloadedStrings
--
-- This module contains a worked example of encoding and decoding messages,
-- and exporting a corresponding .proto file from Haskell types.
--
-- == Setup
--
-- If you are using "GHC.Generics", you should enable the generic deriving
-- extension, and import the main module:
--
-- > {-# LANGUAGE DeriveGeneric #-}
--
-- > import Proto3.Suite
-- > import GHC.Generics
--
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Proto3.Suite.Tutorial where
import Data.Int (Int32)
import Proto3.Suite (Enumerated, Nested, NestedVec, PackedVec,
Message, Named, Finite,
DotProtoDefinition, enum, message, packageFromDefs, toProtoFileDef)
import Data.Proxy
import Data.Word (Word32)
import GHC.Generics
-- |
-- == Defining Message Types
--
-- Define messages using Haskell record types. You can use any 'MessageField' types
-- in your records, and the correct serializer and deserializer will be generated
-- for you.
--
-- Make sure to derive a 'Generic' instance for your type, and then derive instances
-- for 'Message' and 'Named' using the default (empty) instances:
--
-- > instance Message Foo
-- > instance Named Foo
--
-- == Encoding Messages
--
-- Now we can encode a value of type 'Foo' using 'Proto3.Suite.toLazyByteString'.
--
-- For example:
--
-- >>> Proto3.Suite.toLazyByteString (Foo 42 (Proto3.Suite.PackedVec (pure 123)))
-- "\b*\DC2\SOH{"
--
-- We can also decode messages using `fromByteString`:
--
-- >>> Proto3.Suite.fromByteString "\b*\DC2\SOH{" :: Either [Proto3.Suite..Decode.Parser.ParseError] Foo
-- Right (Foo {fooX = 42, fooY = PackedVec {packedvec = [123]}})
data Foo = Foo
{ fooX :: Word32
, fooY :: PackedVec Int32
} deriving (Show, Eq, Generic)
instance Message Foo
instance Named Foo
-- |
-- == Nested Messages
--
-- Messages can contain other messages, by using the 'Nested' constructor, and
-- lists of nested messages using the 'NestedVec constructor'.
data Bar = Bar
{ barShape :: Enumerated Shape
, barFoo :: Nested Foo
, foos :: NestedVec Foo
}
deriving (Eq, Generic)
instance Message Bar
instance Named Bar
-- |
-- == Enumerations
--
-- Enumerated types can be used by deriving the 'Enum', 'Finite' and 'Named'
-- classes. Each of these instances are implied by a 'Generic' instance, so can
-- be derived as follows:
--
-- > data Shape
-- > = Circle
-- > | Square
-- > | Triangle
-- > deriving (Generic, Enum, Finite, Named)
data Shape
= Circle
| Square
| Triangle
deriving (Bounded, Eq, Enum, Finite, Generic, Named, Ord)
-- |
-- == Generating a .proto file
--
-- We can generate a .proto file for the 'Foo' and 'Bar' data types by
-- using the 'toProtoFileDef' function. We have to provide a package name, and
-- explicitly list the message and enumeration types as a 'DotProto' value.
--
-- >>> putStrLn protoFile
-- syntax = "proto3";
-- package examplePackageName;
-- enum Shape {
-- Circle = 0;
-- Square = 1;
-- Triangle = 2;
-- }
-- message Foo {
-- uint32 fooX = 1;
-- repeated int32 fooY = 2 [packed=true];
-- }
-- message Bar {
-- Shape barShape = 1;
-- Foo barFoo = 2;
-- repeated Foo foos = 3 [packed=false];
-- }
protoFile :: String
protoFile = toProtoFileDef $ packageFromDefs "examplePackageName"
([ enum (Proxy :: Proxy Shape)
, message (Proxy :: Proxy Foo)
, message (Proxy :: Proxy Bar)
] :: [DotProtoDefinition])

115
nix/third-party/proto3-suite/src/Proto3/Suite/Types.hs vendored
View File

@ -1,115 +0,0 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ExplicitNamespaces #-}
module Proto3.Suite.Types
(
-- * Integral Types
Fixed(..)
, Signed(..)
-- * Enumerable Types
, Enumerated(..)
, ForceEmit(..)
, Nested(..)
, UnpackedVec(..)
, PackedVec(..)
, NestedVec(..)
, Commented(..)
, type (//)()
) where
import Control.Applicative
import Control.DeepSeq (NFData)
import GHC.Exts (IsList(..))
import GHC.Generics
import qualified Data.Vector as V
import GHC.TypeLits (Symbol)
import Test.QuickCheck (Arbitrary(..))
-- | 'Fixed' provides a way to encode integers in the fixed-width wire formats.
newtype Fixed a = Fixed { fixed :: a }
deriving (Show, Eq, Ord, Num, Generic, NFData, Arbitrary, Enum, Bounded, Functor)
-- | 'Signed' provides a way to encode integers in the signed wire formats.
newtype Signed a = Signed { signed :: a }
deriving (Show, Eq, Ord, Num, Generic, NFData, Arbitrary, Bounded)
-- | 'Enumerated' lifts any type with an 'IsEnum' instance so that it can be encoded
-- with 'HasEncoding'.
newtype Enumerated a = Enumerated { enumerated :: Either Int a }
deriving (Show, Eq, Ord, Generic, NFData)
instance (Bounded a, Enum a) => Arbitrary (Enumerated a) where
arbitrary = do
i <- arbitrary
if i < fromEnum (minBound :: a) || i > fromEnum (maxBound :: a)
then return $ Enumerated $ Left i
else return $ Enumerated $ Right (toEnum i)
-- | 'PackedVec' provides a way to encode packed lists of basic protobuf types into
-- the wire format.
newtype PackedVec a = PackedVec { packedvec :: V.Vector a }
deriving (Show, Eq, Functor, Foldable, Traversable, Ord, NFData, Applicative,
Alternative, Monoid, Semigroup)
instance IsList (PackedVec a) where
type Item (PackedVec a) = a
fromList = PackedVec . V.fromList
toList = V.toList . packedvec
instance Arbitrary a => Arbitrary (PackedVec a) where
arbitrary = fmap (PackedVec . V.fromList) arbitrary
newtype UnpackedVec a = UnpackedVec {unpackedvec :: V.Vector a }
deriving (Show, Eq, Functor, Foldable, Traversable, Ord, NFData, Applicative,
Alternative, Monoid, Semigroup)
instance IsList (UnpackedVec a) where
type Item (UnpackedVec a) = a
fromList = UnpackedVec . V.fromList
toList = V.toList . unpackedvec
instance Arbitrary a => Arbitrary (UnpackedVec a) where
arbitrary = fmap (UnpackedVec . V.fromList) arbitrary
newtype NestedVec a =
NestedVec { nestedvec :: V.Vector a }
deriving (Show, Eq, Functor, Foldable, Traversable, Ord, NFData, Applicative,
Alternative, Monoid, Semigroup)
instance IsList (NestedVec a) where
type Item (NestedVec a) = a
fromList = NestedVec . V.fromList
toList = V.toList . nestedvec
instance Arbitrary a => Arbitrary (NestedVec a) where
arbitrary = fmap (NestedVec . V.fromList) arbitrary
-- | 'Nested' provides a way to nest protobuf messages within protobuf messages.
newtype Nested a = Nested { nested :: Maybe a }
deriving (Show, Eq, Ord, Generic, NFData, Monoid, Semigroup, Arbitrary, Functor, Foldable,
Traversable, Applicative, Alternative, Monad)
-- | 'ForceEmit' provides a way to force emission of field values, even when
-- default-value semantics states otherwise. Used when serializing oneof
-- subfields.
newtype ForceEmit a = ForceEmit{ forceEmit :: a }
deriving (Show, Eq, Ord, Generic, NFData, Monoid, Semigroup, Arbitrary, Functor, Foldable,
Traversable)
-- | 'Commented' provides a way to add comments to generated @.proto@ files.
newtype Commented (comment :: Symbol) a = Commented { unCommented :: a }
deriving (Show, Eq, Ord, Generic, NFData, Monoid, Semigroup, Arbitrary, Functor, Foldable, Traversable)
-- | A type operator synonym for 'Commented', so that we can write C-style
-- comments on fields.
type a // (comment :: Symbol) = Commented comment a

19
nix/third-party/proto3-suite/stack.yaml vendored
View File

@ -1,19 +0,0 @@
resolver: lts-7.4
packages:
- .
- location:
git: https://github.com/awakenetworks/proto3-wire.git
commit: a938330bf794cf3fa05591d03906915df98d157c
extra-dep: true
extra-deps: [ aeson-1.1.1.0
, aeson-pretty-0.8.2
, cabal-doctest-1.0.2
, insert-ordered-containers-0.2.1.0
, neat-interpolation-0.3.2.1
, optparse-applicative-0.13.2.0
, optparse-generic-1.2.1
, swagger2-2.1.6
, turtle-1.3.6
]

BIN
nix/third-party/proto3-suite/test-files/all_packed_types.bin vendored
View File

Binary file not shown.

104
nix/third-party/proto3-suite/test-files/make_reference_encodings.py vendored
View File

@ -1,104 +0,0 @@
# Generates the test-files/*.bin files used in the unit tests.
import test_proto_pb2
def serialize_to_file(msg, fp):
with open(fp, 'wb') as f:
f.write(msg.SerializeToString())
def main():
triv = test_proto_pb2.Trivial()
triv.trivialField = 123
serialize_to_file(triv, 'trivial.bin')
multipleFields = test_proto_pb2.MultipleFields()
multipleFields.multiFieldDouble = 1.23
multipleFields.multiFieldFloat = -0.5
multipleFields.multiFieldInt32 = 123
multipleFields.multiFieldInt64 = 1234567890
multipleFields.multiFieldString = "Hello, world!"
multipleFields.multiFieldBool = True
serialize_to_file(multipleFields, 'multiple_fields.bin')
signedints= test_proto_pb2.SignedInts()
signedints.signed32 = -42
signedints.signed64 = -84
serialize_to_file(signedints, 'signedints.bin')
withEnum = test_proto_pb2.WithEnum()
withEnum.enumField = test_proto_pb2.WithEnum.ENUM1
serialize_to_file(withEnum, 'with_enum0.bin')
withEnum = test_proto_pb2.WithEnum()
withEnum.enumField = test_proto_pb2.WithEnum.ENUM2
serialize_to_file(withEnum, 'with_enum1.bin')
withNesting = test_proto_pb2.WithNesting()
withNesting.nestedMessage.nestedField1 = "123abc"
withNesting.nestedMessage.nestedField2 = 123456
serialize_to_file(withNesting, 'with_nesting.bin')
withNestingRepeated = test_proto_pb2.WithNestingRepeated()
msg1 = withNestingRepeated.nestedMessages.add()
msg1.nestedField1 = "123abc"
msg1.nestedField2 = 123456
msg1.nestedPacked.extend([1,2,3,4])
msg1.nestedUnpacked.extend([5,6,7,8])
msg2 = withNestingRepeated.nestedMessages.add()
msg2.nestedField1 = "abc123"
msg2.nestedField2 = 654321
msg2.nestedPacked.extend([0,9,8,7])
msg2.nestedUnpacked.extend([6,5,4,3])
serialize_to_file(withNestingRepeated, "with_nesting_repeated.bin")
nestingRepeatedMissingFields = test_proto_pb2.WithNestingRepeatedInts()
msg1 = nestingRepeatedMissingFields.nestedInts.add()
msg1.nestedInt1 = 0
msg1.nestedInt2 = 2
msg2 = nestingRepeatedMissingFields.nestedInts.add()
msg2.nestedInt1 = 2
msg2.nestedInt2 = 0
serialize_to_file(nestingRepeatedMissingFields, "with_nesting_ints.bin")
withRepetition = test_proto_pb2.WithRepetition()
withRepetition.repeatedField1.extend([1,2,3,4,5])
serialize_to_file(withRepetition, 'with_repetition.bin')
trivNeg = test_proto_pb2.Trivial()
trivNeg.trivialField = -1
serialize_to_file(trivNeg, 'trivial_negative.bin')
withFixed = test_proto_pb2.WithFixed()
withFixed.fixed1 = 16
withFixed.fixed2 = -123
withFixed.fixed3 = 4096
withFixed.fixed4 = -4096
serialize_to_file(withFixed, 'with_fixed.bin')
withBytes = test_proto_pb2.WithBytes()
withBytes.bytes1 = "abc"
withBytes.bytes2.extend(["abc", "123"])
serialize_to_file(withBytes, "with_bytes.bin")
withPacking = test_proto_pb2.WithPacking()
withPacking.packing1.extend([1,2,3])
withPacking.packing2.extend([1,2,3])
serialize_to_file(withPacking, "with_packing.bin")
allPackedTypes = test_proto_pb2.AllPackedTypes()
allPackedTypes.packedWord32.extend([1,2,3])
allPackedTypes.packedWord64.extend([1,2,3])
allPackedTypes.packedInt32.extend([-1,-2,-3])
allPackedTypes.packedInt64.extend([-1,-2,-3])
allPackedTypes.packedFixed32.extend([1,2,3])
allPackedTypes.packedFixed64.extend([1,2,3])
allPackedTypes.packedFloat.extend([1.0,2.0])
allPackedTypes.packedDouble.extend([1.0,-1.0])
allPackedTypes.packedSFixed32.extend([1,2,3])
allPackedTypes.packedSFixed64.extend([1,2,3])
allPackedTypes.packedBool.extend([False,True])
allPackedTypes.packedEnum.extend([test_proto_pb2.FLD0,test_proto_pb2.FLD1])
allPackedTypes.unpackedEnum.extend([test_proto_pb2.FLD0,test_proto_pb2.FLD1])
serialize_to_file(allPackedTypes, "all_packed_types.bin")
if __name__ == '__main__':
main()

BIN
nix/third-party/proto3-suite/test-files/multiple_fields.bin vendored
View File

Binary file not shown.

1
nix/third-party/proto3-suite/test-files/signedints.bin vendored
View File

@ -1 +0,0 @@
S<10>

142
nix/third-party/proto3-suite/test-files/test_proto.proto vendored
View File

@ -1,142 +0,0 @@
syntax = "proto3";
package TestProto;
import "test_proto_import.proto";
message Trivial {
int32 trivialField = 1;
}
message MultipleFields {
double multiFieldDouble = 1;
float multiFieldFloat = 2;
int32 multiFieldInt32 = 3;
int64 multiFieldInt64 = 4;
string multiFieldString = 5;
bool multiFieldBool = 6;
}
message SignedInts {
sint32 signed32 = 1;
sint64 signed64 = 2;
}
message WithEnum {
enum TestEnum {
ENUM1 = 0;
ENUM2 = 1;
ENUM3 = 2;
}
TestEnum enumField = 1;
}
message WithNesting {
message Nested {
string nestedField1 = 1;
int32 nestedField2 = 2;
repeated int32 nestedPacked = 3 [packed=true];
repeated int32 nestedUnpacked = 4 [packed=false];
}
Nested nestedMessage = 1;
}
message WithNestingRepeated {
message Nested {
string nestedField1 = 1;
int32 nestedField2 = 2;
repeated int32 nestedPacked = 3 [packed=true];
repeated int32 nestedUnpacked = 4 [packed=false];
}
repeated Nested nestedMessages = 1;
}
message NestedInts {
int32 nestedInt1 = 1;
int32 nestedInt2 = 2;
}
message WithNestingRepeatedInts {
repeated NestedInts nestedInts = 1;
}
message WithNestingInts {
NestedInts nestedInts = 1;
}
message WithRepetition {
repeated int32 repeatedField1 = 1;
}
message WithFixed {
fixed32 fixed1 = 1;
sfixed32 fixed2 = 2;
fixed64 fixed3 = 3;
sfixed64 fixed4 = 4;
}
message WithBytes {
bytes bytes1 = 1;
repeated bytes bytes2 = 2;
}
message WithPacking {
repeated int32 packing1 = 1 [packed=false];
repeated int32 packing2 = 2 [packed=true];
}
enum E { FLD0 = 0; FLD1 = 1; }
message AllPackedTypes {
repeated uint32 packedWord32 = 1 [packed=true];
repeated uint64 packedWord64 = 2 [packed=true];
repeated int32 packedInt32 = 3 [packed=true];
repeated int64 packedInt64 = 4 [packed=true];
repeated fixed32 packedFixed32 = 5 [packed=true];
repeated fixed64 packedFixed64 = 6 [packed=true];
repeated float packedFloat = 7 [packed=true];
repeated double packedDouble = 8 [packed=true];
repeated sfixed32 packedSFixed32 = 9 [packed=true];
repeated sfixed64 packedSFixed64 = 10 [packed=true];
repeated bool packedBool = 11 [packed=true];
repeated E packedEnum = 12 [packed=true];
repeated E unpackedEnum = 13 [packed=false];
}
message OutOfOrderFields {
repeated uint32 field1 = 2001 [packed = true];
string field2 = 101;
int64 field3 = 30;
repeated string field4 = 1002;
}
message ShadowedMessage {
string name = 2;
int32 value = 1;
}
message MessageShadower {
message ShadowedMessage {
string name = 1;
string value = 2; // Same as ShadowedMessage above, but with field numbers flipped, and different types for value
}
ShadowedMessage shadowed_message = 1;
string name = 2; // Tests if the field names are shadowed or not
}
message WithQualifiedName {
ShadowedMessage qname1 = 100;
MessageShadower.ShadowedMessage qname2 = 200;
}
message UsingImported {
TestProtoImport.WithNesting importedNesting = 100;
WithNesting localNesting = 200;
}
message Wrapped {
Wrapped wrapped = 1;
}
enum EnumAnnots {
FOO = 0;
BAR = 1 [deprecated=true];
}

11
nix/third-party/proto3-suite/test-files/test_proto_import.proto vendored
View File

@ -1,11 +0,0 @@
syntax="proto3";
package TestProtoImport;
message WithNesting {
message Nested {
int32 nestedField1 = 1;
int32 nestedField2 = 2;
}
Nested nestedMessage1 = 1;
Nested nestedMessage2 = 100;
}

54
nix/third-party/proto3-suite/test-files/test_proto_oneof.proto vendored
View File

@ -1,54 +0,0 @@
syntax = "proto3";
package TestProtoOneof;
import "test_proto_oneof_import.proto";
message DummyMsg {
int32 dummy = 1;
}
enum DummyEnum {
DUMMY0 = 0;
DUMMY1 = 1;
}
// Also handles the case where the oneof field is syntatically the last one in
// the message (this exercises field ordering logic in the code generator)
message Something {
sint64 value = 1;
sint32 another = 2;
oneof pickOne {
string name = 4;
int32 someid = 9;
DummyMsg dummyMsg1 = 10;
DummyMsg dummyMsg2 = 11;
DummyEnum dummyEnum = 12;
}
}
// Handles the case where the oneof field is syntatically the first one in the
// message (this exercises field ordering logic in the code generator)
message OneofFirst {
oneof first {
string choice1 = 1;
string choice2 = 2;
}
int32 last = 3;
}
// Handles the case where the oneof field is syntatically between other fields
// in the message (this exercises field ordering logic in the code generator)
message OneofMiddle {
int32 first = 1;
oneof middle {
string choice1 = 2;
string choice2 = 3;
}
int32 last = 4;
}
message WithImported {
oneof pickOne {
DummyMsg dummyMsg1 = 1;
TestProtoOneofImport.WithOneof withOneof = 2;
}
}

8
nix/third-party/proto3-suite/test-files/test_proto_oneof_import.proto vendored
View File

@ -1,8 +0,0 @@
syntax="proto3";
package TestProtoOneofImport;
message WithOneof {
oneof pickOne {
string a = 1;
int32 b = 2;
}
}

1
nix/third-party/proto3-suite/test-files/trivial.bin vendored
View File

@ -1 +0,0 @@
{

1
nix/third-party/proto3-suite/test-files/trivial.proto vendored
View File

@ -1 +0,0 @@
syntax = "proto3";

1
nix/third-party/proto3-suite/test-files/trivial_negative.bin vendored
View File

@ -1 +0,0 @@
<08><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>

2
nix/third-party/proto3-suite/test-files/with_bytes.bin vendored
View File

@ -1,2 +0,0 @@
abcabc123

0
nix/third-party/proto3-suite/test-files/with_enum0.bin vendored
View File

1
nix/third-party/proto3-suite/test-files/with_enum1.bin vendored
View File

@ -1 +0,0 @@


BIN
nix/third-party/proto3-suite/test-files/with_fixed.bin vendored
View File

Binary file not shown.

3
nix/third-party/proto3-suite/test-files/with_nesting.bin vendored
View File

@ -1,3 +0,0 @@
123abcﾀﾄ

3
nix/third-party/proto3-suite/test-files/with_nesting_ints.bin vendored
View File

@ -1,3 +0,0 @@



3
nix/third-party/proto3-suite/test-files/with_nesting_maybe.bin vendored
View File

@ -1,3 +0,0 @@
123abcﾀﾄ

BIN
nix/third-party/proto3-suite/test-files/with_nesting_repeated.bin vendored
View File

Binary file not shown.

1
nix/third-party/proto3-suite/test-files/with_packing.bin vendored
View File

@ -1 +0,0 @@


2
nix/third-party/proto3-suite/test-files/with_repetition.bin vendored
View File

@ -1,2 +0,0 @@


5
nix/third-party/proto3-suite/tests/.gitattributes vendored
View File

@ -1,5 +0,0 @@
TestProto.hs linguist-generated
TestProtoImport.hs linguist-generated
TestProtoOneof.hs linguist-generated
TestProtoOneofImport.hs linguist-generated

165
nix/third-party/proto3-suite/tests/ArbitraryGeneratedTestTypes.hs vendored
View File

@ -1,165 +0,0 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
module ArbitraryGeneratedTestTypes where
import qualified Data.ByteString as BS
import qualified Data.Text.Lazy as T
import qualified Data.Vector as V
import qualified Proto3.Suite.Types as DotProto
import Test.QuickCheck (Arbitrary, arbitrary,
arbitraryBoundedEnum, listOf)
import qualified Test.QuickCheck as QC
import TestProto
import qualified TestProtoImport
import qualified TestProtoOneof
import qualified TestProtoOneofImport
instance Arbitrary a => Arbitrary (V.Vector a) where
arbitrary = V.fromList <$> listOf arbitrary
instance Arbitrary Trivial where
arbitrary = Trivial <$> arbitrary
instance Arbitrary MultipleFields where
arbitrary =
MultipleFields
<$> arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
<*> fmap T.pack arbitrary
<*> arbitrary
instance Arbitrary WithEnum_TestEnum where
arbitrary = arbitraryBoundedEnum
instance Arbitrary WithEnum where
arbitrary = WithEnum <$> arbitrary
instance Arbitrary WithNesting_Nested where
arbitrary =
WithNesting_Nested
<$> fmap T.pack arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary WithNesting where
arbitrary = WithNesting <$> arbitrary
instance Arbitrary WithRepetition where
arbitrary = WithRepetition <$> arbitrary
instance Arbitrary WithFixed where
arbitrary = WithFixed <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
instance Arbitrary WithBytes where
arbitrary = WithBytes <$> arbitrary <*> arbitrary
instance Arbitrary BS.ByteString where
arbitrary = BS.pack <$> arbitrary
instance Arbitrary AllPackedTypes where
arbitrary = do
AllPackedTypes
<$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
<*> arbitrary <*> arbEnums <*> arbEnums
where
arbEnums = V.fromList <$> listOf (DotProto.Enumerated . Right <$> arbitraryBoundedEnum)
instance Arbitrary SignedInts where
arbitrary = SignedInts <$> arbitrary <*> arbitrary
instance Arbitrary WithNestingRepeated where
arbitrary = WithNestingRepeated <$> arbitrary
instance Arbitrary WithNestingRepeated_Nested where
arbitrary =
WithNestingRepeated_Nested
<$> fmap T.pack arbitrary
<*> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary WithNestingRepeatedInts where
arbitrary = WithNestingRepeatedInts <$> arbitrary
instance Arbitrary NestedInts where
arbitrary = NestedInts <$> arbitrary <*> arbitrary
instance Arbitrary OutOfOrderFields where
arbitrary =
OutOfOrderFields
<$> arbitrary
<*> fmap T.pack arbitrary
<*> arbitrary
<*> fmap (fmap T.pack) arbitrary
instance Arbitrary UsingImported where
arbitrary =
UsingImported
<$> arbitrary
<*> arbitrary
instance Arbitrary TestProtoImport.WithNesting where
arbitrary =
TestProtoImport.WithNesting
<$> arbitrary
<*> arbitrary
instance Arbitrary TestProtoImport.WithNesting_Nested where
arbitrary =
TestProtoImport.WithNesting_Nested
<$> arbitrary
<*> arbitrary
instance Arbitrary Wrapped where
arbitrary = Wrapped <$> arbitrary
instance Arbitrary TestProtoOneof.DummyMsg where
arbitrary =
TestProtoOneof.DummyMsg
<$> arbitrary
instance Arbitrary TestProtoOneof.Something where
arbitrary =
TestProtoOneof.Something
<$> arbitrary
<*> arbitrary
<*> arbitrary
instance Arbitrary TestProtoOneof.SomethingPickOne where
arbitrary =
QC.oneof
[ TestProtoOneof.SomethingPickOneName <$> fmap T.pack arbitrary
, TestProtoOneof.SomethingPickOneSomeid <$> arbitrary
, TestProtoOneof.SomethingPickOneDummyMsg1 <$> arbitrary
, TestProtoOneof.SomethingPickOneDummyMsg2 <$> arbitrary
, TestProtoOneof.SomethingPickOneDummyEnum . DotProto.Enumerated . Right
<$> arbitraryBoundedEnum
]
instance Arbitrary TestProtoOneof.WithImported where
arbitrary =
TestProtoOneof.WithImported
<$> arbitrary
instance Arbitrary TestProtoOneof.WithImportedPickOne where
arbitrary =
QC.oneof
[ TestProtoOneof.WithImportedPickOneDummyMsg1 <$> arbitrary
, TestProtoOneof.WithImportedPickOneWithOneof <$> arbitrary
]
instance Arbitrary TestProtoOneofImport.WithOneof where
arbitrary =
TestProtoOneofImport.WithOneof
<$> arbitrary
instance Arbitrary TestProtoOneofImport.WithOneofPickOne where
arbitrary =
QC.oneof
[ TestProtoOneofImport.WithOneofPickOneA <$> fmap T.pack arbitrary
, TestProtoOneofImport.WithOneofPickOneB <$> arbitrary
]

324
nix/third-party/proto3-suite/tests/Main.hs vendored
View File

@ -1,324 +0,0 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wwarn #-}
module Main where
import ArbitraryGeneratedTestTypes ()
import Control.Applicative
import Control.Exception
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import Data.Either (isRight)
import Data.Int
import Data.Maybe (fromJust)
import Data.Monoid
import Data.Proxy
import Data.String
import qualified Data.Text.Lazy as TL
import Data.Word (Word64)
import GHC.Exts (fromList)
import Proto3.Suite
import Proto3.Wire.Decode (ParseError)
import qualified Proto3.Wire.Decode as Decode
import Proto3.Wire.Types as P
--import qualified Test.DocTest
import Test.QuickCheck (Arbitrary, Property, arbitrary,
counterexample, oneof)
import Test.Tasty
import Test.Tasty.HUnit (Assertion, assertBool, testCase,
(@=?), (@?=))
import Test.Tasty.QuickCheck (testProperty, (===))
import TestCodeGen
import qualified TestProto as TP
import qualified System.Directory
main :: IO ()
main = do
--System.Directory.setCurrentDirectory "libs-haskell/proto3-suite"
System.Directory.setCurrentDirectory "nix/third-party/proto3-suite"
defaultMain tests
tests :: TestTree
tests = testGroup "Tests"
[
-- NOTE(JM): Not easy to make this work with Buck as proto3-suite
-- isn't a registered package.
-- docTests
qcProperties
, encodeUnitTests
, decodeUnitTests
, parserUnitTests
, dotProtoUnitTests
, codeGenTests
]
--------------------------------------------------------------------------------
-- Doctests
{-
docTests :: TestTree
docTests = testCase "doctests" $ do
putStrLn "Running all doctests..."
Test.DocTest.doctest
[ "-isrc"
, "-itests"
, "src/Proto3/Suite/DotProto/Internal.hs"
, "tests/TestCodeGen.hs"
]
-}
--------------------------------------------------------------------------------
-- QuickCheck properties
type MsgProp a = a -> Property
qcProperties :: TestTree
qcProperties = testGroup "QuickCheck properties"
[ qcPropDecEncId
]
-- | Verifies that @decode . encode = id@ for various message types
qcPropDecEncId :: TestTree
qcPropDecEncId = testGroup "Property: (decode . encode = id) for various message types"
[ testProperty "Trivial" (prop :: MsgProp TP.Trivial)
, testProperty "MultipleFields" (prop :: MsgProp TP.MultipleFields)
, testProperty "WithEnum" (prop :: MsgProp TP.WithEnum)
, testProperty "WithNesting" (prop :: MsgProp TP.WithNesting)
, testProperty "WithRepetition" (prop :: MsgProp TP.WithRepetition)
, testProperty "WithFixed" (prop :: MsgProp TP.WithFixed)
, testProperty "WithBytes" (prop :: MsgProp TP.WithBytes)
, testProperty "AllPackedTypes" (prop :: MsgProp TP.AllPackedTypes)
, testProperty "SignedInts" (prop :: MsgProp TP.SignedInts)
, testProperty "WithNestingRepeated" (prop :: MsgProp TP.WithNestingRepeated)
, deeplyNest prop 1000
]
where
prop :: (Message a, Arbitrary a, Eq a, Show a) => MsgProp a
prop msg = msg === (dec . enc) msg
where
dec = either (error . ("error parsing: " <>) . show) id . fromByteString
enc = BL.toStrict . toLazyByteString
deeplyNest :: MsgProp TP.Wrapped -> Int -> TestTree
deeplyNest pf 0 = testProperty "Deeply nested" pf
deeplyNest pf n = deeplyNest (pf . TP.Wrapped . Just) (n-1)
--------------------------------------------------------------------------------
-- Encoding
encodeUnitTests :: TestTree
encodeUnitTests = testGroup "Encoder unit tests"
[ encoderMatchesGoldens
]
-- TODO: We should consider generating the reference encodings
-- (test-files/make_reference_encodings.py) as a part of running the test suite
-- rather than having them in the repository.
encoderMatchesGoldens :: TestTree
encoderMatchesGoldens = testGroup "Encoder matches golden encodings"
[ check "trivial.bin" $ TP.Trivial 123
, check "trivial_negative.bin" $ TP.Trivial (-1)
, check "multiple_fields.bin" $ TP.MultipleFields 1.23 (-0.5) 123 1234567890 "Hello, world!" True
, check "signedints.bin" $ TP.SignedInts (-42) (-84)
, check "with_nesting.bin" $ TP.WithNesting $ Just $ TP.WithNesting_Nested "123abc" 123456 [] []
, check "with_enum0.bin" $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM1
, check "with_enum1.bin" $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM2
, check "with_repetition.bin" $ TP.WithRepetition [1..5]
, check "with_bytes.bin" $ TP.WithBytes (BC.pack "abc") (fromList $ map BC.pack ["abc","123"])
, check "with_nesting_repeated.bin" $ TP.WithNestingRepeated
[ TP.WithNestingRepeated_Nested "123abc" 123456 [1,2,3,4] [5,6,7,8]
, TP.WithNestingRepeated_Nested "abc123" 654321 [0,9,8,7] [6,5,4,3]
]
]
where
check fp v = testCase fp $ do
goldenEncoding <- BL.readFile (testFilesPfx <> fp)
toLazyByteString v @?= goldenEncoding
--------------------------------------------------------------------------------
-- Decoding
decodeUnitTests :: TestTree
decodeUnitTests = testGroup "Decoder unit tests"
[ decodeFromGoldens
]
decodeFromGoldens :: TestTree
decodeFromGoldens = testGroup "Decode golden encodings into key/value lists"
[ check "trivial.bin"
, check "trivial_negative.bin"
, check "multiple_fields.bin"
, check "signedints.bin"
, check "with_nesting.bin"
, check "with_enum0.bin"
, check "with_enum1.bin"
, check "with_repetition.bin"
, check "with_bytes.bin"
, check "with_nesting_repeated.bin"
]
where
check fp = testCase fp $ do
kvs <- Decode.decodeWire <$> B.readFile (testFilesPfx <> fp)
assertBool ("parsing " <> fp <> " into a key-value list succeeds") (isRight kvs)
--------------------------------------------------------------------------------
-- Parser
parserUnitTests :: TestTree
parserUnitTests = testGroup "Parser unit tests"
[ parseFromGoldens
]
parseFromGoldens :: TestTree
parseFromGoldens = testGroup "Parse golden encodings"
[ check "trivial.bin" $ TP.Trivial 123
, check "multiple_fields.bin" $ TP.MultipleFields 1.23 (-0.5) 123 1234567890 "Hello, world!" True
, check "signedints.bin" $ TP.SignedInts (-42) (-84)
, check "with_nesting.bin" $ TP.WithNesting $ Just $ TP.WithNesting_Nested "123abc" 123456 [] []
, check "with_enum0.bin" $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM1
, check "with_enum1.bin" $ TP.WithEnum $ Enumerated $ Right $ TP.WithEnum_TestEnumENUM2
, check "with_repetition.bin" $ TP.WithRepetition [1..5]
, check "with_fixed.bin" $ TP.WithFixed (Fixed 16) (Fixed (-123)) (Fixed 4096) (Fixed (-4096))
, check "with_bytes.bin" $ TP.WithBytes (BC.pack "abc") (fromList $ map BC.pack ["abc","123"])
, check "with_packing.bin" $ TP.WithPacking [1,2,3] [1,2,3]
, check "all_packed_types.bin" $ TP.AllPackedTypes
[1,2,3]
[1,2,3]
[-1,-2,-3]
[-1,-2,-3]
(fromList $ map Fixed [1..3])
(fromList $ map Fixed [1..3])
[1.0,2.0]
[1.0,-1.0]
(fromList $ map Fixed [1,2,3])
(fromList $ map Fixed [1,2,3])
[False,True]
(Enumerated . Right <$> [TP.EFLD0, TP.EFLD1])
(Enumerated . Right <$> [TP.EFLD0, TP.EFLD1])
, check "with_nesting_repeated.bin" $ TP.WithNestingRepeated
[ TP.WithNestingRepeated_Nested "123abc" 123456 [1,2,3,4] [5,6,7,8]
, TP.WithNestingRepeated_Nested "abc123" 654321 [0,9,8,7] [6,5,4,3]
]
, -- Checks parsing repeated embedded messages when one is expected (i.e.,
-- this tests correct merging; this value was encoded as a
-- WithNestingRepeated).
check "with_nesting_repeated.bin" $ TP.WithNesting $ Just $ TP.WithNesting_Nested "abc123" 654321 [1,2,3,4,0,9,8,7] [5,6,7,8,6,5,4,3]
, -- Checks that embedded message merging works correctly when fields have
-- default values; this value was encoded as a WithNestingRepeatedInts
check "with_nesting_ints.bin" $ TP.WithNestingInts $ Just $ TP.NestedInts 2 2
]
where
check fp = testCase fp . testParser (testFilesPfx <> fp) fromByteString
testParser :: (Show a, Eq a)
=> FilePath -> (B.ByteString -> Either ParseError a) -> a -> IO ()
testParser fp p reference = do
bs <- B.readFile fp
case p bs of
Left err -> error $ "Got error: " ++ show err
Right ourResult -> ourResult @?= reference
testDotProtoParse :: FilePath -> DotProto -> Assertion
testDotProtoParse file ast = do
contents <- readFile file
case parseProto (Path []) contents of
Left err -> error $ show err
Right result -> ast @=? result
testDotProtoPrint :: DotProto -> String -> Assertion
testDotProtoPrint ast expected = expected @=? toProtoFileDef ast
testDotProtoRoundtrip :: DotProto -> Assertion
testDotProtoRoundtrip ast =
Right ast @=? parseProto (Path []) (toProtoFileDef ast)
dotProtoUnitTests :: TestTree
dotProtoUnitTests = testGroup ".proto parsing tests"
[ dotProtoParseTrivial
, dotProtoPrintTrivial
, dotProtoRoundtripTrivial
, dotProtoRoundtripSimpleMessage
, qcDotProtoRoundtrip
]
trivialDotProto :: DotProto
trivialDotProto = DotProto [] [] DotProtoNoPackage [] (DotProtoMeta (Path []))
dotProtoParseTrivial :: TestTree
dotProtoParseTrivial = testCase
"Parse a content-less file" $
testDotProtoParse "test-files/trivial.proto" trivialDotProto
dotProtoPrintTrivial :: TestTree
dotProtoPrintTrivial = testCase
"Print a content-less DotProto" $
testDotProtoPrint trivialDotProto "syntax = \"proto3\";"
dotProtoRoundtripTrivial :: TestTree
dotProtoRoundtripTrivial = testCase
"Printing then parsing a content-less DotProto yields an empty DotProto" $
testDotProtoRoundtrip trivialDotProto
dotProtoSimpleMessage :: DotProto
dotProtoSimpleMessage = DotProto [] [] DotProtoNoPackage
[ DotProtoMessage (Single "MessageTest")
[ DotProtoMessageField $
DotProtoField (fieldNumber 1) (Prim Int32) (Single "testfield") [] Nothing
]
]
(DotProtoMeta (Path []))
dotProtoRoundtripSimpleMessage :: TestTree
dotProtoRoundtripSimpleMessage = testCase
"Round-trip for a single flat message" $
testDotProtoRoundtrip dotProtoSimpleMessage
qcDotProtoRoundtrip :: TestTree
qcDotProtoRoundtrip = testProperty
"Round-trip for a randomly-generated .proto AST" roundtrip
where
roundtrip :: DotProto -> Property
roundtrip ast = let generated = toProtoFileDef ast
in case parseProto (Path []) generated of
Left err -> error $ formatParseError err generated
Right result -> counterexample (formatMismatch ast generated result ) (ast == result)
formatMismatch initial generated result = "AST changed during reparsing\n\nInitial AST:\n\n"
++ show initial
++ "\n\nGenerated .proto file:\n\n"
++ generated
++ "\n\nReparsed AST:\n\n"
++ show result
++ "\n\nRegenerated .proto file:\n\n"
++ (toProtoFileDef result)
formatParseError err generated = "Parsec error:\n\n"
++ show err
++ "\n\nWhen attempting to parse:\n\n"
++ generated
++ "\n\nInitial AST:\n\n"
--------------------------------------------------------------------------------
-- Helpers
dotProtoFor :: (Named a, Message a) => Proxy a -> DotProto
dotProtoFor proxy = DotProto [] [] DotProtoNoPackage
[ DotProtoMessage (Single (nameOf proxy)) (DotProtoMessageField <$> dotProto proxy)
]
(DotProtoMeta (Path []))
showDotProtoFor :: (Named a, Message a) => Proxy a -> IO ()
showDotProtoFor = putStrLn . toProtoFileDef . dotProtoFor
instance Arbitrary WireType where
arbitrary = oneof $ map return [Varint, P.Fixed32, P.Fixed64, LengthDelimited]
testFilesPfx :: IsString a => a
testFilesPfx = "test-files/"

14
nix/third-party/proto3-suite/tests/README.md vendored
View File

@ -1,14 +0,0 @@
# Code generation for tests
Running:
```bash
$ bash generate-test-types.sh
```
from inside this directory will result in `./TestProto.hs` and
`./TestProtoImport.hs` being regenerated from `../test-files/test_proto.proto`
and `../test-files/test_proto_import.proto`, respectively.
We'll eventually `nix`-ify the building of codegen artifacts, so this is a bit
of a stopgap.

331
nix/third-party/proto3-suite/tests/SimpleDecodeDotProto.hs vendored
View File

@ -1,331 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
import Test.Tasty
import Test.Tasty.HUnit (Assertion, (@?=), (@=?), testCase)
import Control.Applicative
import Control.Monad
import Proto3.Suite
import qualified Data.ByteString.Char8 as BC
import System.IO
import System.Exit
import TestProto
import qualified TestProtoImport
import qualified TestProtoOneof
import qualified TestProtoOneofImport
main :: IO ()
main = do putStr "\n"
defaultMain tests
tests, testCase1, testCase2, testCase3, testCase4, testCase5,
testCase6, testCase8, testCase9, testCase10, testCase11,
testCase12, testCase13, testCase14, testCase15, testCase16,
testCase17 :: TestTree
tests = testGroup "Decode protobuf messages from Python"
[ testCase1, testCase2, testCaseSignedInts
, testCase3, testCase4, testCase5, testCase6
, testCase7, testCase8, testCase9, testCase10
, testCase11, testCase12, testCase13, testCase14
, testCase15, testCase16, testCase17, testCase18
, allTestsDone -- this should always run last
]
readProto :: Message a => IO a
readProto = do length <- readLn
res <- fromByteString <$> BC.hGet stdin length
case res of
Left err -> fail ("readProto: " ++ show err)
Right x -> pure x
expect :: (Eq a, Message a, Show a) => a -> Assertion
expect v = (v @=?) =<< readProto
testCase1 = testCase "Trivial message" $
do Trivial { .. } <- readProto
trivialTrivialField @?= 0x7BADBEEF
testCase2 = testCase "Multi-field message" $
do MultipleFields { .. } <- readProto
multipleFieldsMultiFieldDouble @?= 1.125
multipleFieldsMultiFieldFloat @?= 1e9
multipleFieldsMultiFieldInt32 @?= 0x1135
multipleFieldsMultiFieldInt64 @?= 0x7FFAFABADDEAFFA0
multipleFieldsMultiFieldString @?= "Goodnight moon"
multipleFieldsMultiFieldBool @?= False
testCaseSignedInts = testCase "Signed integer types" $
do expect (SignedInts 0 0)
expect (SignedInts 42 84)
expect (SignedInts (-42) (-84))
expect (SignedInts minBound minBound)
expect (SignedInts maxBound maxBound)
testCase3 = testCase "Nested enumeration" $
do WithEnum { withEnumEnumField = Enumerated a } <- readProto
a @?= Right WithEnum_TestEnumENUM1
WithEnum { withEnumEnumField = Enumerated b } <- readProto
b @?= Right WithEnum_TestEnumENUM2
WithEnum { withEnumEnumField = Enumerated c } <- readProto
c @?= Right WithEnum_TestEnumENUM3
WithEnum { withEnumEnumField = Enumerated d } <- readProto
d @?= Left 0xBEEF
testCase4 = testCase "Nested message" $
do WithNesting { withNestingNestedMessage = a } <- readProto
a @?= Just (WithNesting_Nested "testCase4 nestedField1" 0xABCD [] [])
WithNesting { withNestingNestedMessage = b } <- readProto
b @?= Nothing
testCase5 = testCase "Nested repeated message" $
do WithNestingRepeated { withNestingRepeatedNestedMessages = a } <- readProto
length a @?= 3
let [a1, a2, a3] = a
a1 @?= WithNestingRepeated_Nested "testCase5 nestedField1" 0xDCBA [1, 1, 2, 3, 5] [0xB, 0xABCD, 0xBADBEEF, 0x10203040]
a2 @?= WithNestingRepeated_Nested "Hello world" 0x7FFFFFFF [0, 0, 0] []
a3 @?= WithNestingRepeated_Nested "" 0 [] []
WithNestingRepeated { withNestingRepeatedNestedMessages = b } <- readProto
b @?= []
testCase6 = testCase "Nested repeated int message" $
do WithNestingRepeatedInts { withNestingRepeatedIntsNestedInts = a } <- readProto
a @?= [ NestedInts 636513 619021 ]
WithNestingRepeatedInts { withNestingRepeatedIntsNestedInts = b } <- readProto
b @?= []
WithNestingRepeatedInts { withNestingRepeatedIntsNestedInts = c } <- readProto
c @?= [ NestedInts 636513 619021
, NestedInts 423549 687069
, NestedInts 545506 143731
, NestedInts 193605 385360 ]
testCase7 = testCase "Repeated int32 field" $
do WithRepetition { withRepetitionRepeatedField1 = a } <- readProto
a @?= []
WithRepetition { withRepetitionRepeatedField1 = b } <- readProto
b @?= [1..10000]
testCase8 = testCase "Fixed-width integer types" $
do WithFixed { .. } <- readProto
withFixedFixed1 @?= 0
withFixedFixed2 @?= 0
withFixedFixed3 @?= 0
withFixedFixed4 @?= 0
WithFixed { .. } <- readProto
withFixedFixed1 @?= maxBound
withFixedFixed2 @?= maxBound
withFixedFixed3 @?= maxBound
withFixedFixed4 @?= maxBound
WithFixed { .. } <- readProto
withFixedFixed1 @?= minBound
withFixedFixed2 @?= minBound
withFixedFixed3 @?= minBound
withFixedFixed4 @?= minBound
testCase9 = testCase "Bytes fields" $
do WithBytes { .. } <- readProto
withBytesBytes1 @?= "\x00\x00\x00\x01\x02\x03\xFF\xFF\x00\x01"
withBytesBytes2 @?= ["", "\x01", "\xAB\xBAhello", "\xBB"]
WithBytes { .. } <- readProto
withBytesBytes1 @?= "Hello world"
withBytesBytes2 @?= []
WithBytes { .. } <- readProto
withBytesBytes1 @?= ""
withBytesBytes2 @?= ["Hello", "\x00world", "\x00\x00"]
WithBytes { .. } <- readProto
withBytesBytes1 @?= ""
withBytesBytes2 @?= []
testCase10 = testCase "Packed and unpacked repeated types" $
do WithPacking { .. } <- readProto
withPackingPacking1 @?= []
withPackingPacking2 @?= []
WithPacking { .. } <- readProto
withPackingPacking1 @?= [100, 2000, 300, 4000, 500, 60000, 7000]
withPackingPacking2 @?= []
WithPacking { .. } <- readProto
withPackingPacking1 @?= []
withPackingPacking2 @?= [100, 2000, 300, 4000, 500, 60000, 7000]
WithPacking { .. } <- readProto
withPackingPacking1 @?= [1, 2, 3, 4, 5]
withPackingPacking2 @?= [5, 4, 3, 2, 1]
testCase11 = testCase "All possible packed types" $
do a <- readProto
a @?= AllPackedTypes [] [] [] [] [] [] [] [] [] [] [] [] []
b <- readProto
b @?= AllPackedTypes [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] [False] [efld0] [efld0]
c <- readProto
c @?= AllPackedTypes [1] [2] [-3] [-4] [5] [6] [-7] [-8] [-9] [-10] [True] [efld1] [efld1]
d <- readProto
d @?= AllPackedTypes [1..10000] [1..10000]
[1..10000] [1..10000]
[1..10000] [1..10000]
[1,1.125..10000] [1,1.125..10000]
[1..10000] [1..10000]
[False,True]
[efld0,efld1]
[efld0,efld1]
where
efld0 = Enumerated (Right EFLD0)
efld1 = Enumerated (Right EFLD1)
testCase12 = testCase "Message with out of order field numbers" $
do OutOfOrderFields { .. } <- readProto
outOfOrderFieldsField1 @?= []
outOfOrderFieldsField2 @?= ""
outOfOrderFieldsField3 @?= maxBound
outOfOrderFieldsField4 @?= []
OutOfOrderFields { .. } <- readProto
outOfOrderFieldsField1 @?= [1,7..100]
outOfOrderFieldsField2 @?= "This is a test"
outOfOrderFieldsField3 @?= minBound
outOfOrderFieldsField4 @?= ["This", "is", "a", "test"]
testCase13 = testCase "Nested message with the same name as another package-level message" $
do ShadowedMessage { .. } <- readProto
shadowedMessageName @?= "name"
shadowedMessageValue @?= 0x7DADBEEF
MessageShadower { .. } <- readProto
messageShadowerName @?= "another name"
messageShadowerShadowedMessage @?= Just (MessageShadower_ShadowedMessage "name" "string value")
MessageShadower_ShadowedMessage { .. } <- readProto
messageShadower_ShadowedMessageName @?= "another name"
messageShadower_ShadowedMessageValue @?= "another string"
testCase14 = testCase "Qualified name resolution" $
do WithQualifiedName { .. } <- readProto
withQualifiedNameQname1 @?= Just (ShadowedMessage "int value" 42)
withQualifiedNameQname2 @?= Just (MessageShadower_ShadowedMessage "string value" "hello world")
testCase15 = testCase "Imported message resolution" $
do TestProtoImport.WithNesting { .. } <- readProto
withNestingNestedMessage1 @?= Just (TestProtoImport.WithNesting_Nested 1 2)
withNestingNestedMessage2 @?= Nothing
testCase16 = testCase "Proper resolution of shadowed message names" $
do UsingImported { .. } <- readProto
usingImportedImportedNesting @?=
Just (TestProtoImport.WithNesting
(Just (TestProtoImport.WithNesting_Nested 1 2))
(Just (TestProtoImport.WithNesting_Nested 3 4)))
usingImportedLocalNesting @?= Just (WithNesting (Just (WithNesting_Nested "field" 0xBEEF [] [])))
testCase17 = testCase "Oneof" $ do
-- Read default values for oneof subfields
do TestProtoOneof.Something{ .. } <- readProto
somethingValue @?= 1
somethingAnother @?= 2
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneName "")
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 3
somethingAnother @?= 4
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneSomeid 0)
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 5
somethingAnother @?= 6
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneDummyMsg1
(TestProtoOneof.DummyMsg 0))
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 7
somethingAnother @?= 8
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneDummyMsg2
(TestProtoOneof.DummyMsg 0))
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 9
somethingAnother @?= 10
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneDummyEnum
(Enumerated (Right TestProtoOneof.DummyEnumDUMMY0)))
-- Read non-default values for oneof subfields
do TestProtoOneof.Something{ .. } <- readProto
somethingValue @?= 1
somethingAnother @?= 2
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneName "hello world")
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 3
somethingAnother @?= 4
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneSomeid 42)
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 5
somethingAnother @?= 6
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneDummyMsg1
(TestProtoOneof.DummyMsg 66))
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 7
somethingAnother @?= 8
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneDummyMsg2
(TestProtoOneof.DummyMsg 67))
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 9
somethingAnother @?= 10
somethingPickOne @?= Just (TestProtoOneof.SomethingPickOneDummyEnum
(Enumerated (Right TestProtoOneof.DummyEnumDUMMY1)))
-- Read with oneof not set
do TestProtoOneof.Something { .. } <- readProto
somethingValue @?= 11
somethingAnother @?= 12
somethingPickOne @?= Nothing
testCase18 = testCase "Imported Oneof" $ do
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneDummyMsg1
(TestProtoOneof.DummyMsg 0))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneDummyMsg1
(TestProtoOneof.DummyMsg 68))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneWithOneof
(TestProtoOneofImport.WithOneof Nothing))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneWithOneof
(TestProtoOneofImport.WithOneof
(Just (TestProtoOneofImport.WithOneofPickOneA ""))))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneWithOneof
(TestProtoOneofImport.WithOneof
(Just (TestProtoOneofImport.WithOneofPickOneB 0))))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneWithOneof
(TestProtoOneofImport.WithOneof
(Just (TestProtoOneofImport.WithOneofPickOneA "foo"))))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Just (TestProtoOneof.WithImportedPickOneWithOneof
(TestProtoOneofImport.WithOneof
(Just (TestProtoOneofImport.WithOneofPickOneB 19))))
do TestProtoOneof.WithImported{ .. } <- readProto
withImportedPickOne @?= Nothing
allTestsDone = testCase "Receive end of test suite sentinel message" $
do MultipleFields{..} <- readProto
multipleFieldsMultiFieldString @?= "All tests complete"

213
nix/third-party/proto3-suite/tests/SimpleEncodeDotProto.hs vendored
View File

@ -1,213 +0,0 @@
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Lazy as BL
import Proto3.Suite
import TestProto
import qualified TestProtoImport
import qualified TestProtoOneof
import qualified TestProtoOneofImport
outputMessage :: Message a => a -> IO ()
outputMessage msg =
let encoded = toLazyByteString msg
in putStrLn (show (BL.length encoded)) >> BL.putStr encoded
testCase1 :: IO ()
testCase1 =
let trivial = Trivial 0x7BADBEEF
in outputMessage trivial
testCase2 :: IO ()
testCase2 =
do outputMessage (MultipleFields 1.125 1e9 0x1135 0x7FFAFABADDEAFFA0 "Goodnight moon" False)
testCaseSignedInts :: IO ()
testCaseSignedInts =
do outputMessage (SignedInts 0 0)
outputMessage (SignedInts 42 84)
outputMessage (SignedInts (-42) (-84))
outputMessage (SignedInts minBound minBound)
outputMessage (SignedInts maxBound maxBound)
testCase3 :: IO ()
testCase3 =
do outputMessage (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1)))
outputMessage (WithEnum (Enumerated (Right WithEnum_TestEnumENUM2)))
outputMessage (WithEnum (Enumerated (Right WithEnum_TestEnumENUM3)))
outputMessage (WithEnum (Enumerated (Left 0xBEEF)))
testCase4 :: IO ()
testCase4 =
do let nested = WithNesting_Nested "testCase4 nestedField1" 0xABCD [] []
outputMessage (WithNesting (Just nested))
outputMessage (WithNesting Nothing)
testCase5 :: IO ()
testCase5 =
do let nested1 = WithNestingRepeated_Nested "testCase5 nestedField1" 0xDCBA [1, 1, 2, 3, 5] [0xB, 0xABCD, 0xBADBEEF, 0x10203040]
nested2 = WithNestingRepeated_Nested "Hello world" 0x7FFFFFFF [0, 0, 0] []
nested3 = WithNestingRepeated_Nested "" 0x0 [] []
outputMessage (WithNestingRepeated [nested1, nested2, nested3])
outputMessage (WithNestingRepeated [])
testCase6 :: IO ()
testCase6 =
do let nested1 = NestedInts 636513 619021
nested2 = NestedInts 423549 687069
nested3 = NestedInts 545506 143731
nested4 = NestedInts 193605 385360
outputMessage (WithNestingRepeatedInts [nested1])
outputMessage (WithNestingRepeatedInts [])
outputMessage (WithNestingRepeatedInts [nested1, nested2, nested3, nested4])
testCase7 :: IO ()
testCase7 =
do outputMessage (WithRepetition [])
outputMessage (WithRepetition [1..10000])
testCase8 :: IO ()
testCase8 =
do outputMessage (WithFixed 0 0 0 0)
outputMessage (WithFixed maxBound maxBound maxBound maxBound)
outputMessage (WithFixed minBound minBound minBound minBound)
testCase9 :: IO ()
testCase9 =
do outputMessage (WithBytes "\x00\x00\x00\x01\x02\x03\xFF\xFF\x0\x1"
["", "\x01", "\xAB\xBAhello", "\xBB"])
outputMessage (WithBytes "Hello world" [])
outputMessage (WithBytes "" ["Hello", "\x00world", "\x00\x00"])
outputMessage (WithBytes "" [])
testCase10 :: IO ()
testCase10 =
do outputMessage (WithPacking [] [])
outputMessage (WithPacking [100, 2000, 300, 4000, 500, 60000, 7000] [])
outputMessage (WithPacking [] [100, 2000, 300, 4000, 500, 60000, 7000])
outputMessage (WithPacking [1, 2, 3, 4, 5] [5, 4, 3, 2, 1])
testCase11 :: IO ()
testCase11 = do
outputMessage $ AllPackedTypes [] [] [] [] [] [] [] [] [] [] [] [] []
outputMessage $ AllPackedTypes [1] [2] [3] [4] [5] [6] [7] [8] [9] [10]
[False][efld0] [efld0]
outputMessage $ AllPackedTypes [1] [2] [-3] [-4] [5] [6] [-7] [-8] [-9] [-10]
[True] [efld1] [efld1]
outputMessage $ AllPackedTypes [1..10000] [1..10000]
[1..10000] [1..10000]
[1..10000] [1..10000]
[1,1.125..10000] [1,1.125..10000]
[1..10000] [1..10000]
[False,True]
[efld0,efld1]
[efld0,efld1]
where
efld0 = Enumerated (Right EFLD0)
efld1 = Enumerated (Right EFLD1)
testCase12 :: IO ()
testCase12 =
do outputMessage (OutOfOrderFields [] "" maxBound [])
outputMessage (OutOfOrderFields [1,7..100] "This is a test" minBound ["This", "is", "a", "test"])
testCase13 :: IO ()
testCase13 =
do outputMessage (ShadowedMessage "name" 0x7DADBEEF)
outputMessage (MessageShadower (Just (MessageShadower_ShadowedMessage "name" "string value")) "another name")
outputMessage (MessageShadower_ShadowedMessage "another name" "another string")
testCase14 :: IO ()
testCase14 =
outputMessage (WithQualifiedName (Just (ShadowedMessage "int value" 42))
(Just (MessageShadower_ShadowedMessage "string value" "hello world")))
testCase15 :: IO ()
testCase15 =
outputMessage
TestProtoImport.WithNesting
{ TestProtoImport.withNestingNestedMessage1 =
Just TestProtoImport.WithNesting_Nested
{ TestProtoImport.withNesting_NestedNestedField1 = 1
, TestProtoImport.withNesting_NestedNestedField2 = 2
}
, TestProtoImport.withNestingNestedMessage2 = Nothing
}
testCase16 :: IO ()
testCase16 =
outputMessage (UsingImported { usingImportedImportedNesting =
Just (TestProtoImport.WithNesting
(Just (TestProtoImport.WithNesting_Nested 1 2))
(Just (TestProtoImport.WithNesting_Nested 3 4)))
, usingImportedLocalNesting =
Just (WithNesting (Just (WithNesting_Nested "field" 0xBEEF [] []))) })
testCase17 :: IO ()
testCase17 = do
let emit v a p = outputMessage
TestProtoOneof.Something
{ TestProtoOneof.somethingValue = v
, TestProtoOneof.somethingAnother = a
, TestProtoOneof.somethingPickOne = p
}
-- Send default values for oneof subfields
emit 1 2 $ Just $ TestProtoOneof.SomethingPickOneName ""
emit 3 4 $ Just $ TestProtoOneof.SomethingPickOneSomeid 0
emit 5 6 $ Just $ TestProtoOneof.SomethingPickOneDummyMsg1 $ TestProtoOneof.DummyMsg 0
emit 7 8 $ Just $ TestProtoOneof.SomethingPickOneDummyMsg2 $ TestProtoOneof.DummyMsg 0
emit 9 10 $ Just $ TestProtoOneof.SomethingPickOneDummyEnum $ Enumerated $ Right $ TestProtoOneof.DummyEnumDUMMY0
-- Send non-default values for oneof subfields
emit 1 2 $ Just $ TestProtoOneof.SomethingPickOneName "hello world"
emit 3 4 $ Just $ TestProtoOneof.SomethingPickOneSomeid 42
emit 5 6 $ Just $ TestProtoOneof.SomethingPickOneDummyMsg1 $ TestProtoOneof.DummyMsg 66
emit 7 8 $ Just $ TestProtoOneof.SomethingPickOneDummyMsg2 $ TestProtoOneof.DummyMsg 67
emit 9 10 $ Just $ TestProtoOneof.SomethingPickOneDummyEnum $ Enumerated $ Right $ TestProtoOneof.DummyEnumDUMMY1
-- Send with oneof not set
emit 11 12 Nothing
testCase18 :: IO ()
testCase18 = do
let emit = outputMessage . TestProtoOneof.WithImported
let emitWithOneof = emit . Just . TestProtoOneof.WithImportedPickOneWithOneof . TestProtoOneofImport.WithOneof
emit $ Just $ TestProtoOneof.WithImportedPickOneDummyMsg1 $ TestProtoOneof.DummyMsg 0
emit $ Just $ TestProtoOneof.WithImportedPickOneDummyMsg1 $ TestProtoOneof.DummyMsg 68
emitWithOneof Nothing
emitWithOneof $ Just $ TestProtoOneofImport.WithOneofPickOneA ""
emitWithOneof $ Just $ TestProtoOneofImport.WithOneofPickOneB 0
emitWithOneof $ Just $ TestProtoOneofImport.WithOneofPickOneA "foo"
emitWithOneof $ Just $ TestProtoOneofImport.WithOneofPickOneB 19
emit Nothing
main :: IO ()
main = do testCase1
testCase2
testCaseSignedInts
testCase3
testCase4
testCase5
testCase6
testCase7
testCase8
testCase9
testCase10
testCase11
testCase12
testCase13
testCase14
-- Tests using imported messages
testCase15
testCase16
-- Oneof tests
testCase17
testCase18
outputMessage (MultipleFields 0 0 0 0 "All tests complete" False)

219
nix/third-party/proto3-suite/tests/TestCodeGen.hs vendored
View File

@ -1,219 +0,0 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wwarn #-}
module TestCodeGen where
import ArbitraryGeneratedTestTypes ()
import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Lazy as LBS
import Data.Monoid ((<>))
import Data.String (IsString)
import qualified Data.Text as T
import Prelude hiding (FilePath)
import Proto3.Suite
import Proto3.Suite.DotProto.Generate
import Proto3.Suite.JSONPB (FromJSONPB (..), Options (..),
ToJSONPB (..), eitherDecode,
encode, defaultOptions)
import System.Exit
import Test.Tasty
import Test.Tasty.HUnit (testCase, (@?=))
import TestProto
import TestProtoOneof
import Turtle (FilePath)
import qualified Turtle
import Turtle.Format ((%))
import qualified Turtle.Format as F
codeGenTests :: TestTree
codeGenTests = testGroup "Code generator unit tests"
[ camelCaseMessageNames
, camelCaseMessageFieldNames
, don'tAlterEnumFieldNames
-- NOTE(JM): Not currently trivial to make these work with the Buck based
-- build.
-- , simpleEncodeDotProto
-- , simpleDecodeDotProto
]
camelCaseMessageNames :: TestTree
camelCaseMessageNames = testGroup "CamelCasing of message names"
[ testCase "Capitalizes letters after underscores" (typeLikeName "protocol_analysis" @?= Right "ProtocolAnalysis")
, testCase "Preserves casing of interior letters" (typeLikeName "analyze_HTTP" @?= Right "AnalyzeHTTP")
, testCase "Handles non-alphanumeric characters after underscore" (typeLikeName "analyze_http_2" @?= Right "AnalyzeHttp2")
, testCase "Preserves one underscore in double underscore sequence" (typeLikeName "Analyze__HTTP" @?= Right "Analyze_HTTP")
, testCase "Handles names prefixed with underscore" (typeLikeName "_message_name" @?= Right "XMessageName")
, testCase "Preserves trailing underscore" (typeLikeName "message_name_" @?= Right "MessageName_") ]
camelCaseMessageFieldNames :: TestTree
camelCaseMessageFieldNames = testGroup "camelCasing of field names"
[ testCase "Preserves capitalization patterns" (fieldLikeName "IP" @?= "ip")
, testCase "Preserves underscores" (fieldLikeName "IP_address" @?= "ip_address") ]
don'tAlterEnumFieldNames :: TestTree
don'tAlterEnumFieldNames
= testGroup "Do not alter enumeration field names"
$ tc <$> [ "fnord"
, "FNORD"
, "PascalCase"
, "camelCase"
, "VOCIFEROUS_SNAKE_CASE"
, "snake_case"
, "snake_case_"
]
where
enumName = "MyEnum"
tc fieldName = testCase fieldName
$ prefixedEnumFieldName enumName fieldName
@?= Right (enumName <> fieldName)
setPythonPath :: IO ()
setPythonPath = Turtle.export "PYTHONPATH" =<< do
maybe pyTmpDir ((pyTmpDir <> ":") <>) <$> Turtle.need "PYTHONPATH"
{-
simpleEncodeDotProto :: TestTree
simpleEncodeDotProto =
testCase "generate code for a simple .proto and then use it to encode messages" $
do compileTestDotProtos
-- Compile our generated encoder
(@?= ExitSuccess) =<< Turtle.proc "tests/encode.sh" [hsTmpDir] empty
-- The python encoder test exits with a special error code to indicate
-- all tests were successful
setPythonPath
let cmd = hsTmpDir <> "/simpleEncodeDotProto | python tests/check_simple_dot_proto.py"
(@?= ExitFailure 12) =<< Turtle.shell cmd empty
-- Not using bracket so that we can inspect the output to fix the tests
Turtle.rmtree hsTmpDir
Turtle.rmtree pyTmpDir
simpleDecodeDotProto :: TestTree
simpleDecodeDotProto =
testCase "generate code for a simple .proto and then use it to decode messages" $
do compileTestDotProtos
-- Compile our generated decoder
(@?= ExitSuccess) =<< Turtle.proc "tests/decode.sh" [hsTmpDir] empty
setPythonPath
let cmd = "python tests/send_simple_dot_proto.py | " <> hsTmpDir <> "/simpleDecodeDotProto "
(@?= ExitSuccess) =<< Turtle.shell cmd empty
-- Not using bracket so that we can inspect the output to fix the tests
Turtle.rmtree hsTmpDir
Turtle.rmtree pyTmpDir
-}
-- * Helpers
-- E.g. dumpAST ["test-files"] "test_proto.proto"
dumpAST :: [FilePath] -> FilePath -> IO ()
dumpAST incs fp = do
Right (dp, tc) <- readDotProtoWithContext incs fp
let Right src = renderHsModuleForDotProto mempty dp tc
putStrLn src
hsTmpDir, pyTmpDir :: IsString a => a
hsTmpDir = "test-files/hs-tmp"
pyTmpDir = "test-files/py-tmp"
compileTestDotProtos :: IO ()
compileTestDotProtos = do
Turtle.mktree hsTmpDir
Turtle.mktree pyTmpDir
forM_ protoFiles $ \protoFile -> do
compileDotProtoFileOrDie [] hsTmpDir ["test-files"] protoFile
(@?= ExitSuccess) =<< Turtle.shell (T.concat [ "protoc --python_out="
, pyTmpDir
, " --proto_path=test-files"
, " test-files/" <> Turtle.format F.fp protoFile
])
empty
Turtle.touch (pyTmpDir Turtle.</> "__init__.py")
where
protoFiles =
[ "test_proto.proto"
, "test_proto_import.proto"
, "test_proto_oneof.proto"
, "test_proto_oneof_import.proto"
]
-- * Doctests for JSONPB
-- $setup
-- >>> import qualified Data.Text.Lazy as TL
-- >>> import qualified Data.Vector as V
-- >>> import Proto3.Suite.JSONPB (defaultOptions)
-- >>> :set -XOverloadedStrings
-- >>> :set -XOverloadedLists
-- >>> let omitDefaults = defaultOptions
-- >>> let emitDefaults = defaultOptions{ optEmitDefaultValuedFields = True }
-- | Round-trip tests
-- prop> roundTrip (x :: Trivial)
-- prop> roundTrip (x :: MultipleFields)
-- prop> roundTrip (x :: SignedInts)
-- prop> roundTrip (SignedInts minBound minBound)
-- prop> roundTrip (SignedInts maxBound maxBound)
-- prop> roundTrip (WithEnum (Enumerated (Right x)))
-- prop> roundTrip (x :: WithNesting)
-- prop> roundTrip (x :: WithNestingRepeated)
-- prop> roundTrip (x :: WithNestingRepeatedInts)
-- prop> roundTrip (x :: WithBytes)
-- prop> roundTrip (x :: OutOfOrderFields)
-- prop> roundTrip (x :: UsingImported)
-- prop> roundTrip (x :: Wrapped)
-- prop> roundTrip (x :: Something)
-- prop> roundTrip (x :: WithImported)
-- | Specific encoding tests
-- prop> encodesAs omitDefaults (MultipleFields 0 0 0 0 "" False) "{}"
-- prop> encodesAs emitDefaults (MultipleFields 0 2.0 0 0 "" True) "{\"multiFieldDouble\":0.0,\"multiFieldFloat\":2.0,\"multiFieldInt32\":0,\"multiFieldInt64\":\"0\",\"multiFieldString\":\"\",\"multiFieldBool\":true}"
-- prop> encodesAs omitDefaults (SignedInts minBound minBound) "{\"signed32\":-2147483648,\"signed64\":\"-9223372036854775808\"}"
-- prop> encodesAs omitDefaults (SignedInts maxBound maxBound) "{\"signed32\":2147483647,\"signed64\":\"9223372036854775807\"}"
-- prop> encodesAs omitDefaults (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1))) "{}"
-- prop> encodesAs emitDefaults (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1))) "{\"enumField\":\"ENUM1\"}"
-- prop> encodesAs omitDefaults (WithEnum (Enumerated (Right WithEnum_TestEnumENUM3))) "{\"enumField\":\"ENUM3\"}"
-- prop> encodesAs omitDefaults (WithNesting $ Just $ WithNesting_Nested "" 0 [1,2] [66,99]) "{\"nestedMessage\":{\"nestedPacked\":[1,2],\"nestedUnpacked\":[66,99]}}"
-- prop> encodesAs omitDefaults (Something 42 99 (Just (SomethingPickOneName ""))) "{\"value\":\"42\",\"another\":99,\"name\":\"\"}"
-- prop> encodesAs omitDefaults (Something 42 99 (Just (SomethingPickOneSomeid 0))) "{\"value\":\"42\",\"another\":99,\"someid\":0}"
-- prop> encodesAs omitDefaults (Something 42 99 (Just (SomethingPickOneDummyMsg1 (DummyMsg 66)))) "{\"value\":\"42\",\"another\":99,\"dummyMsg1\":{\"dummy\":66}}"
-- prop> encodesAs omitDefaults (Something 42 99 (Just (SomethingPickOneDummyMsg2 (DummyMsg 67)))) "{\"value\":\"42\",\"another\":99,\"dummyMsg2\":{\"dummy\":67}}"
-- prop> encodesAs omitDefaults (Something 42 99 (Just (SomethingPickOneDummyEnum (Enumerated (Right DummyEnumDUMMY0))))) "{\"value\":\"42\",\"another\":99,\"dummyEnum\":\"DUMMY0\"}"
-- | Specific decoding tests
-- prop> decodesAs "{\"signed32\":2147483647,\"signed64\":\"9223372036854775807\"}" (SignedInts 2147483647 9223372036854775807)
-- prop> decodesAs "{\"enumField\":\"ENUM3\"}" (WithEnum (Enumerated (Right WithEnum_TestEnumENUM3)))
-- prop> decodesAs "{\"enumField\":null}" (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1)))
-- prop> decodesAs "{}" (WithEnum (Enumerated (Right WithEnum_TestEnumENUM1)))
-- prop> decodesAs "{\"nestedMessage\":{}}" (WithNesting $ Just $ WithNesting_Nested "" 0 [] [])
-- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"someid\":66}" (Something 42 99 (Just (SomethingPickOneSomeid 66)))
-- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"name\":\"foo\"}" (Something 42 99 (Just (SomethingPickOneName "foo")))
-- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"dummyMsg1\":{\"dummy\":41}}" (Something 42 99 (Just (SomethingPickOneDummyMsg1 (DummyMsg 41))))
-- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"dummyMsg2\":{\"dummy\":43}}" (Something 42 99 (Just (SomethingPickOneDummyMsg2 (DummyMsg 43))))
-- prop> decodesAs "{\"value\":\"42\",\"another\":99,\"dummyEnum\":\"DUMMY0\"}" (Something 42 99 (Just (SomethingPickOneDummyEnum (Enumerated (Right DummyEnumDUMMY0)))))
-- prop> decodesAs "{\"value\":\"42\",\"another\":99}" (Something 42 99 Nothing)
-- * Helper quickcheck props
roundTrip :: (ToJSONPB a, FromJSONPB a, Eq a)
=> a -> Bool
roundTrip x = roundTrip' False && roundTrip' True
where
roundTrip' emitDefaults =
eitherDecode (encode defaultOptions{ optEmitDefaultValuedFields = emitDefaults} x)
==
Right x
encodesAs :: (ToJSONPB a)
=> Options -> a -> LBS.ByteString -> Bool
encodesAs opts x bs = encode opts x == bs
decodesAs :: (Eq a, FromJSONPB a)
=> LBS.ByteString -> a -> Bool
decodesAs bs x = eitherDecode bs == Right x

1807
nix/third-party/proto3-suite/tests/TestProto.hs vendored
View File

File diff suppressed because it is too large Load Diff

150
nix/third-party/proto3-suite/tests/TestProtoImport.hs vendored
View File

@ -1,150 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
-- | Generated by Haskell protocol buffer compiler. DO NOT EDIT!
module TestProtoImport where
import qualified Prelude as Hs
import qualified Proto3.Suite.DotProto as HsProtobuf
import qualified Proto3.Suite.Types as HsProtobuf
import qualified Proto3.Suite.Class as HsProtobuf
import qualified Proto3.Suite.JSONPB as HsJSONPB
import Proto3.Suite.JSONPB ((.=), (.:))
import qualified Proto3.Wire as HsProtobuf
import Control.Applicative ((<*>), (<|>), (<$>))
import qualified Control.Monad as Hs
import qualified Data.Text.Lazy as Hs (Text)
import qualified Data.ByteString as Hs
import qualified Data.String as Hs (fromString)
import qualified Data.Vector as Hs (Vector)
import qualified Data.Int as Hs (Int16, Int32, Int64)
import qualified Data.Word as Hs (Word16, Word32, Word64)
import qualified GHC.Generics as Hs
import qualified GHC.Enum as Hs
data WithNesting = WithNesting{withNestingNestedMessage1 ::
Hs.Maybe TestProtoImport.WithNesting_Nested,
withNestingNestedMessage2 ::
Hs.Maybe TestProtoImport.WithNesting_Nested}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named WithNesting where
nameOf _ = (Hs.fromString "WithNesting")
instance HsProtobuf.Message WithNesting where
encodeMessage _
WithNesting{withNestingNestedMessage1 = withNestingNestedMessage1,
withNestingNestedMessage2 = withNestingNestedMessage2}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Nested withNestingNestedMessage1)),
(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 100)
(HsProtobuf.Nested withNestingNestedMessage2))])
decodeMessage _
= (Hs.pure WithNesting) <*>
((Hs.pure HsProtobuf.nested) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1)))
<*>
((Hs.pure HsProtobuf.nested) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 100)))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim (HsProtobuf.Named (HsProtobuf.Single "Nested")))
(HsProtobuf.Single "nestedMessage1")
[]
Hs.Nothing),
(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 100)
(HsProtobuf.Prim (HsProtobuf.Named (HsProtobuf.Single "Nested")))
(HsProtobuf.Single "nestedMessage2")
[]
Hs.Nothing)]
instance HsJSONPB.ToJSONPB WithNesting where
toJSONPB (WithNesting f1 f100)
= (HsJSONPB.object
["nestedMessage1" .= f1, "nestedMessage2" .= f100])
toEncodingPB (WithNesting f1 f100)
= (HsJSONPB.pairs
["nestedMessage1" .= f1, "nestedMessage2" .= f100])
instance HsJSONPB.FromJSONPB WithNesting where
parseJSONPB
= (HsJSONPB.withObject "WithNesting"
(\ obj ->
(Hs.pure WithNesting) <*> obj .: "nestedMessage1" <*>
obj .: "nestedMessage2"))
instance HsJSONPB.ToJSON WithNesting where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON WithNesting where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema WithNesting where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data WithNesting_Nested = WithNesting_Nested{withNesting_NestedNestedField1
:: Hs.Int32,
withNesting_NestedNestedField2 :: Hs.Int32}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named WithNesting_Nested where
nameOf _ = (Hs.fromString "WithNesting_Nested")
instance HsProtobuf.Message WithNesting_Nested where
encodeMessage _
WithNesting_Nested{withNesting_NestedNestedField1 =
withNesting_NestedNestedField1,
withNesting_NestedNestedField2 = withNesting_NestedNestedField2}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
withNesting_NestedNestedField1),
(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
withNesting_NestedNestedField2)])
decodeMessage _
= (Hs.pure WithNesting_Nested) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1))
<*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 2))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "nestedField1")
[]
Hs.Nothing),
(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "nestedField2")
[]
Hs.Nothing)]
instance HsJSONPB.ToJSONPB WithNesting_Nested where
toJSONPB (WithNesting_Nested f1 f2)
= (HsJSONPB.object ["nestedField1" .= f1, "nestedField2" .= f2])
toEncodingPB (WithNesting_Nested f1 f2)
= (HsJSONPB.pairs ["nestedField1" .= f1, "nestedField2" .= f2])
instance HsJSONPB.FromJSONPB WithNesting_Nested where
parseJSONPB
= (HsJSONPB.withObject "WithNesting_Nested"
(\ obj ->
(Hs.pure WithNesting_Nested) <*> obj .: "nestedField1" <*>
obj .: "nestedField2"))
instance HsJSONPB.ToJSON WithNesting_Nested where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON WithNesting_Nested where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema WithNesting_Nested where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB

534
nix/third-party/proto3-suite/tests/TestProtoOneof.hs vendored
View File

@ -1,534 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
-- | Generated by Haskell protocol buffer compiler. DO NOT EDIT!
module TestProtoOneof where
import qualified Prelude as Hs
import qualified Proto3.Suite.DotProto as HsProtobuf
import qualified Proto3.Suite.Types as HsProtobuf
import qualified Proto3.Suite.Class as HsProtobuf
import qualified Proto3.Suite.JSONPB as HsJSONPB
import Proto3.Suite.JSONPB ((.=), (.:))
import qualified Proto3.Wire as HsProtobuf
import Control.Applicative ((<*>), (<|>), (<$>))
import qualified Control.Monad as Hs
import qualified Data.Text.Lazy as Hs (Text)
import qualified Data.ByteString as Hs
import qualified Data.String as Hs (fromString)
import qualified Data.Vector as Hs (Vector)
import qualified Data.Int as Hs (Int16, Int32, Int64)
import qualified Data.Word as Hs (Word16, Word32, Word64)
import qualified GHC.Generics as Hs
import qualified GHC.Enum as Hs
import qualified TestProtoOneofImport
data DummyMsg = DummyMsg{dummyMsgDummy :: Hs.Int32}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named DummyMsg where
nameOf _ = (Hs.fromString "DummyMsg")
instance HsProtobuf.Message DummyMsg where
encodeMessage _ DummyMsg{dummyMsgDummy = dummyMsgDummy}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
dummyMsgDummy)])
decodeMessage _
= (Hs.pure DummyMsg) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "dummy")
[]
Hs.Nothing)]
instance HsJSONPB.ToJSONPB DummyMsg where
toJSONPB (DummyMsg f1) = (HsJSONPB.object ["dummy" .= f1])
toEncodingPB (DummyMsg f1) = (HsJSONPB.pairs ["dummy" .= f1])
instance HsJSONPB.FromJSONPB DummyMsg where
parseJSONPB
= (HsJSONPB.withObject "DummyMsg"
(\ obj -> (Hs.pure DummyMsg) <*> obj .: "dummy"))
instance HsJSONPB.ToJSON DummyMsg where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON DummyMsg where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema DummyMsg where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data DummyEnum = DummyEnumDUMMY0
| DummyEnumDUMMY1
deriving (Hs.Show, Hs.Bounded, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named DummyEnum where
nameOf _ = (Hs.fromString "DummyEnum")
instance Hs.Enum DummyEnum where
toEnum 0 = DummyEnumDUMMY0
toEnum 1 = DummyEnumDUMMY1
toEnum i = (Hs.toEnumError "DummyEnum" i (0 :: Hs.Int, 1))
fromEnum (DummyEnumDUMMY0) = 0
fromEnum (DummyEnumDUMMY1) = 1
succ (DummyEnumDUMMY0) = DummyEnumDUMMY1
succ _ = Hs.succError "DummyEnum"
pred (DummyEnumDUMMY1) = DummyEnumDUMMY0
pred _ = Hs.predError "DummyEnum"
instance HsJSONPB.ToJSONPB DummyEnum where
toJSONPB x _ = HsJSONPB.enumFieldString x
toEncodingPB x _ = HsJSONPB.enumFieldEncoding x
instance HsJSONPB.FromJSONPB DummyEnum where
parseJSONPB (HsJSONPB.String "DUMMY0") = Hs.pure DummyEnumDUMMY0
parseJSONPB (HsJSONPB.String "DUMMY1") = Hs.pure DummyEnumDUMMY1
parseJSONPB v = (HsJSONPB.typeMismatch "DummyEnum" v)
instance HsJSONPB.ToJSON DummyEnum where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON DummyEnum where
parseJSON = HsJSONPB.parseJSONPB
instance HsProtobuf.Finite DummyEnum
data Something = Something{somethingValue :: Hs.Int64,
somethingAnother :: Hs.Int32,
somethingPickOne :: Hs.Maybe SomethingPickOne}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named Something where
nameOf _ = (Hs.fromString "Something")
instance HsProtobuf.Message Something where
encodeMessage _
Something{somethingValue = somethingValue,
somethingAnother = somethingAnother,
somethingPickOne = somethingPickOne}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Signed somethingValue)),
(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
(HsProtobuf.Signed somethingAnother)),
case somethingPickOne of
Hs.Nothing -> Hs.mempty
Hs.Just x
-> case x of
SomethingPickOneName y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 4)
(HsProtobuf.ForceEmit y))
SomethingPickOneSomeid y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 9)
(HsProtobuf.ForceEmit y))
SomethingPickOneDummyMsg1 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 10)
(HsProtobuf.Nested (Hs.Just y)))
SomethingPickOneDummyMsg2 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 11)
(HsProtobuf.Nested (Hs.Just y)))
SomethingPickOneDummyEnum y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 12)
(HsProtobuf.ForceEmit y))])
decodeMessage _
= (Hs.pure Something) <*>
((Hs.pure HsProtobuf.signed) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1)))
<*>
((Hs.pure HsProtobuf.signed) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 2)))
<*>
(HsProtobuf.oneof Hs.Nothing
[((HsProtobuf.FieldNumber 4),
(Hs.pure (Hs.Just Hs.. SomethingPickOneName)) <*>
HsProtobuf.decodeMessageField),
((HsProtobuf.FieldNumber 9),
(Hs.pure (Hs.Just Hs.. SomethingPickOneSomeid)) <*>
HsProtobuf.decodeMessageField),
((HsProtobuf.FieldNumber 10),
(Hs.pure (Hs.fmap SomethingPickOneDummyMsg1)) <*>
((Hs.pure HsProtobuf.nested) <*> HsProtobuf.decodeMessageField)),
((HsProtobuf.FieldNumber 11),
(Hs.pure (Hs.fmap SomethingPickOneDummyMsg2)) <*>
((Hs.pure HsProtobuf.nested) <*> HsProtobuf.decodeMessageField)),
((HsProtobuf.FieldNumber 12),
(Hs.pure (Hs.Just Hs.. SomethingPickOneDummyEnum)) <*>
HsProtobuf.decodeMessageField)])
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim HsProtobuf.SInt64)
(HsProtobuf.Single "value")
[]
Hs.Nothing),
(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 2)
(HsProtobuf.Prim HsProtobuf.SInt32)
(HsProtobuf.Single "another")
[]
Hs.Nothing)]
instance HsJSONPB.ToJSONPB Something where
toJSONPB (Something f1 f2 f4_or_f9_or_f10_or_f11_or_f12)
= (HsJSONPB.object
["value" .= f1, "another" .= f2,
case f4_or_f9_or_f10_or_f11_or_f12 of
Hs.Just (SomethingPickOneName f4) -> (HsJSONPB.pair "name" f4)
Hs.Just (SomethingPickOneSomeid f9) -> (HsJSONPB.pair "someid" f9)
Hs.Just (SomethingPickOneDummyMsg1 f10)
-> (HsJSONPB.pair "dummyMsg1" f10)
Hs.Just (SomethingPickOneDummyMsg2 f11)
-> (HsJSONPB.pair "dummyMsg2" f11)
Hs.Just (SomethingPickOneDummyEnum f12)
-> (HsJSONPB.pair "dummyEnum" f12)
Hs.Nothing -> Hs.mempty])
toEncodingPB (Something f1 f2 f4_or_f9_or_f10_or_f11_or_f12)
= (HsJSONPB.pairs
["value" .= f1, "another" .= f2,
case f4_or_f9_or_f10_or_f11_or_f12 of
Hs.Just (SomethingPickOneName f4) -> (HsJSONPB.pair "name" f4)
Hs.Just (SomethingPickOneSomeid f9) -> (HsJSONPB.pair "someid" f9)
Hs.Just (SomethingPickOneDummyMsg1 f10)
-> (HsJSONPB.pair "dummyMsg1" f10)
Hs.Just (SomethingPickOneDummyMsg2 f11)
-> (HsJSONPB.pair "dummyMsg2" f11)
Hs.Just (SomethingPickOneDummyEnum f12)
-> (HsJSONPB.pair "dummyEnum" f12)
Hs.Nothing -> Hs.mempty])
instance HsJSONPB.FromJSONPB Something where
parseJSONPB
= (HsJSONPB.withObject "Something"
(\ obj ->
(Hs.pure Something) <*> obj .: "value" <*> obj .: "another" <*>
Hs.msum
[Hs.Just Hs.. SomethingPickOneName <$>
(HsJSONPB.parseField obj "name"),
Hs.Just Hs.. SomethingPickOneSomeid <$>
(HsJSONPB.parseField obj "someid"),
Hs.Just Hs.. SomethingPickOneDummyMsg1 <$>
(HsJSONPB.parseField obj "dummyMsg1"),
Hs.Just Hs.. SomethingPickOneDummyMsg2 <$>
(HsJSONPB.parseField obj "dummyMsg2"),
Hs.Just Hs.. SomethingPickOneDummyEnum <$>
(HsJSONPB.parseField obj "dummyEnum"),
Hs.pure Hs.Nothing]))
instance HsJSONPB.ToJSON Something where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON Something where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema Something where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data SomethingPickOne = SomethingPickOneName Hs.Text
| SomethingPickOneSomeid Hs.Int32
| SomethingPickOneDummyMsg1 TestProtoOneof.DummyMsg
| SomethingPickOneDummyMsg2 TestProtoOneof.DummyMsg
| SomethingPickOneDummyEnum (HsProtobuf.Enumerated
TestProtoOneof.DummyEnum)
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named SomethingPickOne where
nameOf _ = (Hs.fromString "SomethingPickOne")
instance HsJSONPB.ToSchema SomethingPickOne where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data OneofFirst = OneofFirst{oneofFirstFirst ::
Hs.Maybe OneofFirstFirst,
oneofFirstLast :: Hs.Int32}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named OneofFirst where
nameOf _ = (Hs.fromString "OneofFirst")
instance HsProtobuf.Message OneofFirst where
encodeMessage _
OneofFirst{oneofFirstFirst = oneofFirstFirst,
oneofFirstLast = oneofFirstLast}
= (Hs.mconcat
[case oneofFirstFirst of
Hs.Nothing -> Hs.mempty
Hs.Just x
-> case x of
OneofFirstFirstChoice1 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
(HsProtobuf.ForceEmit y))
OneofFirstFirstChoice2 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
(HsProtobuf.ForceEmit y)),
(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 3)
oneofFirstLast)])
decodeMessage _
= (Hs.pure OneofFirst) <*>
(HsProtobuf.oneof Hs.Nothing
[((HsProtobuf.FieldNumber 1),
(Hs.pure (Hs.Just Hs.. OneofFirstFirstChoice1)) <*>
HsProtobuf.decodeMessageField),
((HsProtobuf.FieldNumber 2),
(Hs.pure (Hs.Just Hs.. OneofFirstFirstChoice2)) <*>
HsProtobuf.decodeMessageField)])
<*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 3))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 3)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "last")
[]
Hs.Nothing)]
instance HsJSONPB.ToJSONPB OneofFirst where
toJSONPB (OneofFirst f1_or_f2 f3)
= (HsJSONPB.object
[case f1_or_f2 of
Hs.Just (OneofFirstFirstChoice1 f1) -> (HsJSONPB.pair "choice1" f1)
Hs.Just (OneofFirstFirstChoice2 f2) -> (HsJSONPB.pair "choice2" f2)
Hs.Nothing -> Hs.mempty,
"last" .= f3])
toEncodingPB (OneofFirst f1_or_f2 f3)
= (HsJSONPB.pairs
[case f1_or_f2 of
Hs.Just (OneofFirstFirstChoice1 f1) -> (HsJSONPB.pair "choice1" f1)
Hs.Just (OneofFirstFirstChoice2 f2) -> (HsJSONPB.pair "choice2" f2)
Hs.Nothing -> Hs.mempty,
"last" .= f3])
instance HsJSONPB.FromJSONPB OneofFirst where
parseJSONPB
= (HsJSONPB.withObject "OneofFirst"
(\ obj ->
(Hs.pure OneofFirst) <*>
Hs.msum
[Hs.Just Hs.. OneofFirstFirstChoice1 <$>
(HsJSONPB.parseField obj "choice1"),
Hs.Just Hs.. OneofFirstFirstChoice2 <$>
(HsJSONPB.parseField obj "choice2"),
Hs.pure Hs.Nothing]
<*> obj .: "last"))
instance HsJSONPB.ToJSON OneofFirst where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON OneofFirst where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema OneofFirst where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data OneofFirstFirst = OneofFirstFirstChoice1 Hs.Text
| OneofFirstFirstChoice2 Hs.Text
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named OneofFirstFirst where
nameOf _ = (Hs.fromString "OneofFirstFirst")
instance HsJSONPB.ToSchema OneofFirstFirst where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data OneofMiddle = OneofMiddle{oneofMiddleFirst :: Hs.Int32,
oneofMiddleMiddle :: Hs.Maybe OneofMiddleMiddle,
oneofMiddleLast :: Hs.Int32}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named OneofMiddle where
nameOf _ = (Hs.fromString "OneofMiddle")
instance HsProtobuf.Message OneofMiddle where
encodeMessage _
OneofMiddle{oneofMiddleFirst = oneofMiddleFirst,
oneofMiddleMiddle = oneofMiddleMiddle,
oneofMiddleLast = oneofMiddleLast}
= (Hs.mconcat
[(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
oneofMiddleFirst),
case oneofMiddleMiddle of
Hs.Nothing -> Hs.mempty
Hs.Just x
-> case x of
OneofMiddleMiddleChoice1 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
(HsProtobuf.ForceEmit y))
OneofMiddleMiddleChoice2 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 3)
(HsProtobuf.ForceEmit y)),
(HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 4)
oneofMiddleLast)])
decodeMessage _
= (Hs.pure OneofMiddle) <*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 1))
<*>
(HsProtobuf.oneof Hs.Nothing
[((HsProtobuf.FieldNumber 2),
(Hs.pure (Hs.Just Hs.. OneofMiddleMiddleChoice1)) <*>
HsProtobuf.decodeMessageField),
((HsProtobuf.FieldNumber 3),
(Hs.pure (Hs.Just Hs.. OneofMiddleMiddleChoice2)) <*>
HsProtobuf.decodeMessageField)])
<*>
(HsProtobuf.at HsProtobuf.decodeMessageField
(HsProtobuf.FieldNumber 4))
dotProto _
= [(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "first")
[]
Hs.Nothing),
(HsProtobuf.DotProtoField (HsProtobuf.FieldNumber 4)
(HsProtobuf.Prim HsProtobuf.Int32)
(HsProtobuf.Single "last")
[]
Hs.Nothing)]
instance HsJSONPB.ToJSONPB OneofMiddle where
toJSONPB (OneofMiddle f1 f2_or_f3 f4)
= (HsJSONPB.object
["first" .= f1,
case f2_or_f3 of
Hs.Just (OneofMiddleMiddleChoice1 f2)
-> (HsJSONPB.pair "choice1" f2)
Hs.Just (OneofMiddleMiddleChoice2 f3)
-> (HsJSONPB.pair "choice2" f3)
Hs.Nothing -> Hs.mempty,
"last" .= f4])
toEncodingPB (OneofMiddle f1 f2_or_f3 f4)
= (HsJSONPB.pairs
["first" .= f1,
case f2_or_f3 of
Hs.Just (OneofMiddleMiddleChoice1 f2)
-> (HsJSONPB.pair "choice1" f2)
Hs.Just (OneofMiddleMiddleChoice2 f3)
-> (HsJSONPB.pair "choice2" f3)
Hs.Nothing -> Hs.mempty,
"last" .= f4])
instance HsJSONPB.FromJSONPB OneofMiddle where
parseJSONPB
= (HsJSONPB.withObject "OneofMiddle"
(\ obj ->
(Hs.pure OneofMiddle) <*> obj .: "first" <*>
Hs.msum
[Hs.Just Hs.. OneofMiddleMiddleChoice1 <$>
(HsJSONPB.parseField obj "choice1"),
Hs.Just Hs.. OneofMiddleMiddleChoice2 <$>
(HsJSONPB.parseField obj "choice2"),
Hs.pure Hs.Nothing]
<*> obj .: "last"))
instance HsJSONPB.ToJSON OneofMiddle where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON OneofMiddle where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema OneofMiddle where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data OneofMiddleMiddle = OneofMiddleMiddleChoice1 Hs.Text
| OneofMiddleMiddleChoice2 Hs.Text
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named OneofMiddleMiddle where
nameOf _ = (Hs.fromString "OneofMiddleMiddle")
instance HsJSONPB.ToSchema OneofMiddleMiddle where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data WithImported = WithImported{withImportedPickOne ::
Hs.Maybe WithImportedPickOne}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named WithImported where
nameOf _ = (Hs.fromString "WithImported")
instance HsProtobuf.Message WithImported where
encodeMessage _
WithImported{withImportedPickOne = withImportedPickOne}
= (Hs.mconcat
[case withImportedPickOne of
Hs.Nothing -> Hs.mempty
Hs.Just x
-> case x of
WithImportedPickOneDummyMsg1 y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
(HsProtobuf.Nested (Hs.Just y)))
WithImportedPickOneWithOneof y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
(HsProtobuf.Nested (Hs.Just y)))])
decodeMessage _
= (Hs.pure WithImported) <*>
(HsProtobuf.oneof Hs.Nothing
[((HsProtobuf.FieldNumber 1),
(Hs.pure (Hs.fmap WithImportedPickOneDummyMsg1)) <*>
((Hs.pure HsProtobuf.nested) <*> HsProtobuf.decodeMessageField)),
((HsProtobuf.FieldNumber 2),
(Hs.pure (Hs.fmap WithImportedPickOneWithOneof)) <*>
((Hs.pure HsProtobuf.nested) <*> HsProtobuf.decodeMessageField))])
dotProto _ = []
instance HsJSONPB.ToJSONPB WithImported where
toJSONPB (WithImported f1_or_f2)
= (HsJSONPB.object
[case f1_or_f2 of
Hs.Just (WithImportedPickOneDummyMsg1 f1)
-> (HsJSONPB.pair "dummyMsg1" f1)
Hs.Just (WithImportedPickOneWithOneof f2)
-> (HsJSONPB.pair "withOneof" f2)
Hs.Nothing -> Hs.mempty])
toEncodingPB (WithImported f1_or_f2)
= (HsJSONPB.pairs
[case f1_or_f2 of
Hs.Just (WithImportedPickOneDummyMsg1 f1)
-> (HsJSONPB.pair "dummyMsg1" f1)
Hs.Just (WithImportedPickOneWithOneof f2)
-> (HsJSONPB.pair "withOneof" f2)
Hs.Nothing -> Hs.mempty])
instance HsJSONPB.FromJSONPB WithImported where
parseJSONPB
= (HsJSONPB.withObject "WithImported"
(\ obj ->
(Hs.pure WithImported) <*>
Hs.msum
[Hs.Just Hs.. WithImportedPickOneDummyMsg1 <$>
(HsJSONPB.parseField obj "dummyMsg1"),
Hs.Just Hs.. WithImportedPickOneWithOneof <$>
(HsJSONPB.parseField obj "withOneof"),
Hs.pure Hs.Nothing]))
instance HsJSONPB.ToJSON WithImported where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON WithImported where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema WithImported where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data WithImportedPickOne = WithImportedPickOneDummyMsg1 TestProtoOneof.DummyMsg
| WithImportedPickOneWithOneof TestProtoOneofImport.WithOneof
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named WithImportedPickOne where
nameOf _ = (Hs.fromString "WithImportedPickOne")
instance HsJSONPB.ToSchema WithImportedPickOne where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB

101
nix/third-party/proto3-suite/tests/TestProtoOneofImport.hs vendored
View File

@ -1,101 +0,0 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
-- | Generated by Haskell protocol buffer compiler. DO NOT EDIT!
module TestProtoOneofImport where
import qualified Prelude as Hs
import qualified Proto3.Suite.DotProto as HsProtobuf
import qualified Proto3.Suite.Types as HsProtobuf
import qualified Proto3.Suite.Class as HsProtobuf
import qualified Proto3.Suite.JSONPB as HsJSONPB
import Proto3.Suite.JSONPB ((.=), (.:))
import qualified Proto3.Wire as HsProtobuf
import Control.Applicative ((<*>), (<|>), (<$>))
import qualified Control.Monad as Hs
import qualified Data.Text.Lazy as Hs (Text)
import qualified Data.ByteString as Hs
import qualified Data.String as Hs (fromString)
import qualified Data.Vector as Hs (Vector)
import qualified Data.Int as Hs (Int16, Int32, Int64)
import qualified Data.Word as Hs (Word16, Word32, Word64)
import qualified GHC.Generics as Hs
import qualified GHC.Enum as Hs
data WithOneof = WithOneof{withOneofPickOne ::
Hs.Maybe WithOneofPickOne}
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named WithOneof where
nameOf _ = (Hs.fromString "WithOneof")
instance HsProtobuf.Message WithOneof where
encodeMessage _ WithOneof{withOneofPickOne = withOneofPickOne}
= (Hs.mconcat
[case withOneofPickOne of
Hs.Nothing -> Hs.mempty
Hs.Just x
-> case x of
WithOneofPickOneA y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 1)
(HsProtobuf.ForceEmit y))
WithOneofPickOneB y
-> (HsProtobuf.encodeMessageField (HsProtobuf.FieldNumber 2)
(HsProtobuf.ForceEmit y))])
decodeMessage _
= (Hs.pure WithOneof) <*>
(HsProtobuf.oneof Hs.Nothing
[((HsProtobuf.FieldNumber 1),
(Hs.pure (Hs.Just Hs.. WithOneofPickOneA)) <*>
HsProtobuf.decodeMessageField),
((HsProtobuf.FieldNumber 2),
(Hs.pure (Hs.Just Hs.. WithOneofPickOneB)) <*>
HsProtobuf.decodeMessageField)])
dotProto _ = []
instance HsJSONPB.ToJSONPB WithOneof where
toJSONPB (WithOneof f1_or_f2)
= (HsJSONPB.object
[case f1_or_f2 of
Hs.Just (WithOneofPickOneA f1) -> (HsJSONPB.pair "a" f1)
Hs.Just (WithOneofPickOneB f2) -> (HsJSONPB.pair "b" f2)
Hs.Nothing -> Hs.mempty])
toEncodingPB (WithOneof f1_or_f2)
= (HsJSONPB.pairs
[case f1_or_f2 of
Hs.Just (WithOneofPickOneA f1) -> (HsJSONPB.pair "a" f1)
Hs.Just (WithOneofPickOneB f2) -> (HsJSONPB.pair "b" f2)
Hs.Nothing -> Hs.mempty])
instance HsJSONPB.FromJSONPB WithOneof where
parseJSONPB
= (HsJSONPB.withObject "WithOneof"
(\ obj ->
(Hs.pure WithOneof) <*>
Hs.msum
[Hs.Just Hs.. WithOneofPickOneA <$> (HsJSONPB.parseField obj "a"),
Hs.Just Hs.. WithOneofPickOneB <$> (HsJSONPB.parseField obj "b"),
Hs.pure Hs.Nothing]))
instance HsJSONPB.ToJSON WithOneof where
toJSON = HsJSONPB.toAesonValue
toEncoding = HsJSONPB.toAesonEncoding
instance HsJSONPB.FromJSON WithOneof where
parseJSON = HsJSONPB.parseJSONPB
instance HsJSONPB.ToSchema WithOneof where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB
data WithOneofPickOne = WithOneofPickOneA Hs.Text
| WithOneofPickOneB Hs.Int32
deriving (Hs.Show, Hs.Eq, Hs.Ord, Hs.Generic)
instance HsProtobuf.Named WithOneofPickOne where
nameOf _ = (Hs.fromString "WithOneofPickOne")
instance HsJSONPB.ToSchema WithOneofPickOne where
declareNamedSchema = HsJSONPB.genericDeclareNamedSchemaJSONPB

370
nix/third-party/proto3-suite/tests/check_simple_dot_proto.py vendored
View File

@ -1,370 +0,0 @@
#!/usr/bin/env python
import sys
# Import protoc generated {de,}serializers (generated from test_proto{,_import}.proto)
from test_proto_pb2 import *
from test_proto_import_pb2 import WithNesting as ImportedWithNesting
from test_proto_oneof_pb2 import Something, WithImported, DUMMY0, DUMMY1
from test_proto_oneof_import_pb2 import WithOneof
def read_proto(cls):
length = int(raw_input())
data = sys.stdin.read(length)
return cls.FromString(data)
# Test case 1: Trivial message
case1 = read_proto(Trivial)
assert case1.trivialField == 0x7BADBEEF
# Test case 2: Multiple fields
case2 = read_proto(MultipleFields)
assert case2.multiFieldDouble == 1.125
assert case2.multiFieldFloat == 1e9
assert case2.multiFieldInt32 == 0x1135
assert case2.multiFieldInt64 == 0x7FFAFABADDEAFFA0
assert case2.multiFieldString == "Goodnight moon"
assert case2.multiFieldBool == False
# Test case: SignedInts
caseSignedZero = read_proto(SignedInts)
assert caseSignedZero.signed32 == 0
assert caseSignedZero.signed64 == 0
caseSignedPosValues = read_proto(SignedInts)
assert caseSignedPosValues.signed32 == 42
assert caseSignedPosValues.signed64 == 84
caseSignedNegValues = read_proto(SignedInts)
assert caseSignedNegValues.signed32 == (-42)
assert caseSignedNegValues.signed64 == (-84)
caseSignedMinBound = read_proto(SignedInts)
assert caseSignedMinBound.signed32 == -(2**31)
assert caseSignedMinBound.signed64 == -(2**63)
caseSignedMaxBound = read_proto(SignedInts)
assert caseSignedMaxBound.signed32 == (2**32 - 1) / 2
assert caseSignedMaxBound.signed64 == (2**64 - 1) / 2
# Test case 3: Nested enumeration
case3a = read_proto(WithEnum)
assert case3a.enumField == WithEnum.ENUM1
case3b = read_proto(WithEnum)
assert case3b.enumField == WithEnum.ENUM2
case3c = read_proto(WithEnum)
assert case3c.enumField == WithEnum.ENUM3
case3d = read_proto(WithEnum)
assert case3d.enumField == 0xBEEF
# Test case 4: Nested messages
case4a = read_proto(WithNesting)
assert case4a.HasField('nestedMessage')
assert case4a.nestedMessage.nestedField1 == "testCase4 nestedField1"
assert case4a.nestedMessage.nestedField2 == 0xABCD
assert case4a.nestedMessage.nestedPacked == []
assert case4a.nestedMessage.nestedUnpacked == []
case4b = read_proto(WithNesting)
assert not case4b.HasField('nestedMessage')
# Test case 5: Nested repeated message
case5a = read_proto(WithNestingRepeated)
assert len(case5a.nestedMessages) == 3
assert case5a.nestedMessages[0].nestedField1 == "testCase5 nestedField1"
assert case5a.nestedMessages[0].nestedField2 == 0xDCBA
assert len(case5a.nestedMessages[0].nestedPacked) == 5
assert list(case5a.nestedMessages[0].nestedPacked) == [1, 1, 2, 3, 5]
assert len(case5a.nestedMessages[0].nestedUnpacked) == 4
assert list(case5a.nestedMessages[0].nestedUnpacked) == [0xB, 0xABCD, 0xBADBEEF, 0x10203040]
assert case5a.nestedMessages[1].nestedField1 == "Hello world"
assert case5a.nestedMessages[1].nestedField2 == 0x7FFFFFFF
assert len(case5a.nestedMessages[1].nestedPacked) == 3
assert list(case5a.nestedMessages[1].nestedPacked) == [0, 0, 0]
assert len(case5a.nestedMessages[1].nestedUnpacked) == 0
assert case5a.nestedMessages[2].nestedField1 == ""
assert case5a.nestedMessages[2].nestedField2 == 0
assert len(case5a.nestedMessages[2].nestedPacked) == 0
assert len(case5a.nestedMessages[2].nestedUnpacked) == 0
case5b = read_proto(WithNestingRepeated)
assert len(case5b.nestedMessages) == 0
# Test case 6: Nested repeated message
case6a = read_proto(WithNestingRepeatedInts)
assert len(case6a.nestedInts) == 1
assert case6a.nestedInts[0].nestedInt1 == 636513 and case6a.nestedInts[0].nestedInt2 == 619021
case6b = read_proto(WithNestingRepeatedInts)
assert len(case6b.nestedInts) == 0
case6c = read_proto(WithNestingRepeatedInts)
assert len(case6c.nestedInts) == 4
assert case6c.nestedInts[0].nestedInt1 == 636513 and case6c.nestedInts[0].nestedInt2 == 619021
assert case6c.nestedInts[1].nestedInt1 == 423549 and case6c.nestedInts[1].nestedInt2 == 687069
assert case6c.nestedInts[2].nestedInt1 == 545506 and case6c.nestedInts[2].nestedInt2 == 143731
assert case6c.nestedInts[3].nestedInt1 == 193605 and case6c.nestedInts[3].nestedInt2 == 385360
# Test case 7: Repeated int32 field
case7a = read_proto(WithRepetition)
assert len(case7a.repeatedField1) == 0
case7b = read_proto(WithRepetition)
assert list(case7b.repeatedField1) == range(1,10001)
# Test case 8: Fixed-width integer types
case8a = read_proto(WithFixed)
assert case8a.fixed1 == 0
assert case8a.fixed2 == 0
assert case8a.fixed3 == 0
assert case8a.fixed4 == 0
case8b = read_proto(WithFixed)
assert case8b.fixed1 == 2**32 - 1
assert case8b.fixed2 == (2**32 - 1) / 2
assert case8b.fixed3 == 2**64 - 1
assert case8b.fixed4 == (2**64 - 1) / 2
case8c = read_proto(WithFixed)
assert case8c.fixed1 == 0
assert case8c.fixed2 == -(2**31)
assert case8c.fixed3 == 0
assert case8c.fixed4 == -(2**63)
# Test case 9: bytes fields
case9a = read_proto(WithBytes)
assert case9a.bytes1 == "\x00\x00\x00\x01\x02\x03\xFF\xFF\x00\x01"
assert list(case9a.bytes2) == ["", "\x01", "\xAB\xBAhello", "\xBB"]
case9b = read_proto(WithBytes)
assert case9b.bytes1 == "Hello world"
assert len(case9b.bytes2) == 0
case9c = read_proto(WithBytes)
assert case9c.bytes1 == ""
assert list(case9c.bytes2) == ["Hello", "\x00world", "\x00\x00"]
case9d = read_proto(WithBytes)
assert case9d.bytes1 == ""
assert len(case9d.bytes2) == 0
# Test case 10: packed v unpacked repeated types
case10a = read_proto(WithPacking)
assert len(case10a.packing1) == 0 and len(case10a.packing2) == 0
case10b = read_proto(WithPacking)
assert list(case10b.packing1) == [100, 2000, 300, 4000, 500, 60000, 7000]
assert len(case10b.packing2) == 0
case10c = read_proto(WithPacking)
assert len(case10c.packing1) == 0
assert list(case10c.packing2) == [100, 2000, 300, 4000, 500, 60000, 7000]
case10d = read_proto(WithPacking)
assert list(case10d.packing1) == [1, 2, 3, 4, 5]
assert list(case10d.packing2) == [5, 4, 3, 2, 1]
# Test case 11: All possible packed types
case11a = read_proto(AllPackedTypes)
assert len(case11a.packedWord32) == 0 and len(case11a.packedWord64) == 0 and \
len(case11a.packedInt32) == 0 and len(case11a.packedInt64) == 0 and \
len(case11a.packedFixed32) == 0 and len(case11a.packedFixed64) == 0 and \
len(case11a.packedFloat) == 0 and len(case11a.packedDouble) == 0 and \
len(case11a.packedSFixed32) == 0 and len(case11a.packedSFixed64) == 0 and \
len(case11a.packedBool) == 0 and \
len(case11a.packedEnum) == 0 and \
len(case11a.unpackedEnum) == 0
case11b = read_proto(AllPackedTypes)
assert list(case11b.packedWord32) == [1] and list(case11b.packedWord64) == [2] and \
list(case11b.packedInt32) == [3] and list(case11b.packedInt64) == [4] and \
list(case11b.packedFixed32) == [5] and list(case11b.packedFixed64) == [6] and \
list(case11b.packedFloat) == [7] and list(case11b.packedDouble) == [8] and \
list(case11b.packedSFixed32) == [9] and list(case11b.packedSFixed64) == [10] and \
list(case11b.packedBool) == [False] and \
list(case11b.packedEnum) == [FLD0] and \
list(case11b.unpackedEnum) == [FLD0]
case11c = read_proto(AllPackedTypes)
assert list(case11c.packedWord32) == [1] and list(case11c.packedWord64) == [2] and \
list(case11c.packedInt32) == [-3] and list(case11c.packedInt64) == [-4] and \
list(case11c.packedFixed32) == [5] and list(case11c.packedFixed64) == [6] and \
list(case11c.packedFloat) == [-7] and list(case11c.packedDouble) == [-8] and \
list(case11c.packedSFixed32) == [-9] and list(case11c.packedSFixed64) == [-10] and \
list(case11c.packedBool) == [True] and \
list(case11c.packedEnum) == [FLD1] and \
list(case11c.unpackedEnum) == [FLD1]
case11d = read_proto(AllPackedTypes)
expected_fp = [x / 8.0 for x in range(8, 80001)]
assert list(case11d.packedWord32) == range(1,10001) and list(case11d.packedWord64) == range(1,10001) and \
list(case11d.packedInt32) == range(1,10001) and list(case11d.packedInt64) == range(1,10001) and \
list(case11d.packedFixed32) == range(1,10001) and list(case11d.packedFixed64) == range(1,10001) and \
list(case11d.packedFloat) == expected_fp and list(case11d.packedDouble) == expected_fp and \
list(case11d.packedSFixed32) == range(1,10001) and list(case11d.packedSFixed64) == range(1,10001) and \
list(case11d.packedBool) == [False,True] and \
list(case11d.packedEnum) == [FLD0,FLD1] and \
list(case11d.unpackedEnum) == [FLD0,FLD1]
# Test case 12: message with out of order field numbers
case12a = read_proto(OutOfOrderFields)
assert len(case12a.field1) == 0
assert case12a.field2 == ""
assert case12a.field3 == 2 ** 63 - 1
assert len(case12a.field4) == 0
case12b = read_proto(OutOfOrderFields)
assert list(case12b.field1) == range(1, 101, 6)
assert case12b.field2 == "This is a test"
assert case12b.field3 == -(2 ** 63)
assert list(case12b.field4) == ["This", "is", "a", "test"]
# Test case 13: Nested mesage with the same name as another package-level message
case13a = read_proto(ShadowedMessage)
assert case13a.name == "name"
assert case13a.value == 0x7DADBEEF
case13b = read_proto(MessageShadower)
assert case13b.shadowed_message.name == "name"
assert case13b.shadowed_message.value == "string value"
assert case13b.name == "another name"
case13c = read_proto(MessageShadower.ShadowedMessage)
assert case13c.name == "another name"
assert case13c.value == "another string"
# Test case 14: Qualified names
case14 = read_proto(WithQualifiedName)
assert case14.qname1.name == "int value"
assert case14.qname1.value == 42
assert case14.qname2.name == "string value"
assert case14.qname2.value == "hello world"
# Test case 15: imported WithNesting
case15 = read_proto(ImportedWithNesting)
assert not case15.HasField('nestedMessage2')
assert case15.HasField('nestedMessage1')
assert case15.nestedMessage1.nestedField1 == 1
assert case15.nestedMessage1.nestedField2 == 2
# Test case 16: Proper resolution of shadowed imported message names
case16 = read_proto(UsingImported)
assert case16.HasField('importedNesting') and case16.HasField('localNesting')
assert case16.importedNesting.nestedMessage1.nestedField1 == 1
assert case16.importedNesting.nestedMessage1.nestedField2 == 2
assert case16.importedNesting.nestedMessage2.nestedField1 == 3
assert case16.importedNesting.nestedMessage2.nestedField2 == 4
assert case16.localNesting.nestedMessage.nestedField1 == "field"
assert case16.localNesting.nestedMessage.nestedField2 == 0xBEEF
assert case16.localNesting.nestedMessage.nestedPacked == []
assert case16.localNesting.nestedMessage.nestedUnpacked == []
# Test case 17: Oneof
## Read default values for oneof subfields
case17a = read_proto(Something)
assert case17a.value == 1
assert case17a.another == 2
assert case17a.HasField('name') and case17a.name == ""
case17b = read_proto(Something)
assert case17b.value == 3
assert case17b.another == 4
assert case17b.HasField('someid') and case17b.someid == 0
case17c = read_proto(Something)
assert case17c.value == 5
assert case17c.another == 6
assert case17c.HasField('dummyMsg1') and case17c.dummyMsg1.dummy == 0
case17d = read_proto(Something)
assert case17d.value == 7
assert case17d.another == 8
assert case17d.HasField('dummyMsg2') and case17d.dummyMsg2.dummy == 0
case17e = read_proto(Something)
assert case17e.value == 9
assert case17e.another == 10
assert case17e.HasField('dummyEnum') and case17e.dummyEnum == DUMMY0
## Read non-default values for oneof subfields
case17f = read_proto(Something)
assert case17f.value == 1
assert case17f.another == 2
assert case17f.HasField('name') and case17f.name == "hello world"
case17g = read_proto(Something)
assert case17g.value == 3
assert case17g.another == 4
assert case17g.HasField('someid') and case17g.someid == 42
case17h = read_proto(Something)
assert case17h.value == 5
assert case17h.another == 6
assert case17h.HasField('dummyMsg1') and case17h.dummyMsg1.dummy == 66
case17i = read_proto(Something)
assert case17i.value == 7
assert case17i.another == 8
assert case17i.HasField('dummyMsg2') and case17i.dummyMsg2.dummy == 67
case17j = read_proto(Something)
assert case17j.value == 9
assert case17j.another == 10
assert case17j.HasField('dummyEnum') and case17j.dummyEnum == DUMMY1
# Read with oneof not set
case17k = read_proto(Something)
assert case17k.value == 11
assert case17k.another == 12
assert not case17k.HasField('name')
assert not case17k.HasField('someid')
assert not case17k.HasField('dummyMsg1')
assert not case17k.HasField('dummyMsg2')
assert not case17k.HasField('dummyEnum')
# Test case 18: Imported Oneof
case18a = read_proto(WithImported)
assert case18a.HasField('dummyMsg1') and case18a.dummyMsg1.dummy == 0
case18b = read_proto(WithImported)
assert case18b.HasField('dummyMsg1') and case18b.dummyMsg1.dummy == 68
case18c = read_proto(WithImported)
assert case18c.HasField('withOneof')
assert not case18c.withOneof.HasField('a')
assert not case18c.withOneof.HasField('b')
case18d = read_proto(WithImported)
assert case18d.HasField('withOneof')
assert case18d.withOneof.HasField('a') and case18d.withOneof.a == ""
assert not case18d.withOneof.HasField('b')
case18e = read_proto(WithImported)
assert case18e.HasField('withOneof')
assert not case18e.withOneof.HasField('a')
assert case18e.withOneof.HasField('b') and case18e.withOneof.b == 0
case18f = read_proto(WithImported)
assert case18f.HasField('withOneof')
assert case18f.withOneof.HasField('a') and case18f.withOneof.a == "foo"
assert not case18f.withOneof.HasField('b')
case18g = read_proto(WithImported)
assert case18g.HasField('withOneof')
assert not case18g.withOneof.HasField('a')
assert case18g.withOneof.HasField('b') and case18g.withOneof.b == 19
case18h = read_proto(WithImported)
assert not case18h.HasField('dummyMsg1')
assert not case18h.HasField('withOneof')
# Wait for the special 'done' messsage
done_msg = read_proto(MultipleFields)
assert done_msg.multiFieldString == "All tests complete"
# Exit with a special error code to signal that all tests completed successfully
exit(12)

15
nix/third-party/proto3-suite/tests/decode.sh vendored
View File

@ -1,15 +0,0 @@
#!/usr/bin/env bash
set -eu
hsTmpDir=$1
ghc \
--make \
-odir $hsTmpDir \
-hidir $hsTmpDir \
-o $hsTmpDir/simpleDecodeDotProto \
$hsTmpDir/TestProto.hs \
$hsTmpDir/TestProtoImport.hs \
$hsTmpDir/TestProtoOneof.hs \
$hsTmpDir/TestProtoOneofImport.hs \
tests/SimpleDecodeDotProto.hs \
>/dev/null

15
nix/third-party/proto3-suite/tests/encode.sh vendored
View File

@ -1,15 +0,0 @@
#!/usr/bin/env bash
set -eu
hsTmpDir=$1
ghc \
--make \
-odir $hsTmpDir \
-hidir $hsTmpDir \
-o $hsTmpDir/simpleEncodeDotProto \
$hsTmpDir/TestProto.hs \
$hsTmpDir/TestProtoImport.hs \
$hsTmpDir/TestProtoOneof.hs \
$hsTmpDir/TestProtoOneofImport.hs \
tests/SimpleEncodeDotProto.hs \
>/dev/null

Some files were not shown because too many files have changed in this diff Show More