Moving from govendor to dep, updated dependencies (#48)
* Moving from govendor to dep. * Making the pull request template more friendly. * Fixing akward space in PR template. * goimports run on whole project using ` goimports -w $(find . -type f -name '*.go' -not -path "./vendor/*" -not -path "./gen-go/*")` source of command: https://gist.github.com/bgentry/fd1ffef7dbde01857f66
This commit is contained in:
parent
9631aa3aab
commit
8d445c1c77
2186 changed files with 400410 additions and 352 deletions
93
vendor/git.apache.org/thrift.git/lib/hs/CMakeLists.txt
generated
vendored
Normal file
93
vendor/git.apache.org/thrift.git/lib/hs/CMakeLists.txt
generated
vendored
Normal file
|
@ -0,0 +1,93 @@
|
|||
#
|
||||
# Licensed to the Apache Software Foundation (ASF) under one
|
||||
# or more contributor license agreements. See the NOTICE file
|
||||
# distributed with this work for additional information
|
||||
# regarding copyright ownership. The ASF licenses this file
|
||||
# to you 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.
|
||||
#
|
||||
|
||||
# Rebuild when any of these files changes
|
||||
set(haskell_sources
|
||||
src/Thrift.hs
|
||||
src/Thrift/Arbitraries.hs
|
||||
src/Thrift/Protocol.hs
|
||||
src/Thrift/Protocol/Binary.hs
|
||||
src/Thrift/Protocol/Compact.hs
|
||||
src/Thrift/Protocol/JSON.hs
|
||||
src/Thrift/Server.hs
|
||||
src/Thrift/Transport.hs
|
||||
src/Thrift/Transport/Empty.hs
|
||||
src/Thrift/Transport/Framed.hs
|
||||
src/Thrift/Transport/Handle.hs
|
||||
src/Thrift/Transport/HttpClient.hs
|
||||
src/Thrift/Transport/IOBuffer.hs
|
||||
src/Thrift/Types.hs
|
||||
Thrift.cabal
|
||||
)
|
||||
|
||||
if(BUILD_TESTING)
|
||||
list(APPEND haskell_soruces
|
||||
test/Spec.hs
|
||||
test/BinarySpec.hs
|
||||
test/CompactSpec.hs
|
||||
test/JSONSpec.hs
|
||||
)
|
||||
set(hs_enable_test "--enable-tests")
|
||||
endif()
|
||||
|
||||
set(haskell_artifacts thrift_cabal.stamp)
|
||||
# Adding *.hi files so that any missing file triggers the build
|
||||
foreach(SRC ${haskell_sources})
|
||||
get_filename_component(EX ${SRC} EXT)
|
||||
if(${EX} STREQUAL ".hs")
|
||||
file(RELATIVE_PATH REL ${CMAKE_CURRENT_SOURCE_DIR}/src ${CMAKE_CURRENT_SOURCE_DIR}/${SRC})
|
||||
get_filename_component(DIR ${REL} DIRECTORY)
|
||||
get_filename_component(BASE ${REL} NAME_WE)
|
||||
list(APPEND haskell_artifacts dist/build/${DIR}/${BASE}.hi)
|
||||
endif()
|
||||
endforeach()
|
||||
|
||||
if(CMAKE_BUILD_TYPE STREQUAL "Debug")
|
||||
set(hs_optimize -O0)
|
||||
elseif(CMAKE_BUILD_TYPE STREQUAL "Release")
|
||||
set(hs_optimize -O1)
|
||||
endif()
|
||||
|
||||
add_custom_command(
|
||||
OUTPUT ${haskell_artifacts}
|
||||
COMMAND ${CABAL} update
|
||||
# Build dependencies first without --builddir, otherwise it fails.
|
||||
COMMAND ${CABAL} install --only-dependencies ${hs_enable_test}
|
||||
COMMAND ${CABAL} configure ${hs_optimize} ${hs_enable_test} --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist
|
||||
COMMAND ${CABAL} build --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist
|
||||
COMMAND ${CABAL} install --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist
|
||||
COMMAND ${CMAKE_COMMAND} -E touch ${CMAKE_CURRENT_BINARY_DIR}/thrift_cabal.stamp
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
|
||||
DEPENDS ${haskell_sources}
|
||||
COMMENT "Building Haskell library")
|
||||
|
||||
add_custom_target(haskell_library ALL
|
||||
DEPENDS ${haskell_artifacts})
|
||||
|
||||
if(BUILD_TESTING)
|
||||
add_test(NAME HaskellCabalCheck
|
||||
COMMAND ${CABAL} check
|
||||
WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
|
||||
add_test(NAME HaskellCabalTest
|
||||
# Cabal fails to find built executable when --builddir is specified.
|
||||
# So we invoke the executable directly.
|
||||
# COMMAND ${CABAL} test --builddir=${CMAKE_CURRENT_BINARY_DIR}/dist
|
||||
# WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR})
|
||||
COMMAND dist/build/spec/spec)
|
||||
endif()
|
202
vendor/git.apache.org/thrift.git/lib/hs/LICENSE
generated
vendored
Normal file
202
vendor/git.apache.org/thrift.git/lib/hs/LICENSE
generated
vendored
Normal file
|
@ -0,0 +1,202 @@
|
|||
|
||||
Apache License
|
||||
Version 2.0, January 2004
|
||||
http://www.apache.org/licenses/
|
||||
|
||||
TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION
|
||||
|
||||
1. Definitions.
|
||||
|
||||
"License" shall mean the terms and conditions for use, reproduction,
|
||||
and distribution as defined by Sections 1 through 9 of this document.
|
||||
|
||||
"Licensor" shall mean the copyright owner or entity authorized by
|
||||
the copyright owner that is granting the License.
|
||||
|
||||
"Legal Entity" shall mean the union of the acting entity and all
|
||||
other entities that control, are controlled by, or are under common
|
||||
control with that entity. For the purposes of this definition,
|
||||
"control" means (i) the power, direct or indirect, to cause the
|
||||
direction or management of such entity, whether by contract or
|
||||
otherwise, or (ii) ownership of fifty percent (50%) or more of the
|
||||
outstanding shares, or (iii) beneficial ownership of such entity.
|
||||
|
||||
"You" (or "Your") shall mean an individual or Legal Entity
|
||||
exercising permissions granted by this License.
|
||||
|
||||
"Source" form shall mean the preferred form for making modifications,
|
||||
including but not limited to software source code, documentation
|
||||
source, and configuration files.
|
||||
|
||||
"Object" form shall mean any form resulting from mechanical
|
||||
transformation or translation of a Source form, including but
|
||||
not limited to compiled object code, generated documentation,
|
||||
and conversions to other media types.
|
||||
|
||||
"Work" shall mean the work of authorship, whether in Source or
|
||||
Object form, made available under the License, as indicated by a
|
||||
copyright notice that is included in or attached to the work
|
||||
(an example is provided in the Appendix below).
|
||||
|
||||
"Derivative Works" shall mean any work, whether in Source or Object
|
||||
form, that is based on (or derived from) the Work and for which the
|
||||
editorial revisions, annotations, elaborations, or other modifications
|
||||
represent, as a whole, an original work of authorship. For the purposes
|
||||
of this License, Derivative Works shall not include works that remain
|
||||
separable from, or merely link (or bind by name) to the interfaces of,
|
||||
the Work and Derivative Works thereof.
|
||||
|
||||
"Contribution" shall mean any work of authorship, including
|
||||
the original version of the Work and any modifications or additions
|
||||
to that Work or Derivative Works thereof, that is intentionally
|
||||
submitted to Licensor for inclusion in the Work by the copyright owner
|
||||
or by an individual or Legal Entity authorized to submit on behalf of
|
||||
the copyright owner. For the purposes of this definition, "submitted"
|
||||
means any form of electronic, verbal, or written communication sent
|
||||
to the Licensor or its representatives, including but not limited to
|
||||
communication on electronic mailing lists, source code control systems,
|
||||
and issue tracking systems that are managed by, or on behalf of, the
|
||||
Licensor for the purpose of discussing and improving the Work, but
|
||||
excluding communication that is conspicuously marked or otherwise
|
||||
designated in writing by the copyright owner as "Not a Contribution."
|
||||
|
||||
"Contributor" shall mean Licensor and any individual or Legal Entity
|
||||
on behalf of whom a Contribution has been received by Licensor and
|
||||
subsequently incorporated within the Work.
|
||||
|
||||
2. Grant of Copyright License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
copyright license to reproduce, prepare Derivative Works of,
|
||||
publicly display, publicly perform, sublicense, and distribute the
|
||||
Work and such Derivative Works in Source or Object form.
|
||||
|
||||
3. Grant of Patent License. Subject to the terms and conditions of
|
||||
this License, each Contributor hereby grants to You a perpetual,
|
||||
worldwide, non-exclusive, no-charge, royalty-free, irrevocable
|
||||
(except as stated in this section) patent license to make, have made,
|
||||
use, offer to sell, sell, import, and otherwise transfer the Work,
|
||||
where such license applies only to those patent claims licensable
|
||||
by such Contributor that are necessarily infringed by their
|
||||
Contribution(s) alone or by combination of their Contribution(s)
|
||||
with the Work to which such Contribution(s) was submitted. If You
|
||||
institute patent litigation against any entity (including a
|
||||
cross-claim or counterclaim in a lawsuit) alleging that the Work
|
||||
or a Contribution incorporated within the Work constitutes direct
|
||||
or contributory patent infringement, then any patent licenses
|
||||
granted to You under this License for that Work shall terminate
|
||||
as of the date such litigation is filed.
|
||||
|
||||
4. Redistribution. You may reproduce and distribute copies of the
|
||||
Work or Derivative Works thereof in any medium, with or without
|
||||
modifications, and in Source or Object form, provided that You
|
||||
meet the following conditions:
|
||||
|
||||
(a) You must give any other recipients of the Work or
|
||||
Derivative Works a copy of this License; and
|
||||
|
||||
(b) You must cause any modified files to carry prominent notices
|
||||
stating that You changed the files; and
|
||||
|
||||
(c) You must retain, in the Source form of any Derivative Works
|
||||
that You distribute, all copyright, patent, trademark, and
|
||||
attribution notices from the Source form of the Work,
|
||||
excluding those notices that do not pertain to any part of
|
||||
the Derivative Works; and
|
||||
|
||||
(d) If the Work includes a "NOTICE" text file as part of its
|
||||
distribution, then any Derivative Works that You distribute must
|
||||
include a readable copy of the attribution notices contained
|
||||
within such NOTICE file, excluding those notices that do not
|
||||
pertain to any part of the Derivative Works, in at least one
|
||||
of the following places: within a NOTICE text file distributed
|
||||
as part of the Derivative Works; within the Source form or
|
||||
documentation, if provided along with the Derivative Works; or,
|
||||
within a display generated by the Derivative Works, if and
|
||||
wherever such third-party notices normally appear. The contents
|
||||
of the NOTICE file are for informational purposes only and
|
||||
do not modify the License. You may add Your own attribution
|
||||
notices within Derivative Works that You distribute, alongside
|
||||
or as an addendum to the NOTICE text from the Work, provided
|
||||
that such additional attribution notices cannot be construed
|
||||
as modifying the License.
|
||||
|
||||
You may add Your own copyright statement to Your modifications and
|
||||
may provide additional or different license terms and conditions
|
||||
for use, reproduction, or distribution of Your modifications, or
|
||||
for any such Derivative Works as a whole, provided Your use,
|
||||
reproduction, and distribution of the Work otherwise complies with
|
||||
the conditions stated in this License.
|
||||
|
||||
5. Submission of Contributions. Unless You explicitly state otherwise,
|
||||
any Contribution intentionally submitted for inclusion in the Work
|
||||
by You to the Licensor shall be under the terms and conditions of
|
||||
this License, without any additional terms or conditions.
|
||||
Notwithstanding the above, nothing herein shall supersede or modify
|
||||
the terms of any separate license agreement you may have executed
|
||||
with Licensor regarding such Contributions.
|
||||
|
||||
6. Trademarks. This License does not grant permission to use the trade
|
||||
names, trademarks, service marks, or product names of the Licensor,
|
||||
except as required for reasonable and customary use in describing the
|
||||
origin of the Work and reproducing the content of the NOTICE file.
|
||||
|
||||
7. Disclaimer of Warranty. Unless required by applicable law or
|
||||
agreed to in writing, Licensor provides the Work (and each
|
||||
Contributor provides its Contributions) on an "AS IS" BASIS,
|
||||
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
|
||||
implied, including, without limitation, any warranties or conditions
|
||||
of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A
|
||||
PARTICULAR PURPOSE. You are solely responsible for determining the
|
||||
appropriateness of using or redistributing the Work and assume any
|
||||
risks associated with Your exercise of permissions under this License.
|
||||
|
||||
8. Limitation of Liability. In no event and under no legal theory,
|
||||
whether in tort (including negligence), contract, or otherwise,
|
||||
unless required by applicable law (such as deliberate and grossly
|
||||
negligent acts) or agreed to in writing, shall any Contributor be
|
||||
liable to You for damages, including any direct, indirect, special,
|
||||
incidental, or consequential damages of any character arising as a
|
||||
result of this License or out of the use or inability to use the
|
||||
Work (including but not limited to damages for loss of goodwill,
|
||||
work stoppage, computer failure or malfunction, or any and all
|
||||
other commercial damages or losses), even if such Contributor
|
||||
has been advised of the possibility of such damages.
|
||||
|
||||
9. Accepting Warranty or Additional Liability. While redistributing
|
||||
the Work or Derivative Works thereof, You may choose to offer,
|
||||
and charge a fee for, acceptance of support, warranty, indemnity,
|
||||
or other liability obligations and/or rights consistent with this
|
||||
License. However, in accepting such obligations, You may act only
|
||||
on Your own behalf and on Your sole responsibility, not on behalf
|
||||
of any other Contributor, and only if You agree to indemnify,
|
||||
defend, and hold each Contributor harmless for any liability
|
||||
incurred by, or claims asserted against, such Contributor by reason
|
||||
of your accepting any such warranty or additional liability.
|
||||
|
||||
END OF TERMS AND CONDITIONS
|
||||
|
||||
APPENDIX: How to apply the Apache License to your work.
|
||||
|
||||
To apply the Apache License to your work, attach the following
|
||||
boilerplate notice, with the fields enclosed by brackets "[]"
|
||||
replaced with your own identifying information. (Don't include
|
||||
the brackets!) The text should be enclosed in the appropriate
|
||||
comment syntax for the file format. We also recommend that a
|
||||
file or class name and description of purpose be included on the
|
||||
same "printed page" as the copyright notice for easier
|
||||
identification within third-party archives.
|
||||
|
||||
Copyright [yyyy] [name of copyright owner]
|
||||
|
||||
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.
|
50
vendor/git.apache.org/thrift.git/lib/hs/Makefile.am
generated
vendored
Normal file
50
vendor/git.apache.org/thrift.git/lib/hs/Makefile.am
generated
vendored
Normal file
|
@ -0,0 +1,50 @@
|
|||
#
|
||||
# Licensed to the Apache Software Foundation (ASF) under one
|
||||
# or more contributor license agreements. See the NOTICE file
|
||||
# distributed with this work for additional information
|
||||
# regarding copyright ownership. The ASF licenses this file
|
||||
# to you 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.
|
||||
#
|
||||
|
||||
EXTRA_DIST = \
|
||||
coding_standards.md \
|
||||
CMakeLists.txt \
|
||||
LICENSE \
|
||||
README.md \
|
||||
Setup.lhs \
|
||||
TODO \
|
||||
Thrift.cabal \
|
||||
src \
|
||||
test
|
||||
|
||||
all-local:
|
||||
$(CABAL) update
|
||||
$(CABAL) install
|
||||
|
||||
install-exec-hook:
|
||||
$(CABAL) install
|
||||
|
||||
# Make sure this doesn't fail if Haskell is not configured.
|
||||
clean-local:
|
||||
$(CABAL) clean
|
||||
|
||||
maintainer-clean-local:
|
||||
$(CABAL) clean
|
||||
|
||||
check-local:
|
||||
$(CABAL) check
|
||||
$(CABAL) install --only-dependencies --enable-tests
|
||||
$(CABAL) configure --enable-tests
|
||||
$(CABAL) build
|
||||
$(CABAL) test
|
99
vendor/git.apache.org/thrift.git/lib/hs/README.md
generated
vendored
Normal file
99
vendor/git.apache.org/thrift.git/lib/hs/README.md
generated
vendored
Normal file
|
@ -0,0 +1,99 @@
|
|||
Haskell Thrift Bindings
|
||||
|
||||
License
|
||||
=======
|
||||
|
||||
Licensed to the Apache Software Foundation (ASF) under one
|
||||
or more contributor license agreements. See the NOTICE file
|
||||
distributed with this work for additional information
|
||||
regarding copyright ownership. The ASF licenses this file
|
||||
to you 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.
|
||||
|
||||
Compile
|
||||
=======
|
||||
|
||||
Use Cabal to compile and install; ./configure uses Cabal underneath, and that
|
||||
path is not yet well tested. Thrift's library and generated code should compile
|
||||
with pretty much any GHC extensions or warnings you enable (or disable).
|
||||
Please report this not being the case as a bug on
|
||||
https://issues.apache.org/jira/secure/CreateIssue!default.jspa
|
||||
|
||||
Chances you'll need to muck a bit with Cabal flags to install Thrift:
|
||||
|
||||
CABAL_CONFIGURE_FLAGS="--user" ./configure
|
||||
|
||||
Base Types
|
||||
==========
|
||||
|
||||
The mapping from Thrift types to Haskell's is:
|
||||
|
||||
* double -> Double
|
||||
* byte -> Data.Int.Int8
|
||||
* i16 -> Data.Int.Int16
|
||||
* i32 -> Data.Int.Int32
|
||||
* i64 -> Data.Int.Int64
|
||||
* string -> Text
|
||||
* binary -> Data.ByteString.Lazy
|
||||
* bool -> Boolean
|
||||
|
||||
Enums
|
||||
=====
|
||||
|
||||
Become Haskell 'data' types. Use fromEnum to get out the int value.
|
||||
|
||||
Lists
|
||||
=====
|
||||
|
||||
Become Data.Vector.Vector from the vector package.
|
||||
|
||||
Maps and Sets
|
||||
=============
|
||||
|
||||
Become Data.HashMap.Strict.Map and Data.HashSet.Set from the
|
||||
unordered-containers package.
|
||||
|
||||
Structs
|
||||
=======
|
||||
|
||||
Become records. Field labels are ugly, of the form f_STRUCTNAME_FIELDNAME. All
|
||||
fields are Maybe types.
|
||||
|
||||
Exceptions
|
||||
==========
|
||||
|
||||
Identical to structs. Use them with throw and catch from Control.Exception.
|
||||
|
||||
Client
|
||||
======
|
||||
|
||||
Just a bunch of functions. You may have to import a bunch of client files to
|
||||
deal with inheritance.
|
||||
|
||||
Interface
|
||||
=========
|
||||
|
||||
You should only have to import the last one in the chain of inheritors. To make
|
||||
an interface, declare a label:
|
||||
|
||||
data MyIface = MyIface
|
||||
|
||||
and then declare it an instance of each iface class, starting with the superest
|
||||
class and proceeding down (all the while defining the methods). Then pass your
|
||||
label to process as the handler.
|
||||
|
||||
Processor
|
||||
=========
|
||||
|
||||
Just a function that takes a handler label, protocols. It calls the
|
||||
superclasses process if there is a superclass.
|
21
vendor/git.apache.org/thrift.git/lib/hs/Setup.lhs
generated
vendored
Executable file
21
vendor/git.apache.org/thrift.git/lib/hs/Setup.lhs
generated
vendored
Executable file
|
@ -0,0 +1,21 @@
|
|||
#!/usr/bin/env runhaskell
|
||||
|
||||
> -- Licensed to the Apache Software Foundation (ASF) under one
|
||||
> -- or more contributor license agreements. See the NOTICE file
|
||||
> -- distributed with this work for additional information
|
||||
> -- regarding copyright ownership. The ASF licenses this file
|
||||
> -- to you 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.
|
||||
|
||||
> import Distribution.Simple
|
||||
> main = defaultMain
|
2
vendor/git.apache.org/thrift.git/lib/hs/TODO
generated
vendored
Normal file
2
vendor/git.apache.org/thrift.git/lib/hs/TODO
generated
vendored
Normal file
|
@ -0,0 +1,2 @@
|
|||
The library could stand to be built up more.
|
||||
Many modules need export lists.
|
80
vendor/git.apache.org/thrift.git/lib/hs/Thrift.cabal
generated
vendored
Normal file
80
vendor/git.apache.org/thrift.git/lib/hs/Thrift.cabal
generated
vendored
Normal file
|
@ -0,0 +1,80 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
Name: thrift
|
||||
Version: 0.10.0
|
||||
Cabal-Version: >= 1.8
|
||||
License: OtherLicense
|
||||
Category: Foreign
|
||||
Build-Type: Simple
|
||||
Synopsis: Haskell bindings for the Apache Thrift RPC system
|
||||
Homepage: http://thrift.apache.org
|
||||
Bug-Reports: https://issues.apache.org/jira/browse/THRIFT
|
||||
Maintainer: dev@thrift.apache.org
|
||||
License-File: LICENSE
|
||||
|
||||
Description:
|
||||
Haskell bindings for the Apache Thrift RPC system. Requires the use of the thrift code generator.
|
||||
|
||||
flag network-uri
|
||||
description: Get Network.URI from the network-uri package
|
||||
default: True
|
||||
|
||||
Library
|
||||
Hs-Source-Dirs:
|
||||
src
|
||||
Build-Depends:
|
||||
base >= 4, base < 5, containers, ghc-prim, attoparsec, binary, bytestring >= 0.10, base64-bytestring, hashable, HTTP, text, unordered-containers >= 0.2.6, vector == 0.10.12.2, QuickCheck >= 2.8.2, split
|
||||
if flag(network-uri)
|
||||
build-depends: network-uri >= 2.6, network >= 2.6
|
||||
else
|
||||
build-depends: network < 2.6
|
||||
Exposed-Modules:
|
||||
Thrift,
|
||||
Thrift.Arbitraries
|
||||
Thrift.Protocol,
|
||||
Thrift.Protocol.Binary,
|
||||
Thrift.Protocol.Compact,
|
||||
Thrift.Protocol.JSON,
|
||||
Thrift.Server,
|
||||
Thrift.Transport,
|
||||
Thrift.Transport.Empty,
|
||||
Thrift.Transport.Framed,
|
||||
Thrift.Transport.Handle,
|
||||
Thrift.Transport.HttpClient,
|
||||
Thrift.Transport.IOBuffer,
|
||||
Thrift.Transport.Memory,
|
||||
Thrift.Types
|
||||
Extensions:
|
||||
DeriveDataTypeable,
|
||||
ExistentialQuantification,
|
||||
FlexibleInstances,
|
||||
KindSignatures,
|
||||
MagicHash,
|
||||
RankNTypes,
|
||||
RecordWildCards,
|
||||
ScopedTypeVariables,
|
||||
TypeSynonymInstances
|
||||
|
||||
Test-Suite spec
|
||||
Type: exitcode-stdio-1.0
|
||||
Hs-Source-Dirs: test
|
||||
Ghc-Options: -Wall
|
||||
main-is: Spec.hs
|
||||
Build-Depends: base, thrift, hspec, QuickCheck >= 2.8.2, bytestring >= 0.10, unordered-containers >= 0.2.6
|
1
vendor/git.apache.org/thrift.git/lib/hs/coding_standards.md
generated
vendored
Normal file
1
vendor/git.apache.org/thrift.git/lib/hs/coding_standards.md
generated
vendored
Normal file
|
@ -0,0 +1 @@
|
|||
Please follow [General Coding Standards](/doc/coding_standards.md)
|
114
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift.hs
generated
vendored
Normal file
114
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift.hs
generated
vendored
Normal file
|
@ -0,0 +1,114 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift
|
||||
( module Thrift.Transport
|
||||
, module Thrift.Protocol
|
||||
, AppExnType(..)
|
||||
, AppExn(..)
|
||||
, readAppExn
|
||||
, writeAppExn
|
||||
, ThriftException(..)
|
||||
) where
|
||||
|
||||
import Control.Exception
|
||||
|
||||
import Data.Int
|
||||
import Data.Text.Lazy ( Text, pack, unpack )
|
||||
import Data.Text.Lazy.Encoding
|
||||
import Data.Typeable ( Typeable )
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
|
||||
import Thrift.Protocol
|
||||
import Thrift.Transport
|
||||
import Thrift.Types
|
||||
|
||||
data ThriftException = ThriftException
|
||||
deriving ( Show, Typeable )
|
||||
instance Exception ThriftException
|
||||
|
||||
data AppExnType
|
||||
= AE_UNKNOWN
|
||||
| AE_UNKNOWN_METHOD
|
||||
| AE_INVALID_MESSAGE_TYPE
|
||||
| AE_WRONG_METHOD_NAME
|
||||
| AE_BAD_SEQUENCE_ID
|
||||
| AE_MISSING_RESULT
|
||||
| AE_INTERNAL_ERROR
|
||||
| AE_PROTOCOL_ERROR
|
||||
| AE_INVALID_TRANSFORM
|
||||
| AE_INVALID_PROTOCOL
|
||||
| AE_UNSUPPORTED_CLIENT_TYPE
|
||||
deriving ( Eq, Show, Typeable )
|
||||
|
||||
instance Enum AppExnType where
|
||||
toEnum 0 = AE_UNKNOWN
|
||||
toEnum 1 = AE_UNKNOWN_METHOD
|
||||
toEnum 2 = AE_INVALID_MESSAGE_TYPE
|
||||
toEnum 3 = AE_WRONG_METHOD_NAME
|
||||
toEnum 4 = AE_BAD_SEQUENCE_ID
|
||||
toEnum 5 = AE_MISSING_RESULT
|
||||
toEnum 6 = AE_INTERNAL_ERROR
|
||||
toEnum 7 = AE_PROTOCOL_ERROR
|
||||
toEnum 8 = AE_INVALID_TRANSFORM
|
||||
toEnum 9 = AE_INVALID_PROTOCOL
|
||||
toEnum 10 = AE_UNSUPPORTED_CLIENT_TYPE
|
||||
toEnum t = error $ "Invalid AppExnType " ++ show t
|
||||
|
||||
fromEnum AE_UNKNOWN = 0
|
||||
fromEnum AE_UNKNOWN_METHOD = 1
|
||||
fromEnum AE_INVALID_MESSAGE_TYPE = 2
|
||||
fromEnum AE_WRONG_METHOD_NAME = 3
|
||||
fromEnum AE_BAD_SEQUENCE_ID = 4
|
||||
fromEnum AE_MISSING_RESULT = 5
|
||||
fromEnum AE_INTERNAL_ERROR = 6
|
||||
fromEnum AE_PROTOCOL_ERROR = 7
|
||||
fromEnum AE_INVALID_TRANSFORM = 8
|
||||
fromEnum AE_INVALID_PROTOCOL = 9
|
||||
fromEnum AE_UNSUPPORTED_CLIENT_TYPE = 10
|
||||
|
||||
data AppExn = AppExn { ae_type :: AppExnType, ae_message :: String }
|
||||
deriving ( Show, Typeable )
|
||||
instance Exception AppExn
|
||||
|
||||
writeAppExn :: (Protocol p, Transport t) => p t -> AppExn -> IO ()
|
||||
writeAppExn pt ae = writeVal pt $ TStruct $ Map.fromList
|
||||
[ (1, ("message", TString $ encodeUtf8 $ pack $ ae_message ae))
|
||||
, (2, ("type", TI32 $ fromIntegral $ fromEnum (ae_type ae)))
|
||||
]
|
||||
|
||||
readAppExn :: (Protocol p, Transport t) => p t -> IO AppExn
|
||||
readAppExn pt = do
|
||||
let typemap = Map.fromList [(1,("message",T_STRING)),(2,("type",T_I32))]
|
||||
TStruct fields <- readVal pt $ T_STRUCT typemap
|
||||
return $ readAppExnFields fields
|
||||
|
||||
readAppExnFields :: Map.HashMap Int16 (Text, ThriftVal) -> AppExn
|
||||
readAppExnFields fields = AppExn{
|
||||
ae_message = maybe undefined unwrapMessage $ Map.lookup 1 fields,
|
||||
ae_type = maybe undefined unwrapType $ Map.lookup 2 fields
|
||||
}
|
||||
where
|
||||
unwrapMessage (_, TString s) = unpack $ decodeUtf8 s
|
||||
unwrapMessage _ = undefined
|
||||
unwrapType (_, TI32 i) = toEnum $ fromIntegral i
|
||||
unwrapType _ = undefined
|
55
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Arbitraries.hs
generated
vendored
Normal file
55
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Arbitraries.hs
generated
vendored
Normal file
|
@ -0,0 +1,55 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Thrift.Arbitraries where
|
||||
|
||||
import Data.Bits()
|
||||
|
||||
import Test.QuickCheck.Arbitrary
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Data.HashSet as HSet
|
||||
import qualified Data.HashMap.Strict as HMap
|
||||
import Data.Hashable (Hashable)
|
||||
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import qualified Data.ByteString.Lazy as BS
|
||||
|
||||
-- String has an Arbitrary instance already
|
||||
-- Bool has an Arbitrary instance already
|
||||
-- A Thrift 'list' is a Vector.
|
||||
|
||||
instance Arbitrary ByteString where
|
||||
arbitrary = BS.pack . filter (/= 0) <$> arbitrary
|
||||
|
||||
instance (Arbitrary k) => Arbitrary (Vector.Vector k) where
|
||||
arbitrary = Vector.fromList <$> arbitrary
|
||||
|
||||
instance Arbitrary Text.Text where
|
||||
arbitrary = Text.pack . filter (/= '\0') <$> arbitrary
|
||||
|
||||
instance (Eq k, Hashable k, Arbitrary k) => Arbitrary (HSet.HashSet k) where
|
||||
arbitrary = HSet.fromList <$> arbitrary
|
||||
|
||||
instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) =>
|
||||
Arbitrary (HMap.HashMap k v) where
|
||||
arbitrary = HMap.fromList <$> arbitrary
|
||||
|
||||
{-
|
||||
To handle Thrift 'enum' we would ideally use something like:
|
||||
|
||||
instance (Enum a, Bounded a) => Arbitrary a
|
||||
where arbitrary = elements (enumFromTo minBound maxBound)
|
||||
|
||||
Unfortunately this doesn't play nicely with the type system.
|
||||
Instead we'll generate an arbitrary instance along with the code.
|
||||
-}
|
||||
|
||||
{-
|
||||
There might be some way to introspect on the Haskell structure of a
|
||||
Thrift 'struct' or 'exception' but generating the code directly is simpler.
|
||||
-}
|
149
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol.hs
generated
vendored
Normal file
149
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol.hs
generated
vendored
Normal file
|
@ -0,0 +1,149 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Protocol
|
||||
( Protocol(..)
|
||||
, ProtocolExn(..)
|
||||
, ProtocolExnType(..)
|
||||
, getTypeOf
|
||||
, runParser
|
||||
, versionMask
|
||||
, version1
|
||||
, bsToDouble
|
||||
, bsToDoubleLE
|
||||
) where
|
||||
|
||||
import Control.Exception
|
||||
import Data.Attoparsec.ByteString
|
||||
import Data.Bits
|
||||
import Data.ByteString.Lazy (ByteString, toStrict)
|
||||
import Data.ByteString.Unsafe
|
||||
import Data.Functor ((<$>))
|
||||
import Data.Int
|
||||
import Data.Monoid (mempty)
|
||||
import Data.Text.Lazy (Text)
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Word
|
||||
import Foreign.Ptr (castPtr)
|
||||
import Foreign.Storable (Storable, peek, poke)
|
||||
import System.IO.Unsafe
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
|
||||
import Thrift.Types
|
||||
import Thrift.Transport
|
||||
|
||||
versionMask :: Int32
|
||||
versionMask = fromIntegral (0xffff0000 :: Word32)
|
||||
|
||||
version1 :: Int32
|
||||
version1 = fromIntegral (0x80010000 :: Word32)
|
||||
|
||||
class Protocol a where
|
||||
getTransport :: Transport t => a t -> t
|
||||
|
||||
writeMessageBegin :: Transport t => a t -> (Text, MessageType, Int32) -> IO ()
|
||||
writeMessageEnd :: Transport t => a t -> IO ()
|
||||
writeMessageEnd _ = return ()
|
||||
|
||||
readMessageBegin :: Transport t => a t -> IO (Text, MessageType, Int32)
|
||||
readMessageEnd :: Transport t => a t -> IO ()
|
||||
readMessageEnd _ = return ()
|
||||
|
||||
serializeVal :: Transport t => a t -> ThriftVal -> ByteString
|
||||
deserializeVal :: Transport t => a t -> ThriftType -> ByteString -> ThriftVal
|
||||
|
||||
writeVal :: Transport t => a t -> ThriftVal -> IO ()
|
||||
writeVal p = tWrite (getTransport p) . serializeVal p
|
||||
readVal :: Transport t => a t -> ThriftType -> IO ThriftVal
|
||||
|
||||
data ProtocolExnType
|
||||
= PE_UNKNOWN
|
||||
| PE_INVALID_DATA
|
||||
| PE_NEGATIVE_SIZE
|
||||
| PE_SIZE_LIMIT
|
||||
| PE_BAD_VERSION
|
||||
| PE_NOT_IMPLEMENTED
|
||||
| PE_MISSING_REQUIRED_FIELD
|
||||
deriving ( Eq, Show, Typeable )
|
||||
|
||||
data ProtocolExn = ProtocolExn ProtocolExnType String
|
||||
deriving ( Show, Typeable )
|
||||
instance Exception ProtocolExn
|
||||
|
||||
getTypeOf :: ThriftVal -> ThriftType
|
||||
getTypeOf v = case v of
|
||||
TStruct{} -> T_STRUCT Map.empty
|
||||
TMap{} -> T_MAP T_VOID T_VOID
|
||||
TList{} -> T_LIST T_VOID
|
||||
TSet{} -> T_SET T_VOID
|
||||
TBool{} -> T_BOOL
|
||||
TByte{} -> T_BYTE
|
||||
TI16{} -> T_I16
|
||||
TI32{} -> T_I32
|
||||
TI64{} -> T_I64
|
||||
TString{} -> T_STRING
|
||||
TBinary{} -> T_BINARY
|
||||
TDouble{} -> T_DOUBLE
|
||||
|
||||
runParser :: (Protocol p, Transport t, Show a) => p t -> Parser a -> IO a
|
||||
runParser prot p = refill >>= getResult . parse p
|
||||
where
|
||||
refill = handle handleEOF $ toStrict <$> tReadAll (getTransport prot) 1
|
||||
getResult (Done _ a) = return a
|
||||
getResult (Partial k) = refill >>= getResult . k
|
||||
getResult f = throw $ ProtocolExn PE_INVALID_DATA (show f)
|
||||
|
||||
handleEOF :: SomeException -> IO BS.ByteString
|
||||
handleEOF = const $ return mempty
|
||||
|
||||
-- | Converts a ByteString to a Floating point number
|
||||
-- The ByteString is assumed to be encoded in network order (Big Endian)
|
||||
-- therefore the behavior of this function varies based on whether the local
|
||||
-- machine is big endian or little endian.
|
||||
bsToDouble :: BS.ByteString -> Double
|
||||
bsToDoubleLE :: BS.ByteString -> Double
|
||||
#if __BYTE_ORDER == __LITTLE_ENDIAN
|
||||
bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBsSwapped
|
||||
bsToDoubleLE bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs
|
||||
#else
|
||||
bsToDouble bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBs
|
||||
bsToDoubleLE bs = unsafeDupablePerformIO $ unsafeUseAsCString bs castBsSwapped
|
||||
#endif
|
||||
|
||||
|
||||
castBsSwapped chrPtr = do
|
||||
w <- peek (castPtr chrPtr)
|
||||
poke (castPtr chrPtr) (byteSwap w)
|
||||
peek (castPtr chrPtr)
|
||||
castBs = peek . castPtr
|
||||
|
||||
-- | Swap endianness of a 64-bit word
|
||||
byteSwap :: Word64 -> Word64
|
||||
byteSwap w = (w `shiftL` 56 .&. 0xFF00000000000000) .|.
|
||||
(w `shiftL` 40 .&. 0x00FF000000000000) .|.
|
||||
(w `shiftL` 24 .&. 0x0000FF0000000000) .|.
|
||||
(w `shiftL` 8 .&. 0x000000FF00000000) .|.
|
||||
(w `shiftR` 8 .&. 0x00000000FF000000) .|.
|
||||
(w `shiftR` 24 .&. 0x0000000000FF0000) .|.
|
||||
(w `shiftR` 40 .&. 0x000000000000FF00) .|.
|
||||
(w `shiftR` 56 .&. 0x00000000000000FF)
|
191
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol/Binary.hs
generated
vendored
Normal file
191
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol/Binary.hs
generated
vendored
Normal file
|
@ -0,0 +1,191 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Thrift.Protocol.Binary
|
||||
( module Thrift.Protocol
|
||||
, BinaryProtocol(..)
|
||||
) where
|
||||
|
||||
import Control.Exception ( throw )
|
||||
import Control.Monad
|
||||
import Data.Bits
|
||||
import Data.ByteString.Lazy.Builder
|
||||
import Data.Functor
|
||||
import Data.Int
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
|
||||
|
||||
import Thrift.Protocol
|
||||
import Thrift.Transport
|
||||
import Thrift.Types
|
||||
|
||||
import qualified Data.Attoparsec.ByteString as P
|
||||
import qualified Data.Attoparsec.ByteString.Lazy as LP
|
||||
import qualified Data.Binary as Binary
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Text.Lazy as LT
|
||||
|
||||
data BinaryProtocol a = BinaryProtocol a
|
||||
|
||||
-- NOTE: Reading and Writing functions rely on Builders and Data.Binary to
|
||||
-- encode and decode data. Data.Binary assumes that the binary values it is
|
||||
-- encoding to and decoding from are in BIG ENDIAN format, and converts the
|
||||
-- endianness as necessary to match the local machine.
|
||||
instance Protocol BinaryProtocol where
|
||||
getTransport (BinaryProtocol t) = t
|
||||
|
||||
writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
|
||||
buildBinaryValue (TI32 (version1 .|. fromIntegral (fromEnum t))) <>
|
||||
buildBinaryValue (TString $ encodeUtf8 n) <>
|
||||
buildBinaryValue (TI32 s)
|
||||
|
||||
readMessageBegin p = runParser p $ do
|
||||
TI32 ver <- parseBinaryValue T_I32
|
||||
if ver .&. versionMask /= version1
|
||||
then throw $ ProtocolExn PE_BAD_VERSION "Missing version identifier"
|
||||
else do
|
||||
TString s <- parseBinaryValue T_STRING
|
||||
TI32 sz <- parseBinaryValue T_I32
|
||||
return (decodeUtf8 s, toEnum $ fromIntegral $ ver .&. 0xFF, sz)
|
||||
|
||||
serializeVal _ = toLazyByteString . buildBinaryValue
|
||||
deserializeVal _ ty bs =
|
||||
case LP.eitherResult $ LP.parse (parseBinaryValue ty) bs of
|
||||
Left s -> error s
|
||||
Right val -> val
|
||||
|
||||
readVal p = runParser p . parseBinaryValue
|
||||
|
||||
-- | Writing Functions
|
||||
buildBinaryValue :: ThriftVal -> Builder
|
||||
buildBinaryValue (TStruct fields) = buildBinaryStruct fields <> buildType T_STOP
|
||||
buildBinaryValue (TMap ky vt entries) =
|
||||
buildType ky <>
|
||||
buildType vt <>
|
||||
int32BE (fromIntegral (length entries)) <>
|
||||
buildBinaryMap entries
|
||||
buildBinaryValue (TList ty entries) =
|
||||
buildType ty <>
|
||||
int32BE (fromIntegral (length entries)) <>
|
||||
buildBinaryList entries
|
||||
buildBinaryValue (TSet ty entries) =
|
||||
buildType ty <>
|
||||
int32BE (fromIntegral (length entries)) <>
|
||||
buildBinaryList entries
|
||||
buildBinaryValue (TBool b) =
|
||||
word8 $ toEnum $ if b then 1 else 0
|
||||
buildBinaryValue (TByte b) = int8 b
|
||||
buildBinaryValue (TI16 i) = int16BE i
|
||||
buildBinaryValue (TI32 i) = int32BE i
|
||||
buildBinaryValue (TI64 i) = int64BE i
|
||||
buildBinaryValue (TDouble d) = doubleBE d
|
||||
buildBinaryValue (TString s) = int32BE len <> lazyByteString s
|
||||
where
|
||||
len :: Int32 = fromIntegral (LBS.length s)
|
||||
buildBinaryValue (TBinary s) = buildBinaryValue (TString s)
|
||||
|
||||
buildBinaryStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder
|
||||
buildBinaryStruct = Map.foldrWithKey combine mempty
|
||||
where
|
||||
combine fid (_,val) s =
|
||||
buildTypeOf val <> int16BE fid <> buildBinaryValue val <> s
|
||||
|
||||
buildBinaryMap :: [(ThriftVal, ThriftVal)] -> Builder
|
||||
buildBinaryMap = foldl combine mempty
|
||||
where
|
||||
combine s (key, val) = s <> buildBinaryValue key <> buildBinaryValue val
|
||||
|
||||
buildBinaryList :: [ThriftVal] -> Builder
|
||||
buildBinaryList = foldr (mappend . buildBinaryValue) mempty
|
||||
|
||||
-- | Reading Functions
|
||||
parseBinaryValue :: ThriftType -> P.Parser ThriftVal
|
||||
parseBinaryValue (T_STRUCT tmap) = TStruct <$> parseBinaryStruct tmap
|
||||
parseBinaryValue (T_MAP _ _) = do
|
||||
kt <- parseType
|
||||
vt <- parseType
|
||||
n <- Binary.decode . LBS.fromStrict <$> P.take 4
|
||||
TMap kt vt <$> parseBinaryMap kt vt n
|
||||
parseBinaryValue (T_LIST _) = do
|
||||
t <- parseType
|
||||
n <- Binary.decode . LBS.fromStrict <$> P.take 4
|
||||
TList t <$> parseBinaryList t n
|
||||
parseBinaryValue (T_SET _) = do
|
||||
t <- parseType
|
||||
n <- Binary.decode . LBS.fromStrict <$> P.take 4
|
||||
TSet t <$> parseBinaryList t n
|
||||
parseBinaryValue T_BOOL = TBool . (/=0) <$> P.anyWord8
|
||||
parseBinaryValue T_BYTE = TByte . Binary.decode . LBS.fromStrict <$> P.take 1
|
||||
parseBinaryValue T_I16 = TI16 . Binary.decode . LBS.fromStrict <$> P.take 2
|
||||
parseBinaryValue T_I32 = TI32 . Binary.decode . LBS.fromStrict <$> P.take 4
|
||||
parseBinaryValue T_I64 = TI64 . Binary.decode . LBS.fromStrict <$> P.take 8
|
||||
parseBinaryValue T_DOUBLE = TDouble . bsToDouble <$> P.take 8
|
||||
parseBinaryValue T_STRING = parseBinaryString TString
|
||||
parseBinaryValue T_BINARY = parseBinaryString TBinary
|
||||
parseBinaryValue ty = error $ "Cannot read value of type " ++ show ty
|
||||
|
||||
parseBinaryString ty = do
|
||||
i :: Int32 <- Binary.decode . LBS.fromStrict <$> P.take 4
|
||||
ty . LBS.fromStrict <$> P.take (fromIntegral i)
|
||||
|
||||
parseBinaryStruct :: TypeMap -> P.Parser (Map.HashMap Int16 (LT.Text, ThriftVal))
|
||||
parseBinaryStruct tmap = Map.fromList <$> P.manyTill parseField (matchType T_STOP)
|
||||
where
|
||||
parseField = do
|
||||
t <- parseType
|
||||
n <- Binary.decode . LBS.fromStrict <$> P.take 2
|
||||
v <- case (t, Map.lookup n tmap) of
|
||||
(T_STRING, Just (_, T_BINARY)) -> parseBinaryValue T_BINARY
|
||||
_ -> parseBinaryValue t
|
||||
return (n, ("", v))
|
||||
|
||||
parseBinaryMap :: ThriftType -> ThriftType -> Int32 -> P.Parser [(ThriftVal, ThriftVal)]
|
||||
parseBinaryMap kt vt n | n <= 0 = return []
|
||||
| otherwise = do
|
||||
k <- parseBinaryValue kt
|
||||
v <- parseBinaryValue vt
|
||||
((k,v) :) <$> parseBinaryMap kt vt (n-1)
|
||||
|
||||
parseBinaryList :: ThriftType -> Int32 -> P.Parser [ThriftVal]
|
||||
parseBinaryList ty n | n <= 0 = return []
|
||||
| otherwise = liftM2 (:) (parseBinaryValue ty)
|
||||
(parseBinaryList ty (n-1))
|
||||
|
||||
|
||||
|
||||
-- | Write a type as a byte
|
||||
buildType :: ThriftType -> Builder
|
||||
buildType t = word8 $ fromIntegral $ fromEnum t
|
||||
|
||||
-- | Write type of a ThriftVal as a byte
|
||||
buildTypeOf :: ThriftVal -> Builder
|
||||
buildTypeOf = buildType . getTypeOf
|
||||
|
||||
-- | Read a byte as though it were a ThriftType
|
||||
parseType :: P.Parser ThriftType
|
||||
parseType = toEnum . fromIntegral <$> P.anyWord8
|
||||
|
||||
matchType :: ThriftType -> P.Parser ThriftType
|
||||
matchType t = t <$ P.word8 (fromIntegral $ fromEnum t)
|
301
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol/Compact.hs
generated
vendored
Normal file
301
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol/Compact.hs
generated
vendored
Normal file
|
@ -0,0 +1,301 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Thrift.Protocol.Compact
|
||||
( module Thrift.Protocol
|
||||
, CompactProtocol(..)
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Exception ( throw )
|
||||
import Control.Monad
|
||||
import Data.Attoparsec.ByteString as P
|
||||
import Data.Attoparsec.ByteString.Lazy as LP
|
||||
import Data.Bits
|
||||
import Data.ByteString.Lazy.Builder as B
|
||||
import Data.Int
|
||||
import Data.List as List
|
||||
import Data.Monoid
|
||||
import Data.Word
|
||||
import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8 )
|
||||
|
||||
import Thrift.Protocol hiding (versionMask)
|
||||
import Thrift.Transport
|
||||
import Thrift.Types
|
||||
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Text.Lazy as LT
|
||||
|
||||
-- | the Compact Protocol implements the standard Thrift 'TCompactProcotol'
|
||||
-- which is similar to the 'TBinaryProtocol', but takes less space on the wire.
|
||||
-- Integral types are encoded using as varints.
|
||||
data CompactProtocol a = CompactProtocol a
|
||||
-- ^ Constuct a 'CompactProtocol' with a 'Transport'
|
||||
|
||||
protocolID, version, versionMask, typeMask, typeBits :: Word8
|
||||
protocolID = 0x82 -- 1000 0010
|
||||
version = 0x01
|
||||
versionMask = 0x1f -- 0001 1111
|
||||
typeMask = 0xe0 -- 1110 0000
|
||||
typeBits = 0x07 -- 0000 0111
|
||||
typeShiftAmount :: Int
|
||||
typeShiftAmount = 5
|
||||
|
||||
|
||||
instance Protocol CompactProtocol where
|
||||
getTransport (CompactProtocol t) = t
|
||||
|
||||
writeMessageBegin p (n, t, s) = tWrite (getTransport p) $ toLazyByteString $
|
||||
B.word8 protocolID <>
|
||||
B.word8 ((version .&. versionMask) .|.
|
||||
(((fromIntegral $ fromEnum t) `shiftL`
|
||||
typeShiftAmount) .&. typeMask)) <>
|
||||
buildVarint (i32ToZigZag s) <>
|
||||
buildCompactValue (TString $ encodeUtf8 n)
|
||||
|
||||
readMessageBegin p = runParser p $ do
|
||||
pid <- fromIntegral <$> P.anyWord8
|
||||
when (pid /= protocolID) $ error "Bad Protocol ID"
|
||||
w <- fromIntegral <$> P.anyWord8
|
||||
let ver = w .&. versionMask
|
||||
when (ver /= version) $ error "Bad Protocol version"
|
||||
let typ = (w `shiftR` typeShiftAmount) .&. typeBits
|
||||
seqId <- parseVarint zigZagToI32
|
||||
TString name <- parseCompactValue T_STRING
|
||||
return (decodeUtf8 name, toEnum $ fromIntegral $ typ, seqId)
|
||||
|
||||
serializeVal _ = toLazyByteString . buildCompactValue
|
||||
deserializeVal _ ty bs =
|
||||
case LP.eitherResult $ LP.parse (parseCompactValue ty) bs of
|
||||
Left s -> error s
|
||||
Right val -> val
|
||||
|
||||
readVal p ty = runParser p $ parseCompactValue ty
|
||||
|
||||
|
||||
-- | Writing Functions
|
||||
buildCompactValue :: ThriftVal -> Builder
|
||||
buildCompactValue (TStruct fields) = buildCompactStruct fields
|
||||
buildCompactValue (TMap kt vt entries) =
|
||||
let len = fromIntegral $ length entries :: Word32 in
|
||||
if len == 0
|
||||
then B.word8 0x00
|
||||
else buildVarint len <>
|
||||
B.word8 (fromTType kt `shiftL` 4 .|. fromTType vt) <>
|
||||
buildCompactMap entries
|
||||
buildCompactValue (TList ty entries) =
|
||||
let len = length entries in
|
||||
(if len < 15
|
||||
then B.word8 $ (fromIntegral len `shiftL` 4) .|. fromTType ty
|
||||
else B.word8 (0xF0 .|. fromTType ty) <>
|
||||
buildVarint (fromIntegral len :: Word32)) <>
|
||||
buildCompactList entries
|
||||
buildCompactValue (TSet ty entries) = buildCompactValue (TList ty entries)
|
||||
buildCompactValue (TBool b) =
|
||||
B.word8 $ toEnum $ if b then 1 else 0
|
||||
buildCompactValue (TByte b) = int8 b
|
||||
buildCompactValue (TI16 i) = buildVarint $ i16ToZigZag i
|
||||
buildCompactValue (TI32 i) = buildVarint $ i32ToZigZag i
|
||||
buildCompactValue (TI64 i) = buildVarint $ i64ToZigZag i
|
||||
buildCompactValue (TDouble d) = doubleLE d
|
||||
buildCompactValue (TString s) = buildVarint len <> lazyByteString s
|
||||
where
|
||||
len = fromIntegral (LBS.length s) :: Word32
|
||||
buildCompactValue (TBinary s) = buildCompactValue (TString s)
|
||||
|
||||
buildCompactStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder
|
||||
buildCompactStruct = flip (loop 0) mempty . Map.toList
|
||||
where
|
||||
loop _ [] acc = acc <> B.word8 (fromTType T_STOP)
|
||||
loop lastId ((fid, (_,val)) : fields) acc = loop fid fields $ acc <>
|
||||
(if fid > lastId && fid - lastId <= 15
|
||||
then B.word8 $ fromIntegral ((fid - lastId) `shiftL` 4) .|. typeOf val
|
||||
else B.word8 (typeOf val) <> buildVarint (i16ToZigZag fid)) <>
|
||||
(if typeOf val > 0x02 -- Not a T_BOOL
|
||||
then buildCompactValue val
|
||||
else mempty) -- T_BOOLs are encoded in the type
|
||||
buildCompactMap :: [(ThriftVal, ThriftVal)] -> Builder
|
||||
buildCompactMap = foldl combine mempty
|
||||
where
|
||||
combine s (key, val) = buildCompactValue key <> buildCompactValue val <> s
|
||||
|
||||
buildCompactList :: [ThriftVal] -> Builder
|
||||
buildCompactList = foldr (mappend . buildCompactValue) mempty
|
||||
|
||||
-- | Reading Functions
|
||||
parseCompactValue :: ThriftType -> Parser ThriftVal
|
||||
parseCompactValue (T_STRUCT tmap) = TStruct <$> parseCompactStruct tmap
|
||||
parseCompactValue (T_MAP kt' vt') = do
|
||||
n <- parseVarint id
|
||||
if n == 0
|
||||
then return $ TMap kt' vt' []
|
||||
else do
|
||||
w <- P.anyWord8
|
||||
let kt = typeFrom $ w `shiftR` 4
|
||||
vt = typeFrom $ w .&. 0x0F
|
||||
TMap kt vt <$> parseCompactMap kt vt n
|
||||
parseCompactValue (T_LIST ty) = TList ty <$> parseCompactList
|
||||
parseCompactValue (T_SET ty) = TSet ty <$> parseCompactList
|
||||
parseCompactValue T_BOOL = TBool . (/=0) <$> P.anyWord8
|
||||
parseCompactValue T_BYTE = TByte . fromIntegral <$> P.anyWord8
|
||||
parseCompactValue T_I16 = TI16 <$> parseVarint zigZagToI16
|
||||
parseCompactValue T_I32 = TI32 <$> parseVarint zigZagToI32
|
||||
parseCompactValue T_I64 = TI64 <$> parseVarint zigZagToI64
|
||||
parseCompactValue T_DOUBLE = TDouble . bsToDoubleLE <$> P.take 8
|
||||
parseCompactValue T_STRING = parseCompactString TString
|
||||
parseCompactValue T_BINARY = parseCompactString TBinary
|
||||
parseCompactValue ty = error $ "Cannot read value of type " ++ show ty
|
||||
|
||||
parseCompactString ty = do
|
||||
len :: Word32 <- parseVarint id
|
||||
ty . LBS.fromStrict <$> P.take (fromIntegral len)
|
||||
|
||||
parseCompactStruct :: TypeMap -> Parser (Map.HashMap Int16 (LT.Text, ThriftVal))
|
||||
parseCompactStruct tmap = Map.fromList <$> parseFields 0
|
||||
where
|
||||
parseFields :: Int16 -> Parser [(Int16, (LT.Text, ThriftVal))]
|
||||
parseFields lastId = do
|
||||
w <- P.anyWord8
|
||||
if w == 0x00
|
||||
then return []
|
||||
else do
|
||||
let ty = typeFrom (w .&. 0x0F)
|
||||
modifier = (w .&. 0xF0) `shiftR` 4
|
||||
fid <- if modifier /= 0
|
||||
then return (lastId + fromIntegral modifier)
|
||||
else parseVarint zigZagToI16
|
||||
val <- if ty == T_BOOL
|
||||
then return (TBool $ (w .&. 0x0F) == 0x01)
|
||||
else case (ty, Map.lookup fid tmap) of
|
||||
(T_STRING, Just (_, T_BINARY)) -> parseCompactValue T_BINARY
|
||||
_ -> parseCompactValue ty
|
||||
((fid, (LT.empty, val)) : ) <$> parseFields fid
|
||||
|
||||
parseCompactMap :: ThriftType -> ThriftType -> Int32 ->
|
||||
Parser [(ThriftVal, ThriftVal)]
|
||||
parseCompactMap kt vt n | n <= 0 = return []
|
||||
| otherwise = do
|
||||
k <- parseCompactValue kt
|
||||
v <- parseCompactValue vt
|
||||
((k,v) :) <$> parseCompactMap kt vt (n-1)
|
||||
|
||||
parseCompactList :: Parser [ThriftVal]
|
||||
parseCompactList = do
|
||||
w <- P.anyWord8
|
||||
let ty = typeFrom $ w .&. 0x0F
|
||||
lsize = w `shiftR` 4
|
||||
size <- if lsize == 0xF
|
||||
then parseVarint id
|
||||
else return $ fromIntegral lsize
|
||||
loop ty size
|
||||
where
|
||||
loop :: ThriftType -> Int32 -> Parser [ThriftVal]
|
||||
loop ty n | n <= 0 = return []
|
||||
| otherwise = liftM2 (:) (parseCompactValue ty)
|
||||
(loop ty (n-1))
|
||||
|
||||
-- Signed numbers must be converted to "Zig Zag" format before they can be
|
||||
-- serialized in the Varint format
|
||||
i16ToZigZag :: Int16 -> Word16
|
||||
i16ToZigZag n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` 15)
|
||||
|
||||
zigZagToI16 :: Word16 -> Int16
|
||||
zigZagToI16 n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)
|
||||
|
||||
i32ToZigZag :: Int32 -> Word32
|
||||
i32ToZigZag n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` 31)
|
||||
|
||||
zigZagToI32 :: Word32 -> Int32
|
||||
zigZagToI32 n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)
|
||||
|
||||
i64ToZigZag :: Int64 -> Word64
|
||||
i64ToZigZag n = fromIntegral $ (n `shiftL` 1) `xor` (n `shiftR` 63)
|
||||
|
||||
zigZagToI64 :: Word64 -> Int64
|
||||
zigZagToI64 n = fromIntegral $ (n `shiftR` 1) `xor` negate (n .&. 0x1)
|
||||
|
||||
buildVarint :: (Bits a, Integral a) => a -> Builder
|
||||
buildVarint n | n .&. complement 0x7F == 0 = B.word8 $ fromIntegral n
|
||||
| otherwise = B.word8 (0x80 .|. (fromIntegral n .&. 0x7F)) <>
|
||||
buildVarint (n `shiftR` 7)
|
||||
|
||||
parseVarint :: (Bits a, Integral a, Ord a) => (a -> b) -> Parser b
|
||||
parseVarint fromZigZag = do
|
||||
bytestemp <- BS.unpack <$> P.takeTill (not . flip testBit 7)
|
||||
lsb <- P.anyWord8
|
||||
let bytes = lsb : List.reverse bytestemp
|
||||
return $ fromZigZag $ List.foldl' combine 0x00 bytes
|
||||
where combine a b = (a `shiftL` 7) .|. (fromIntegral b .&. 0x7f)
|
||||
|
||||
-- | Compute the Compact Type
|
||||
fromTType :: ThriftType -> Word8
|
||||
fromTType ty = case ty of
|
||||
T_STOP -> 0x00
|
||||
T_BOOL -> 0x01
|
||||
T_BYTE -> 0x03
|
||||
T_I16 -> 0x04
|
||||
T_I32 -> 0x05
|
||||
T_I64 -> 0x06
|
||||
T_DOUBLE -> 0x07
|
||||
T_STRING -> 0x08
|
||||
T_BINARY -> 0x08
|
||||
T_LIST{} -> 0x09
|
||||
T_SET{} -> 0x0A
|
||||
T_MAP{} -> 0x0B
|
||||
T_STRUCT{} -> 0x0C
|
||||
T_VOID -> error "No Compact type for T_VOID"
|
||||
|
||||
typeOf :: ThriftVal -> Word8
|
||||
typeOf v = case v of
|
||||
TBool True -> 0x01
|
||||
TBool False -> 0x02
|
||||
TByte _ -> 0x03
|
||||
TI16 _ -> 0x04
|
||||
TI32 _ -> 0x05
|
||||
TI64 _ -> 0x06
|
||||
TDouble _ -> 0x07
|
||||
TString _ -> 0x08
|
||||
TBinary _ -> 0x08
|
||||
TList{} -> 0x09
|
||||
TSet{} -> 0x0A
|
||||
TMap{} -> 0x0B
|
||||
TStruct{} -> 0x0C
|
||||
|
||||
typeFrom :: Word8 -> ThriftType
|
||||
typeFrom w = case w of
|
||||
0x01 -> T_BOOL
|
||||
0x02 -> T_BOOL
|
||||
0x03 -> T_BYTE
|
||||
0x04 -> T_I16
|
||||
0x05 -> T_I32
|
||||
0x06 -> T_I64
|
||||
0x07 -> T_DOUBLE
|
||||
0x08 -> T_STRING
|
||||
0x09 -> T_LIST T_VOID
|
||||
0x0A -> T_SET T_VOID
|
||||
0x0B -> T_MAP T_VOID T_VOID
|
||||
0x0C -> T_STRUCT Map.empty
|
||||
n -> error $ "typeFrom: " ++ show n ++ " is not a compact type"
|
352
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol/JSON.hs
generated
vendored
Normal file
352
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Protocol/JSON.hs
generated
vendored
Normal file
|
@ -0,0 +1,352 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
module Thrift.Protocol.JSON
|
||||
( module Thrift.Protocol
|
||||
, JSONProtocol(..)
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Attoparsec.ByteString as P
|
||||
import Data.Attoparsec.ByteString.Char8 as PC
|
||||
import Data.Attoparsec.ByteString.Lazy as LP
|
||||
import Data.ByteString.Base64.Lazy as B64C
|
||||
import Data.ByteString.Base64 as B64
|
||||
import Data.ByteString.Lazy.Builder as B
|
||||
import Data.ByteString.Internal (c2w, w2c)
|
||||
import Data.Functor
|
||||
import Data.Int
|
||||
import Data.List
|
||||
import Data.Maybe (catMaybes)
|
||||
import Data.Monoid
|
||||
import Data.Text.Lazy.Encoding
|
||||
import Data.Word
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
|
||||
import Thrift.Protocol
|
||||
import Thrift.Transport
|
||||
import Thrift.Types
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Lazy.Char8 as LBSC
|
||||
import qualified Data.Text.Lazy as LT
|
||||
|
||||
-- | The JSON Protocol data uses the standard 'TJSONProtocol'. Data is
|
||||
-- encoded as a JSON 'ByteString'
|
||||
data JSONProtocol t = JSONProtocol t
|
||||
-- ^ Construct a 'JSONProtocol' with a 'Transport'
|
||||
|
||||
instance Protocol JSONProtocol where
|
||||
getTransport (JSONProtocol t) = t
|
||||
|
||||
writeMessageBegin (JSONProtocol t) (s, ty, sq) = tWrite t $ toLazyByteString $
|
||||
B.char8 '[' <> buildShowable (1 :: Int32) <>
|
||||
B.string8 ",\"" <> escape (encodeUtf8 s) <> B.char8 '\"' <>
|
||||
B.char8 ',' <> buildShowable (fromEnum ty) <>
|
||||
B.char8 ',' <> buildShowable sq <>
|
||||
B.char8 ','
|
||||
writeMessageEnd (JSONProtocol t) = tWrite t "]"
|
||||
readMessageBegin p = runParser p $ skipSpace *> do
|
||||
_ver :: Int32 <- lexeme (PC.char8 '[') *> lexeme (signed decimal)
|
||||
bs <- lexeme (PC.char8 ',') *> lexeme escapedString
|
||||
case decodeUtf8' bs of
|
||||
Left _ -> fail "readMessage: invalid text encoding"
|
||||
Right str -> do
|
||||
ty <- toEnum <$> (lexeme (PC.char8 ',') *> lexeme (signed decimal))
|
||||
seqNum <- lexeme (PC.char8 ',') *> lexeme (signed decimal)
|
||||
_ <- PC.char8 ','
|
||||
return (str, ty, seqNum)
|
||||
readMessageEnd p = void $ runParser p (PC.char8 ']')
|
||||
|
||||
serializeVal _ = toLazyByteString . buildJSONValue
|
||||
deserializeVal _ ty bs =
|
||||
case LP.eitherResult $ LP.parse (parseJSONValue ty) bs of
|
||||
Left s -> error s
|
||||
Right val -> val
|
||||
|
||||
readVal p ty = runParser p $ skipSpace *> parseJSONValue ty
|
||||
|
||||
|
||||
-- Writing Functions
|
||||
|
||||
buildJSONValue :: ThriftVal -> Builder
|
||||
buildJSONValue (TStruct fields) = B.char8 '{' <> buildJSONStruct fields <> B.char8 '}'
|
||||
buildJSONValue (TMap kt vt entries) =
|
||||
B.char8 '[' <> B.char8 '"' <> getTypeName kt <> B.char8 '"' <>
|
||||
B.char8 ',' <> B.char8 '"' <> getTypeName vt <> B.char8 '"' <>
|
||||
B.char8 ',' <> buildShowable (length entries) <>
|
||||
B.char8 ',' <> B.char8 '{' <> buildJSONMap entries <> B.char8 '}' <>
|
||||
B.char8 ']'
|
||||
buildJSONValue (TList ty entries) =
|
||||
B.char8 '[' <> B.char8 '"' <> getTypeName ty <> B.char8 '"' <>
|
||||
B.char8 ',' <> buildShowable (length entries) <>
|
||||
(if length entries > 0
|
||||
then B.char8 ',' <> buildJSONList entries
|
||||
else mempty) <>
|
||||
B.char8 ']'
|
||||
buildJSONValue (TSet ty entries) = buildJSONValue (TList ty entries)
|
||||
buildJSONValue (TBool b) = if b then B.char8 '1' else B.char8 '0'
|
||||
buildJSONValue (TByte b) = buildShowable b
|
||||
buildJSONValue (TI16 i) = buildShowable i
|
||||
buildJSONValue (TI32 i) = buildShowable i
|
||||
buildJSONValue (TI64 i) = buildShowable i
|
||||
buildJSONValue (TDouble d) = buildShowable d
|
||||
buildJSONValue (TString s) = B.char8 '\"' <> escape s <> B.char8 '\"'
|
||||
buildJSONValue (TBinary s) = B.char8 '\"' <> (B.lazyByteString . B64C.encode $ s) <> B.char8 '\"'
|
||||
|
||||
buildJSONStruct :: Map.HashMap Int16 (LT.Text, ThriftVal) -> Builder
|
||||
buildJSONStruct = mconcat . intersperse (B.char8 ',') . Map.foldrWithKey buildField []
|
||||
where
|
||||
buildField fid (_,val) = (:) $
|
||||
B.char8 '"' <> buildShowable fid <> B.string8 "\":" <>
|
||||
B.char8 '{' <>
|
||||
B.char8 '"' <> getTypeName (getTypeOf val) <> B.string8 "\":" <>
|
||||
buildJSONValue val <>
|
||||
B.char8 '}'
|
||||
|
||||
buildJSONMap :: [(ThriftVal, ThriftVal)] -> Builder
|
||||
buildJSONMap = mconcat . intersperse (B.char8 ',') . map buildKV
|
||||
where
|
||||
buildKV (key@(TString _), val) =
|
||||
buildJSONValue key <> B.char8 ':' <> buildJSONValue val
|
||||
buildKV (key, val) =
|
||||
B.char8 '\"' <> buildJSONValue key <> B.string8 "\":" <> buildJSONValue val
|
||||
buildJSONList :: [ThriftVal] -> Builder
|
||||
buildJSONList = mconcat . intersperse (B.char8 ',') . map buildJSONValue
|
||||
|
||||
buildShowable :: Show a => a -> Builder
|
||||
buildShowable = B.string8 . show
|
||||
|
||||
-- Reading Functions
|
||||
|
||||
parseJSONValue :: ThriftType -> Parser ThriftVal
|
||||
parseJSONValue (T_STRUCT tmap) =
|
||||
TStruct <$> (lexeme (PC.char8 '{') *> parseJSONStruct tmap <* PC.char8 '}')
|
||||
parseJSONValue (T_MAP kt vt) = fmap (TMap kt vt) $
|
||||
between '[' ']' $
|
||||
lexeme escapedString *> lexeme (PC.char8 ',') *>
|
||||
lexeme escapedString *> lexeme (PC.char8 ',') *>
|
||||
lexeme decimal *> lexeme (PC.char8 ',') *>
|
||||
between '{' '}' (parseJSONMap kt vt)
|
||||
parseJSONValue (T_LIST ty) = fmap (TList ty) $
|
||||
between '[' ']' $ do
|
||||
len <- lexeme escapedString *> lexeme (PC.char8 ',') *> lexeme decimal
|
||||
if len > 0
|
||||
then lexeme (PC.char8 ',') *> parseJSONList ty
|
||||
else return []
|
||||
parseJSONValue (T_SET ty) = fmap (TSet ty) $
|
||||
between '[' ']' $ do
|
||||
len <- lexeme escapedString *> lexeme (PC.char8 ',') *> lexeme decimal
|
||||
if len > 0
|
||||
then lexeme (PC.char8 ',') *> parseJSONList ty
|
||||
else return []
|
||||
parseJSONValue T_BOOL =
|
||||
(TBool True <$ PC.char8 '1') <|> (TBool False <$ PC.char8 '0')
|
||||
parseJSONValue T_BYTE = TByte <$> signed decimal
|
||||
parseJSONValue T_I16 = TI16 <$> signed decimal
|
||||
parseJSONValue T_I32 = TI32 <$> signed decimal
|
||||
parseJSONValue T_I64 = TI64 <$> signed decimal
|
||||
parseJSONValue T_DOUBLE = TDouble <$> double
|
||||
parseJSONValue T_STRING = TString <$> escapedString
|
||||
parseJSONValue T_BINARY = TBinary <$> base64String
|
||||
parseJSONValue T_STOP = fail "parseJSONValue: cannot parse type T_STOP"
|
||||
parseJSONValue T_VOID = fail "parseJSONValue: cannot parse type T_VOID"
|
||||
|
||||
parseAnyValue :: Parser ()
|
||||
parseAnyValue = choice $
|
||||
skipBetween '{' '}' :
|
||||
skipBetween '[' ']' :
|
||||
map (void . parseJSONValue)
|
||||
[ T_BOOL
|
||||
, T_I16
|
||||
, T_I32
|
||||
, T_I64
|
||||
, T_DOUBLE
|
||||
, T_STRING
|
||||
, T_BINARY
|
||||
]
|
||||
where
|
||||
skipBetween :: Char -> Char -> Parser ()
|
||||
skipBetween a b = between a b $ void (PC.satisfy (\c -> c /= a && c /= b))
|
||||
<|> skipBetween a b
|
||||
|
||||
parseJSONStruct :: TypeMap -> Parser (Map.HashMap Int16 (LT.Text, ThriftVal))
|
||||
parseJSONStruct tmap = Map.fromList . catMaybes <$> parseField
|
||||
`sepBy` lexeme (PC.char8 ',')
|
||||
where
|
||||
parseField = do
|
||||
fid <- lexeme (between '"' '"' decimal) <* lexeme (PC.char8 ':')
|
||||
case Map.lookup fid tmap of
|
||||
Just (str, ftype) -> between '{' '}' $ do
|
||||
_ <- lexeme (escapedString) *> lexeme (PC.char8 ':')
|
||||
val <- lexeme (parseJSONValue ftype)
|
||||
return $ Just (fid, (str, val))
|
||||
Nothing -> lexeme parseAnyValue *> return Nothing
|
||||
|
||||
parseJSONMap :: ThriftType -> ThriftType -> Parser [(ThriftVal, ThriftVal)]
|
||||
parseJSONMap kt vt =
|
||||
((,) <$> lexeme (parseJSONKey kt) <*>
|
||||
(lexeme (PC.char8 ':') *> lexeme (parseJSONValue vt))) `sepBy`
|
||||
lexeme (PC.char8 ',')
|
||||
where
|
||||
parseJSONKey T_STRING = parseJSONValue T_STRING
|
||||
parseJSONKey T_BINARY = parseJSONValue T_BINARY
|
||||
parseJSONKey kt = PC.char8 '"' *> parseJSONValue kt <* PC.char8 '"'
|
||||
|
||||
parseJSONList :: ThriftType -> Parser [ThriftVal]
|
||||
parseJSONList ty = lexeme (parseJSONValue ty) `sepBy` lexeme (PC.char8 ',')
|
||||
|
||||
escapedString :: Parser LBS.ByteString
|
||||
escapedString = PC.char8 '"' *>
|
||||
(LBS.pack <$> P.many' (escapedChar <|> notChar8 '"')) <*
|
||||
PC.char8 '"'
|
||||
|
||||
base64String :: Parser LBS.ByteString
|
||||
base64String = PC.char8 '"' *>
|
||||
(decodeBase64 . LBSC.pack <$> P.many' (PC.notChar '"')) <*
|
||||
PC.char8 '"'
|
||||
where
|
||||
decodeBase64 b =
|
||||
let padded = case (LBS.length b) `mod` 4 of
|
||||
2 -> LBS.append b "=="
|
||||
3 -> LBS.append b "="
|
||||
_ -> b in
|
||||
case B64C.decode padded of
|
||||
Right s -> s
|
||||
Left x -> error x
|
||||
|
||||
escapedChar :: Parser Word8
|
||||
escapedChar = PC.char8 '\\' *> (c2w <$> choice
|
||||
[ '\SOH' <$ P.string "u0001"
|
||||
, '\STX' <$ P.string "u0002"
|
||||
, '\ETX' <$ P.string "u0003"
|
||||
, '\EOT' <$ P.string "u0004"
|
||||
, '\ENQ' <$ P.string "u0005"
|
||||
, '\ACK' <$ P.string "u0006"
|
||||
, '\BEL' <$ P.string "u0007"
|
||||
, '\BS' <$ P.string "u0008"
|
||||
, '\VT' <$ P.string "u000b"
|
||||
, '\FF' <$ P.string "u000c"
|
||||
, '\CR' <$ P.string "u000d"
|
||||
, '\SO' <$ P.string "u000e"
|
||||
, '\SI' <$ P.string "u000f"
|
||||
, '\DLE' <$ P.string "u0010"
|
||||
, '\DC1' <$ P.string "u0011"
|
||||
, '\DC2' <$ P.string "u0012"
|
||||
, '\DC3' <$ P.string "u0013"
|
||||
, '\DC4' <$ P.string "u0014"
|
||||
, '\NAK' <$ P.string "u0015"
|
||||
, '\SYN' <$ P.string "u0016"
|
||||
, '\ETB' <$ P.string "u0017"
|
||||
, '\CAN' <$ P.string "u0018"
|
||||
, '\EM' <$ P.string "u0019"
|
||||
, '\SUB' <$ P.string "u001a"
|
||||
, '\ESC' <$ P.string "u001b"
|
||||
, '\FS' <$ P.string "u001c"
|
||||
, '\GS' <$ P.string "u001d"
|
||||
, '\RS' <$ P.string "u001e"
|
||||
, '\US' <$ P.string "u001f"
|
||||
, '\DEL' <$ P.string "u007f"
|
||||
, '\0' <$ PC.char '0'
|
||||
, '\a' <$ PC.char 'a'
|
||||
, '\b' <$ PC.char 'b'
|
||||
, '\f' <$ PC.char 'f'
|
||||
, '\n' <$ PC.char 'n'
|
||||
, '\r' <$ PC.char 'r'
|
||||
, '\t' <$ PC.char 't'
|
||||
, '\v' <$ PC.char 'v'
|
||||
, '\"' <$ PC.char '"'
|
||||
, '\'' <$ PC.char '\''
|
||||
, '\\' <$ PC.char '\\'
|
||||
, '/' <$ PC.char '/'
|
||||
])
|
||||
|
||||
escape :: LBS.ByteString -> Builder
|
||||
escape = LBS.foldl' escapeChar mempty
|
||||
where
|
||||
escapeChar b w = b <> (B.lazyByteString $ case w2c w of
|
||||
'\0' -> "\\0"
|
||||
'\b' -> "\\b"
|
||||
'\f' -> "\\f"
|
||||
'\n' -> "\\n"
|
||||
'\r' -> "\\r"
|
||||
'\t' -> "\\t"
|
||||
'\"' -> "\\\""
|
||||
'\\' -> "\\\\"
|
||||
'\SOH' -> "\\u0001"
|
||||
'\STX' -> "\\u0002"
|
||||
'\ETX' -> "\\u0003"
|
||||
'\EOT' -> "\\u0004"
|
||||
'\ENQ' -> "\\u0005"
|
||||
'\ACK' -> "\\u0006"
|
||||
'\BEL' -> "\\u0007"
|
||||
'\VT' -> "\\u000b"
|
||||
'\SO' -> "\\u000e"
|
||||
'\SI' -> "\\u000f"
|
||||
'\DLE' -> "\\u0010"
|
||||
'\DC1' -> "\\u0011"
|
||||
'\DC2' -> "\\u0012"
|
||||
'\DC3' -> "\\u0013"
|
||||
'\DC4' -> "\\u0014"
|
||||
'\NAK' -> "\\u0015"
|
||||
'\SYN' -> "\\u0016"
|
||||
'\ETB' -> "\\u0017"
|
||||
'\CAN' -> "\\u0018"
|
||||
'\EM' -> "\\u0019"
|
||||
'\SUB' -> "\\u001a"
|
||||
'\ESC' -> "\\u001b"
|
||||
'\FS' -> "\\u001c"
|
||||
'\GS' -> "\\u001d"
|
||||
'\RS' -> "\\u001e"
|
||||
'\US' -> "\\u001f"
|
||||
'\DEL' -> "\\u007f"
|
||||
_ -> LBS.singleton w)
|
||||
|
||||
lexeme :: Parser a -> Parser a
|
||||
lexeme = (<* skipSpace)
|
||||
|
||||
notChar8 :: Char -> Parser Word8
|
||||
notChar8 c = P.satisfy (/= c2w c)
|
||||
|
||||
between :: Char -> Char -> Parser a -> Parser a
|
||||
between a b p = lexeme (PC.char8 a) *> lexeme p <* lexeme (PC.char8 b)
|
||||
|
||||
getTypeName :: ThriftType -> Builder
|
||||
getTypeName ty = B.string8 $ case ty of
|
||||
T_STRUCT _ -> "rec"
|
||||
T_MAP _ _ -> "map"
|
||||
T_LIST _ -> "lst"
|
||||
T_SET _ -> "set"
|
||||
T_BOOL -> "tf"
|
||||
T_BYTE -> "i8"
|
||||
T_I16 -> "i16"
|
||||
T_I32 -> "i32"
|
||||
T_I64 -> "i64"
|
||||
T_DOUBLE -> "dbl"
|
||||
T_STRING -> "str"
|
||||
T_BINARY -> "str"
|
||||
_ -> error "Unrecognized Type"
|
||||
|
66
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Server.hs
generated
vendored
Normal file
66
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Server.hs
generated
vendored
Normal file
|
@ -0,0 +1,66 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Server
|
||||
( runBasicServer
|
||||
, runThreadedServer
|
||||
) where
|
||||
|
||||
import Control.Concurrent ( forkIO )
|
||||
import Control.Exception
|
||||
import Control.Monad ( forever, when )
|
||||
|
||||
import Network
|
||||
|
||||
import System.IO
|
||||
|
||||
import Thrift
|
||||
import Thrift.Transport.Handle()
|
||||
import Thrift.Protocol.Binary
|
||||
|
||||
|
||||
-- | A threaded sever that is capable of using any Transport or Protocol
|
||||
-- instances.
|
||||
runThreadedServer :: (Transport t, Protocol i, Protocol o)
|
||||
=> (Socket -> IO (i t, o t))
|
||||
-> h
|
||||
-> (h -> (i t, o t) -> IO Bool)
|
||||
-> PortID
|
||||
-> IO a
|
||||
runThreadedServer accepter hand proc_ port = do
|
||||
socket <- listenOn port
|
||||
acceptLoop (accepter socket) (proc_ hand)
|
||||
|
||||
-- | A basic threaded binary protocol socket server.
|
||||
runBasicServer :: h
|
||||
-> (h -> (BinaryProtocol Handle, BinaryProtocol Handle) -> IO Bool)
|
||||
-> PortNumber
|
||||
-> IO a
|
||||
runBasicServer hand proc_ port = runThreadedServer binaryAccept hand proc_ (PortNumber port)
|
||||
where binaryAccept s = do
|
||||
(h, _, _) <- accept s
|
||||
return (BinaryProtocol h, BinaryProtocol h)
|
||||
|
||||
acceptLoop :: IO t -> (t -> IO Bool) -> IO a
|
||||
acceptLoop accepter proc_ = forever $
|
||||
do ps <- accepter
|
||||
forkIO $ handle (\(_ :: SomeException) -> return ())
|
||||
(loop $ proc_ ps)
|
||||
where loop m = do { continue <- m; when continue (loop m) }
|
65
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport.hs
generated
vendored
Normal file
65
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport.hs
generated
vendored
Normal file
|
@ -0,0 +1,65 @@
|
|||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport
|
||||
( Transport(..)
|
||||
, TransportExn(..)
|
||||
, TransportExnType(..)
|
||||
) where
|
||||
|
||||
import Control.Monad ( when )
|
||||
import Control.Exception ( Exception, throw )
|
||||
import Data.Functor ( (<$>) )
|
||||
import Data.Typeable ( Typeable )
|
||||
import Data.Word
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.Monoid
|
||||
|
||||
class Transport a where
|
||||
tIsOpen :: a -> IO Bool
|
||||
tClose :: a -> IO ()
|
||||
tRead :: a -> Int -> IO LBS.ByteString
|
||||
tPeek :: a -> IO (Maybe Word8)
|
||||
tWrite :: a -> LBS.ByteString -> IO ()
|
||||
tFlush :: a -> IO ()
|
||||
tReadAll :: a -> Int -> IO LBS.ByteString
|
||||
|
||||
tReadAll _ 0 = return mempty
|
||||
tReadAll a len = do
|
||||
result <- tRead a len
|
||||
let rlen = fromIntegral $ LBS.length result
|
||||
when (rlen == 0) (throw $ TransportExn "Cannot read. Remote side has closed." TE_UNKNOWN)
|
||||
if len <= rlen
|
||||
then return result
|
||||
else (result `mappend`) <$> tReadAll a (len - rlen)
|
||||
|
||||
data TransportExn = TransportExn String TransportExnType
|
||||
deriving ( Show, Typeable )
|
||||
instance Exception TransportExn
|
||||
|
||||
data TransportExnType
|
||||
= TE_UNKNOWN
|
||||
| TE_NOT_OPEN
|
||||
| TE_ALREADY_OPEN
|
||||
| TE_TIMED_OUT
|
||||
| TE_END_OF_FILE
|
||||
deriving ( Eq, Show, Typeable )
|
36
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Empty.hs
generated
vendored
Normal file
36
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Empty.hs
generated
vendored
Normal file
|
@ -0,0 +1,36 @@
|
|||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport.Empty
|
||||
( EmptyTransport(..)
|
||||
) where
|
||||
|
||||
import Thrift.Transport
|
||||
|
||||
data EmptyTransport = EmptyTransport
|
||||
|
||||
instance Transport EmptyTransport where
|
||||
tIsOpen = const $ return False
|
||||
tClose = const $ return ()
|
||||
tRead _ _ = return ""
|
||||
tPeek = const $ return Nothing
|
||||
tWrite _ _ = return ()
|
||||
tFlush = const$ return ()
|
99
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Framed.hs
generated
vendored
Normal file
99
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Framed.hs
generated
vendored
Normal file
|
@ -0,0 +1,99 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport.Framed
|
||||
( module Thrift.Transport
|
||||
, FramedTransport
|
||||
, openFramedTransport
|
||||
) where
|
||||
|
||||
import Thrift.Transport
|
||||
import Thrift.Transport.IOBuffer
|
||||
|
||||
import Data.Int (Int32)
|
||||
import qualified Data.Binary as B
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
|
||||
-- | FramedTransport wraps a given transport in framed mode.
|
||||
data FramedTransport t = FramedTransport {
|
||||
wrappedTrans :: t, -- ^ Underlying transport.
|
||||
writeBuffer :: WriteBuffer, -- ^ Write buffer.
|
||||
readBuffer :: ReadBuffer -- ^ Read buffer.
|
||||
}
|
||||
|
||||
-- | Create a new framed transport which wraps the given transport.
|
||||
openFramedTransport :: Transport t => t -> IO (FramedTransport t)
|
||||
openFramedTransport trans = do
|
||||
wbuf <- newWriteBuffer
|
||||
rbuf <- newReadBuffer
|
||||
return FramedTransport{ wrappedTrans = trans, writeBuffer = wbuf, readBuffer = rbuf }
|
||||
|
||||
instance Transport t => Transport (FramedTransport t) where
|
||||
|
||||
tClose = tClose . wrappedTrans
|
||||
|
||||
tRead trans n = do
|
||||
-- First, check the read buffer for any data.
|
||||
bs <- readBuf (readBuffer trans) n
|
||||
if LBS.null bs
|
||||
then
|
||||
-- When the buffer is empty, read another frame from the
|
||||
-- underlying transport.
|
||||
do len <- readFrame trans
|
||||
if len > 0
|
||||
then tRead trans n
|
||||
else return bs
|
||||
else return bs
|
||||
tPeek trans = do
|
||||
mw <- peekBuf (readBuffer trans)
|
||||
case mw of
|
||||
Just _ -> return mw
|
||||
Nothing -> do
|
||||
len <- readFrame trans
|
||||
if len > 0
|
||||
then tPeek trans
|
||||
else return Nothing
|
||||
|
||||
tWrite = writeBuf . writeBuffer
|
||||
|
||||
tFlush trans = do
|
||||
bs <- flushBuf (writeBuffer trans)
|
||||
let szBs = B.encode $ (fromIntegral $ LBS.length bs :: Int32)
|
||||
tWrite (wrappedTrans trans) szBs
|
||||
tWrite (wrappedTrans trans) bs
|
||||
tFlush (wrappedTrans trans)
|
||||
|
||||
tIsOpen = tIsOpen . wrappedTrans
|
||||
|
||||
readFrame :: Transport t => FramedTransport t -> IO Int
|
||||
readFrame trans = do
|
||||
-- Read and decode the frame size.
|
||||
szBs <- tRead (wrappedTrans trans) 4
|
||||
let sz = fromIntegral (B.decode szBs :: Int32)
|
||||
|
||||
-- Read the frame and stuff it into the read buffer.
|
||||
bs <- tRead (wrappedTrans trans) sz
|
||||
fillBuf (readBuffer trans) bs
|
||||
|
||||
-- Return the frame size so that the caller knows whether to expect
|
||||
-- something in the read buffer or not.
|
||||
return sz
|
68
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Handle.hs
generated
vendored
Normal file
68
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Handle.hs
generated
vendored
Normal file
|
@ -0,0 +1,68 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport.Handle
|
||||
( module Thrift.Transport
|
||||
, HandleSource(..)
|
||||
) where
|
||||
|
||||
import Control.Exception ( catch, throw )
|
||||
import Data.ByteString.Internal (c2w)
|
||||
import Data.Functor
|
||||
|
||||
import Network
|
||||
|
||||
import System.IO
|
||||
import System.IO.Error ( isEOFError )
|
||||
|
||||
import Thrift.Transport
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.Monoid
|
||||
|
||||
instance Transport Handle where
|
||||
tIsOpen = hIsOpen
|
||||
tClose = hClose
|
||||
tRead h n = LBS.hGet h n `Control.Exception.catch` handleEOF mempty
|
||||
tPeek h = (Just . c2w <$> hLookAhead h) `Control.Exception.catch` handleEOF Nothing
|
||||
tWrite = LBS.hPut
|
||||
tFlush = hFlush
|
||||
|
||||
|
||||
-- | Type class for all types that can open a Handle. This class is used to
|
||||
-- replace tOpen in the Transport type class.
|
||||
class HandleSource s where
|
||||
hOpen :: s -> IO Handle
|
||||
|
||||
instance HandleSource FilePath where
|
||||
hOpen s = openFile s ReadWriteMode
|
||||
|
||||
instance HandleSource (HostName, PortID) where
|
||||
hOpen = uncurry connectTo
|
||||
|
||||
|
||||
handleEOF :: a -> IOError -> IO a
|
||||
handleEOF a e = if isEOFError e
|
||||
then return a
|
||||
else throw $ TransportExn "TChannelTransport: Could not read" TE_UNKNOWN
|
101
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/HttpClient.hs
generated
vendored
Normal file
101
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/HttpClient.hs
generated
vendored
Normal file
|
@ -0,0 +1,101 @@
|
|||
{-# LANGUAGE FlexibleInstances #-}
|
||||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport.HttpClient
|
||||
( module Thrift.Transport
|
||||
, HttpClient (..)
|
||||
, openHttpClient
|
||||
) where
|
||||
|
||||
import Thrift.Transport
|
||||
import Thrift.Transport.IOBuffer
|
||||
import Network.URI
|
||||
import Network.HTTP hiding (port, host)
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Monoid (mempty)
|
||||
import Control.Exception (throw)
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
|
||||
-- | 'HttpClient', or THttpClient implements the Thrift Transport
|
||||
-- | Layer over http or https.
|
||||
data HttpClient =
|
||||
HttpClient {
|
||||
hstream :: HandleStream LBS.ByteString,
|
||||
uri :: URI,
|
||||
writeBuffer :: WriteBuffer,
|
||||
readBuffer :: ReadBuffer
|
||||
}
|
||||
|
||||
uriAuth :: URI -> URIAuth
|
||||
uriAuth = fromJust . uriAuthority
|
||||
|
||||
host :: URI -> String
|
||||
host = uriRegName . uriAuth
|
||||
|
||||
port :: URI -> Int
|
||||
port uri_ =
|
||||
if portStr == mempty then
|
||||
httpPort
|
||||
else
|
||||
read portStr
|
||||
where
|
||||
portStr = dropWhile (== ':') $ uriPort $ uriAuth uri_
|
||||
httpPort = 80
|
||||
|
||||
-- | Use 'openHttpClient' to create an HttpClient connected to @uri@
|
||||
openHttpClient :: URI -> IO HttpClient
|
||||
openHttpClient uri_ = do
|
||||
stream <- openTCPConnection (host uri_) (port uri_)
|
||||
wbuf <- newWriteBuffer
|
||||
rbuf <- newReadBuffer
|
||||
return $ HttpClient stream uri_ wbuf rbuf
|
||||
|
||||
instance Transport HttpClient where
|
||||
|
||||
tClose = close . hstream
|
||||
|
||||
tPeek = peekBuf . readBuffer
|
||||
|
||||
tRead = readBuf . readBuffer
|
||||
|
||||
tWrite = writeBuf . writeBuffer
|
||||
|
||||
tFlush hclient = do
|
||||
body <- flushBuf $ writeBuffer hclient
|
||||
let request = Request {
|
||||
rqURI = uri hclient,
|
||||
rqHeaders = [
|
||||
mkHeader HdrContentType "application/x-thrift",
|
||||
mkHeader HdrContentLength $ show $ LBS.length body],
|
||||
rqMethod = POST,
|
||||
rqBody = body
|
||||
}
|
||||
|
||||
res <- sendHTTP (hstream hclient) request
|
||||
case res of
|
||||
Right response ->
|
||||
fillBuf (readBuffer hclient) (rspBody response)
|
||||
Left _ ->
|
||||
throw $ TransportExn "THttpConnection: HTTP failure from server" TE_UNKNOWN
|
||||
return ()
|
||||
|
||||
tIsOpen _ = return True
|
69
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/IOBuffer.hs
generated
vendored
Normal file
69
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/IOBuffer.hs
generated
vendored
Normal file
|
@ -0,0 +1,69 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport.IOBuffer
|
||||
( WriteBuffer
|
||||
, newWriteBuffer
|
||||
, writeBuf
|
||||
, flushBuf
|
||||
, ReadBuffer
|
||||
, newReadBuffer
|
||||
, fillBuf
|
||||
, readBuf
|
||||
, peekBuf
|
||||
) where
|
||||
|
||||
import Data.ByteString.Lazy.Builder
|
||||
import Data.Functor
|
||||
import Data.IORef
|
||||
import Data.Monoid
|
||||
import Data.Word
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
type WriteBuffer = IORef Builder
|
||||
type ReadBuffer = IORef LBS.ByteString
|
||||
|
||||
newWriteBuffer :: IO WriteBuffer
|
||||
newWriteBuffer = newIORef mempty
|
||||
|
||||
writeBuf :: WriteBuffer -> LBS.ByteString -> IO ()
|
||||
writeBuf w s = modifyIORef w ( <> lazyByteString s)
|
||||
|
||||
flushBuf :: WriteBuffer -> IO LBS.ByteString
|
||||
flushBuf w = do
|
||||
buf <- readIORef w
|
||||
writeIORef w mempty
|
||||
return $ toLazyByteString buf
|
||||
|
||||
newReadBuffer :: IO ReadBuffer
|
||||
newReadBuffer = newIORef mempty
|
||||
|
||||
fillBuf :: ReadBuffer -> LBS.ByteString -> IO ()
|
||||
fillBuf = writeIORef
|
||||
|
||||
readBuf :: ReadBuffer -> Int -> IO LBS.ByteString
|
||||
readBuf r n = do
|
||||
bs <- readIORef r
|
||||
let (hd, tl) = LBS.splitAt (fromIntegral n) bs
|
||||
writeIORef r tl
|
||||
return hd
|
||||
|
||||
peekBuf :: ReadBuffer -> IO (Maybe Word8)
|
||||
peekBuf r = (fmap fst . LBS.uncons) <$> readIORef r
|
77
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Memory.hs
generated
vendored
Normal file
77
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Transport/Memory.hs
generated
vendored
Normal file
|
@ -0,0 +1,77 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module Thrift.Transport.Memory
|
||||
( openMemoryBuffer
|
||||
, MemoryBuffer(..)
|
||||
) where
|
||||
|
||||
import Data.ByteString.Lazy.Builder
|
||||
import Data.Functor
|
||||
import Data.IORef
|
||||
import Data.Monoid
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
import Thrift.Transport
|
||||
|
||||
|
||||
data MemoryBuffer = MemoryBuffer {
|
||||
writeBuffer :: IORef Builder,
|
||||
readBuffer :: IORef LBS.ByteString
|
||||
}
|
||||
|
||||
openMemoryBuffer :: IO MemoryBuffer
|
||||
openMemoryBuffer = do
|
||||
wbuf <- newIORef mempty
|
||||
rbuf <- newIORef mempty
|
||||
return MemoryBuffer {
|
||||
writeBuffer = wbuf,
|
||||
readBuffer = rbuf
|
||||
}
|
||||
|
||||
instance Transport MemoryBuffer where
|
||||
tIsOpen = const $ return False
|
||||
tClose = const $ return ()
|
||||
tFlush trans = do
|
||||
let wBuf = writeBuffer trans
|
||||
wb <- readIORef wBuf
|
||||
modifyIORef (readBuffer trans) $ \rb -> mappend rb $ toLazyByteString wb
|
||||
writeIORef wBuf mempty
|
||||
|
||||
tRead _ 0 = return mempty
|
||||
tRead trans n = do
|
||||
let rbuf = readBuffer trans
|
||||
rb <- readIORef rbuf
|
||||
let len = fromIntegral $ LBS.length rb
|
||||
if len == 0
|
||||
then do
|
||||
tFlush trans
|
||||
rb2 <- readIORef (readBuffer trans)
|
||||
if (fromIntegral $ LBS.length rb2) == 0
|
||||
then return mempty
|
||||
else tRead trans n
|
||||
else do
|
||||
let (ret, remain) = LBS.splitAt (fromIntegral n) rb
|
||||
writeIORef rbuf remain
|
||||
return ret
|
||||
|
||||
tPeek trans = (fmap fst . LBS.uncons) <$> readIORef (readBuffer trans)
|
||||
|
||||
tWrite trans v = do
|
||||
modifyIORef (writeBuffer trans) (<> lazyByteString v)
|
130
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Types.hs
generated
vendored
Normal file
130
vendor/git.apache.org/thrift.git/lib/hs/src/Thrift/Types.hs
generated
vendored
Normal file
|
@ -0,0 +1,130 @@
|
|||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
|
||||
module Thrift.Types where
|
||||
|
||||
import Data.Foldable (foldl')
|
||||
import Data.Hashable ( Hashable, hashWithSalt )
|
||||
import Data.Int
|
||||
import Test.QuickCheck.Arbitrary
|
||||
import Test.QuickCheck.Gen (elements)
|
||||
import Data.Text.Lazy (Text)
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashSet as Set
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
instance (Hashable a) => Hashable (Vector.Vector a) where
|
||||
hashWithSalt = Vector.foldl' hashWithSalt
|
||||
|
||||
|
||||
type TypeMap = Map.HashMap Int16 (Text, ThriftType)
|
||||
|
||||
data ThriftVal = TStruct (Map.HashMap Int16 (Text, ThriftVal))
|
||||
| TMap ThriftType ThriftType [(ThriftVal, ThriftVal)]
|
||||
| TList ThriftType [ThriftVal]
|
||||
| TSet ThriftType [ThriftVal]
|
||||
| TBool Bool
|
||||
| TByte Int8
|
||||
| TI16 Int16
|
||||
| TI32 Int32
|
||||
| TI64 Int64
|
||||
| TString LBS.ByteString
|
||||
| TBinary LBS.ByteString
|
||||
| TDouble Double
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- Information is needed here for collection types (ie T_STRUCT, T_MAP,
|
||||
-- T_LIST, and T_SET) so that we know what types those collections are
|
||||
-- parameterized by. In most protocols, this cannot be discerned directly
|
||||
-- from the data being read.
|
||||
data ThriftType
|
||||
= T_STOP
|
||||
| T_VOID
|
||||
| T_BOOL
|
||||
| T_BYTE
|
||||
| T_DOUBLE
|
||||
| T_I16
|
||||
| T_I32
|
||||
| T_I64
|
||||
| T_STRING
|
||||
| T_BINARY
|
||||
| T_STRUCT TypeMap
|
||||
| T_MAP ThriftType ThriftType
|
||||
| T_SET ThriftType
|
||||
| T_LIST ThriftType
|
||||
deriving ( Eq, Show )
|
||||
|
||||
-- NOTE: when using toEnum information about parametized types is NOT preserved.
|
||||
-- This design choice is consistent woth the Thrift implementation in other
|
||||
-- languages
|
||||
instance Enum ThriftType where
|
||||
fromEnum T_STOP = 0
|
||||
fromEnum T_VOID = 1
|
||||
fromEnum T_BOOL = 2
|
||||
fromEnum T_BYTE = 3
|
||||
fromEnum T_DOUBLE = 4
|
||||
fromEnum T_I16 = 6
|
||||
fromEnum T_I32 = 8
|
||||
fromEnum T_I64 = 10
|
||||
fromEnum T_STRING = 11
|
||||
fromEnum T_BINARY = 11
|
||||
fromEnum (T_STRUCT _) = 12
|
||||
fromEnum (T_MAP _ _) = 13
|
||||
fromEnum (T_SET _) = 14
|
||||
fromEnum (T_LIST _) = 15
|
||||
|
||||
toEnum 0 = T_STOP
|
||||
toEnum 1 = T_VOID
|
||||
toEnum 2 = T_BOOL
|
||||
toEnum 3 = T_BYTE
|
||||
toEnum 4 = T_DOUBLE
|
||||
toEnum 6 = T_I16
|
||||
toEnum 8 = T_I32
|
||||
toEnum 10 = T_I64
|
||||
toEnum 11 = T_STRING
|
||||
-- toEnum 11 = T_BINARY
|
||||
toEnum 12 = T_STRUCT Map.empty
|
||||
toEnum 13 = T_MAP T_VOID T_VOID
|
||||
toEnum 14 = T_SET T_VOID
|
||||
toEnum 15 = T_LIST T_VOID
|
||||
toEnum t = error $ "Invalid ThriftType " ++ show t
|
||||
|
||||
data MessageType
|
||||
= M_CALL
|
||||
| M_REPLY
|
||||
| M_EXCEPTION
|
||||
| M_ONEWAY
|
||||
deriving ( Eq, Show )
|
||||
|
||||
instance Enum MessageType where
|
||||
fromEnum M_CALL = 1
|
||||
fromEnum M_REPLY = 2
|
||||
fromEnum M_EXCEPTION = 3
|
||||
fromEnum M_ONEWAY = 4
|
||||
|
||||
toEnum 1 = M_CALL
|
||||
toEnum 2 = M_REPLY
|
||||
toEnum 3 = M_EXCEPTION
|
||||
toEnum 4 = M_ONEWAY
|
||||
toEnum t = error $ "Invalid MessageType " ++ show t
|
||||
|
||||
instance Arbitrary MessageType where
|
||||
arbitrary = elements [M_CALL, M_REPLY, M_EXCEPTION, M_ONEWAY]
|
91
vendor/git.apache.org/thrift.git/lib/hs/test/BinarySpec.hs
generated
vendored
Normal file
91
vendor/git.apache.org/thrift.git/lib/hs/test/BinarySpec.hs
generated
vendored
Normal file
|
@ -0,0 +1,91 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module BinarySpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck (prop)
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Lazy.Char8 as C
|
||||
|
||||
import Thrift.Types
|
||||
import Thrift.Transport
|
||||
import Thrift.Transport.Memory
|
||||
import Thrift.Protocol
|
||||
import Thrift.Protocol.Binary
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "BinaryProtocol" $ do
|
||||
describe "double" $ do
|
||||
it "writes in big endian order" $ do
|
||||
let val = 2 ** 53
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
writeVal proto (TDouble val)
|
||||
bin <- tRead trans 8
|
||||
(LBS.unpack bin) `shouldBe`[67, 64, 0, 0, 0, 0, 0, 0]
|
||||
|
||||
it "reads in big endian order" $ do
|
||||
let bin = LBS.pack [67, 64, 0, 0, 0, 0, 0, 0]
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
tWrite trans bin
|
||||
val <- readVal proto T_DOUBLE
|
||||
val `shouldBe` (TDouble $ 2 ** 53)
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
writeVal proto $ TDouble val
|
||||
val2 <- readVal proto T_DOUBLE
|
||||
val2 `shouldBe` (TDouble val)
|
||||
|
||||
describe "string" $ do
|
||||
it "writes" $ do
|
||||
let val = C.pack "aaa"
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
writeVal proto (TString val)
|
||||
bin <- tRead trans 7
|
||||
(LBS.unpack bin) `shouldBe` [0, 0, 0, 3, 97, 97, 97]
|
||||
|
||||
describe "binary" $ do
|
||||
it "writes" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
writeVal proto (TBinary $ LBS.pack [42, 43, 44])
|
||||
bin <- tRead trans 100
|
||||
(LBS.unpack bin) `shouldBe` [0, 0, 0, 3, 42, 43, 44]
|
||||
|
||||
it "reads" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
tWrite trans $ LBS.pack [0, 0, 0, 3, 42, 43, 44]
|
||||
val <- readVal proto (T_BINARY)
|
||||
val `shouldBe` (TBinary $ LBS.pack [42, 43, 44])
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = BinaryProtocol trans
|
||||
writeVal proto (TBinary $ LBS.pack val)
|
||||
val2 <- readVal proto (T_BINARY)
|
||||
val2 `shouldBe` (TBinary $ LBS.pack val)
|
||||
|
81
vendor/git.apache.org/thrift.git/lib/hs/test/CompactSpec.hs
generated
vendored
Normal file
81
vendor/git.apache.org/thrift.git/lib/hs/test/CompactSpec.hs
generated
vendored
Normal file
|
@ -0,0 +1,81 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module CompactSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck (prop)
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
|
||||
import Thrift.Types
|
||||
import Thrift.Transport
|
||||
import Thrift.Transport.Memory
|
||||
import Thrift.Protocol
|
||||
import Thrift.Protocol.Compact
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "CompactProtocol" $ do
|
||||
describe "double" $ do
|
||||
it "writes in little endian order" $ do
|
||||
let val = 2 ** 53
|
||||
trans <- openMemoryBuffer
|
||||
let proto = CompactProtocol trans
|
||||
writeVal proto (TDouble val)
|
||||
bin <- tReadAll trans 8
|
||||
(LBS.unpack bin) `shouldBe`[0, 0, 0, 0, 0, 0, 64, 67]
|
||||
|
||||
it "reads in little endian order" $ do
|
||||
let bin = LBS.pack [0, 0, 0, 0, 0, 0, 64, 67]
|
||||
trans <- openMemoryBuffer
|
||||
let proto = CompactProtocol trans
|
||||
tWrite trans bin
|
||||
val <- readVal proto T_DOUBLE
|
||||
val `shouldBe` (TDouble $ 2 ** 53)
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = CompactProtocol trans
|
||||
writeVal proto $ TDouble val
|
||||
val2 <- readVal proto T_DOUBLE
|
||||
val2 `shouldBe` (TDouble val)
|
||||
|
||||
describe "binary" $ do
|
||||
it "writes" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = CompactProtocol trans
|
||||
writeVal proto (TBinary $ LBS.pack [42, 43, 44])
|
||||
bin <- tRead trans 100
|
||||
(LBS.unpack bin) `shouldBe` [3, 42, 43, 44]
|
||||
|
||||
it "reads" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = CompactProtocol trans
|
||||
tWrite trans $ LBS.pack [3, 42, 43, 44]
|
||||
val <- readVal proto (T_BINARY)
|
||||
val `shouldBe` (TBinary $ LBS.pack [42, 43, 44])
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = CompactProtocol trans
|
||||
writeVal proto (TBinary $ LBS.pack val)
|
||||
val2 <- readVal proto (T_BINARY)
|
||||
val2 `shouldBe` (TBinary $ LBS.pack val)
|
||||
|
225
vendor/git.apache.org/thrift.git/lib/hs/test/JSONSpec.hs
generated
vendored
Normal file
225
vendor/git.apache.org/thrift.git/lib/hs/test/JSONSpec.hs
generated
vendored
Normal file
|
@ -0,0 +1,225 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
module JSONSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Test.Hspec.QuickCheck (prop)
|
||||
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import qualified Data.ByteString.Lazy.Char8 as C
|
||||
|
||||
import Thrift.Types
|
||||
import Thrift.Transport
|
||||
import Thrift.Transport.Memory
|
||||
import Thrift.Protocol
|
||||
import Thrift.Protocol.JSON
|
||||
|
||||
tString :: [Char] -> ThriftVal
|
||||
tString = TString . C.pack
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "JSONProtocol" $ do
|
||||
describe "bool" $ do
|
||||
it "writes true as 1" $ do
|
||||
let val = True
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TBool val)
|
||||
bin <-tRead trans 100
|
||||
(C.unpack bin) `shouldBe` ['1']
|
||||
|
||||
it "writes false as 0" $ do
|
||||
let val = False
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TBool val)
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe` ['0']
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto $ TBool val
|
||||
val2 <- readVal proto T_BOOL
|
||||
val2 `shouldBe` (TBool val)
|
||||
|
||||
describe "string" $ do
|
||||
it "writes" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TString $ C.pack "\"a")
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe` "\"\\\"a\""
|
||||
|
||||
it "reads" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans $ C.pack "\"\\\"a\""
|
||||
val <- readVal proto (T_STRING)
|
||||
val `shouldBe` (TString $ C.pack "\"a")
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TString $ C.pack val)
|
||||
val2 <- readVal proto (T_STRING)
|
||||
val2 `shouldBe` (TString $ C.pack val)
|
||||
|
||||
describe "binary" $ do
|
||||
it "writes with padding" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TBinary $ LBS.pack [1])
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe` "\"AQ==\""
|
||||
|
||||
it "reads with padding" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans $ C.pack "\"AQ==\""
|
||||
val <- readVal proto (T_BINARY)
|
||||
val `shouldBe` (TBinary $ LBS.pack [1])
|
||||
|
||||
it "reads without padding" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans $ C.pack "\"AQ\""
|
||||
val <- readVal proto (T_BINARY)
|
||||
val `shouldBe` (TBinary $ LBS.pack [1])
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TBinary $ LBS.pack val)
|
||||
val2 <- readVal proto (T_BINARY)
|
||||
val2 `shouldBe` (TBinary $ LBS.pack val)
|
||||
|
||||
describe "list" $ do
|
||||
it "writes empty list" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TList T_BYTE [])
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe` "[\"i8\",0]"
|
||||
|
||||
it "reads empty" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",0]")
|
||||
val <- readVal proto (T_LIST T_BYTE)
|
||||
val `shouldBe` (TList T_BYTE [])
|
||||
|
||||
it "writes single element" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TList T_BYTE [TByte 0])
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe` "[\"i8\",1,0]"
|
||||
|
||||
it "reads single element" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",1,0]")
|
||||
val <- readVal proto (T_LIST T_BYTE)
|
||||
val `shouldBe` (TList T_BYTE [TByte 0])
|
||||
|
||||
it "reads elements" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",2,42, 43]")
|
||||
val <- readVal proto (T_LIST T_BYTE)
|
||||
val `shouldBe` (TList T_BYTE [TByte 42, TByte 43])
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto $ (TList T_STRING $ map tString val)
|
||||
val2 <- readVal proto $ T_LIST T_STRING
|
||||
val2 `shouldBe` (TList T_STRING $ map tString val)
|
||||
|
||||
describe "set" $ do
|
||||
it "writes empty" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TSet T_BYTE [])
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe` "[\"i8\",0]"
|
||||
|
||||
it "reads empty" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",0]")
|
||||
val <- readVal proto (T_SET T_BYTE)
|
||||
val `shouldBe` (TSet T_BYTE [])
|
||||
|
||||
it "reads single element" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",1,0]")
|
||||
val <- readVal proto (T_SET T_BYTE)
|
||||
val `shouldBe` (TSet T_BYTE [TByte 0])
|
||||
|
||||
it "reads elements" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",2,42, 43]")
|
||||
val <- readVal proto (T_SET T_BYTE)
|
||||
val `shouldBe` (TSet T_BYTE [TByte 42, TByte 43])
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto $ (TSet T_STRING $ map tString val)
|
||||
val2 <- readVal proto $ T_SET T_STRING
|
||||
val2 `shouldBe` (TSet T_STRING $ map tString val)
|
||||
|
||||
describe "map" $ do
|
||||
it "writes empty" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto (TMap T_BYTE T_BYTE [])
|
||||
bin <- tRead trans 100
|
||||
(C.unpack bin) `shouldBe`"[\"i8\",\"i8\",0,{}]"
|
||||
|
||||
it "reads empty" $ do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack "[\"i8\",\"i8\",0,{}]")
|
||||
val <- readVal proto (T_MAP T_BYTE T_BYTE)
|
||||
val `shouldBe` (TMap T_BYTE T_BYTE [])
|
||||
|
||||
it "reads string-string" $ do
|
||||
let bin = "[\"str\",\"str\",2,{\"a\":\"2\",\"b\":\"blah\"}]"
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
tWrite trans (C.pack bin)
|
||||
val <- readVal proto (T_MAP T_STRING T_STRING)
|
||||
val`shouldBe` (TMap T_STRING T_STRING [(tString "a", tString "2"), (tString "b", tString "blah")])
|
||||
|
||||
prop "round trip" $ \val -> do
|
||||
trans <- openMemoryBuffer
|
||||
let proto = JSONProtocol trans
|
||||
writeVal proto $ (TMap T_STRING T_STRING $ map toKV val)
|
||||
val2 <- readVal proto $ T_MAP T_STRING T_STRING
|
||||
val2 `shouldBe` (TMap T_STRING T_STRING $ map toKV val)
|
||||
where
|
||||
toKV v = (tString v, tString v)
|
||||
|
38
vendor/git.apache.org/thrift.git/lib/hs/test/Spec.hs
generated
vendored
Normal file
38
vendor/git.apache.org/thrift.git/lib/hs/test/Spec.hs
generated
vendored
Normal file
|
@ -0,0 +1,38 @@
|
|||
--
|
||||
-- Licensed to the Apache Software Foundation (ASF) under one
|
||||
-- or more contributor license agreements. See the NOTICE file
|
||||
-- distributed with this work for additional information
|
||||
-- regarding copyright ownership. The ASF licenses this file
|
||||
-- to you 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.
|
||||
--
|
||||
|
||||
-- Our CI does not work well with auto discover.
|
||||
-- Need to add build-time PATH variable to hspec-discover dir from CMake
|
||||
-- or install hspec system-wide for the following to work.
|
||||
-- {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
||||
|
||||
import Test.Hspec
|
||||
|
||||
import qualified BinarySpec
|
||||
import qualified CompactSpec
|
||||
import qualified JSONSpec
|
||||
|
||||
main :: IO ()
|
||||
main = hspec spec
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Binary" BinarySpec.spec
|
||||
describe "Compact" CompactSpec.spec
|
||||
describe "JSON" JSONSpec.spec
|
Loading…
Add table
Add a link
Reference in a new issue