Created
April 16, 2021 16:50
-
-
Save phadej/03bd6cbb6ea9bde11512528eb072d855 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
From 99908846a224e73ef7322604048dd21a22dbbcfb Mon Sep 17 00:00:00 2001 | |
From: Oleg Grenrus <oleg.grenrus@iki.fi> | |
Date: Fri, 16 Apr 2021 19:40:18 +0300 | |
Subject: [PATCH] WIP: make basement,memory,cryptonite dependency optional | |
Few tests don't pass. I probably screwed something in Dhall.Crypto | |
(those functions don't have tests and it's all ByteStrings, so | |
maybe I convert to wrong bytes somewhere). | |
cryptohash-sha256 needs base relaxation too, | |
and its maintainer is not most responsive either, | |
let the users chose of two options. | |
base16-bytestring is maintained by HF CTO, | |
so that is a win over using `memory` for that. | |
Also `http-client` doesn't use memory for base16 conversion anymore, | |
since http-client-0.7.4 | |
--- | |
cabal.project | 12 ++++++- | |
dhall/dhall.cabal | 49 +++++++++++++++++++-------- | |
dhall/ghc-src/Dhall/Crypto.hs | 37 +++++++++++++++++--- | |
dhall/ghc-src/Dhall/Import/Manager.hs | 36 ++++++++++++++++++-- | |
dhall/src/Dhall/Binary.hs | 3 +- | |
dhall/src/Dhall/Parser/Expression.hs | 5 ++- | |
dhall/tests/Dhall/Test/Import.hs | 5 +-- | |
dhall/tests/Dhall/Test/Main.hs | 3 +- | |
8 files changed, 119 insertions(+), 31 deletions(-) | |
diff --git a/cabal.project b/cabal.project | |
index 71829b48..78b13a8b 100644 | |
--- a/cabal.project | |
+++ b/cabal.project | |
@@ -1 +1,11 @@ | |
-packages: ./dhall ./dhall-bash ./dhall-json ./dhall-yaml ./dhall-lsp-server ./dhall-nix ./dhall-docs ./dhall-openapi ./dhall-nixpkgs | |
+packages: ./dhall | |
+tests: True | |
+-- ./dhall-bash ./dhall-json ./dhall-yaml ./dhall-lsp-server ./dhall-nix ./dhall-docs ./dhall-openapi ./dhall-nixpkgs | |
+ | |
+package dhall | |
+ flags: -cryptonite | |
+ | |
+allow-newer: cborg:base | |
+allow-newer: cborg:ghc-prim | |
+allow-newer: cborg-json:base | |
+allow-newer: cryptohash-sha256:base | |
diff --git a/dhall/dhall.cabal b/dhall/dhall.cabal | |
index 4c0a0696..1ff62da7 100644 | |
--- a/dhall/dhall.cabal | |
+++ b/dhall/dhall.cabal | |
@@ -1,4 +1,4 @@ | |
-Name: dhall | |
+name: dhall | |
Version: 1.38.1 | |
Cabal-Version: 2.0 | |
Build-Type: Simple | |
@@ -458,17 +458,17 @@ Flag with-http | |
Default: True | |
Manual: True | |
-Flag use-http-client-tls | |
- Description: Use http-client-tls for resolving HTTP imports by default | |
- (requires with-http to be enabled) | |
- Default: True | |
- Manual: True | |
- | |
Flag cross | |
Description: Disable TemplateHaskell to make cross-compiling easier | |
Default: False | |
Manual: True | |
+Flag cryptonite | |
+ Description: Use cryptonite, or don't use it. | |
+ Default: False | |
+ Manual: True | |
+ | |
+ | |
Library | |
Hs-Source-Dirs: src | |
Build-Depends: | |
@@ -477,6 +477,7 @@ Library | |
aeson-pretty < 0.9 , | |
ansi-terminal >= 0.6.3.1 && < 0.12, | |
atomic-write >= 0.2.0.7 && < 0.3 , | |
+ base16-bytestring >=1.0.1.0, | |
bytestring < 0.12, | |
case-insensitive < 1.3 , | |
cborg >= 0.2.0.0 && < 0.3 , | |
@@ -496,7 +497,6 @@ Library | |
hashable >= 1.2 && < 1.4 , | |
lens-family-core >= 1.0.0 && < 2.2 , | |
megaparsec >= 7 && < 9.1 , | |
- memory >= 0.14 && < 0.16, | |
mmorph < 1.2 , | |
mtl >= 2.2.1 && < 2.3 , | |
network-uri >= 2.6 && < 2.7 , | |
@@ -510,7 +510,7 @@ Library | |
repline >= 0.4.0.0 && < 0.5 , | |
serialise >= 0.2.0.0 && < 0.3 , | |
scientific >= 0.3.0.0 && < 0.4 , | |
- template-haskell >= 2.13.0.0 && < 2.17, | |
+ template-haskell >= 2.13.0.0 && < 2.18, | |
text >= 0.11.1.0 && < 1.3 , | |
text-manipulate >= 0.2.0.1 && < 0.4 , | |
th-lift-instances >= 0.1.13 && < 0.2 , | |
@@ -522,9 +522,9 @@ Library | |
if flag(with-http) | |
CPP-Options: | |
-DWITH_HTTP | |
- if flag(use-http-client-tls) | |
+ if flag(cryptonite) | |
CPP-Options: | |
- -DUSE_HTTP_CLIENT_TLS | |
+ -DUSE_CRYPTONITE | |
if impl(ghcjs) | |
Hs-Source-Dirs: ghcjs-src | |
Build-Depends: | |
@@ -532,15 +532,25 @@ Library | |
ghcjs-xhr | |
else | |
Hs-Source-Dirs: ghc-src | |
- Build-Depends: | |
- cryptonite >= 0.23 && < 1.0 | |
+ if flag(cryptonite) | |
+ Build-Depends: | |
+ memory >= 0.14 && < 0.16, | |
+ cryptonite >= 0.23 && < 1.0 | |
+ else | |
+ Build-Depends: | |
+ cryptohash-sha256 | |
if flag(with-http) | |
Build-Depends: | |
http-types >= 0.7.0 && < 0.13, | |
http-client >= 0.5.0 && < 0.8 | |
- if flag(use-http-client-tls) | |
+ if flag(cryptonite) | |
Build-Depends: | |
http-client-tls >= 0.2.0 && < 0.4 | |
+ else | |
+ build-depends: | |
+ HsOpenSSL >=0.11.4.16 && <0.12 | |
+ , HsOpenSSL-x509-system >=0.1.0.3 && <0.2 | |
+ , http-client-openssl >=0.2.2.0 && <0.4 | |
Other-Extensions: | |
BangPatterns | |
@@ -619,6 +629,7 @@ Library | |
if flag(with-http) | |
Other-Modules: | |
Dhall.Import.HTTP | |
+ Exposed-Modules: | |
Dhall.Import.Manager | |
GHC-Options: -Wall -fwarn-incomplete-uni-patterns | |
@@ -655,6 +666,15 @@ Test-Suite tasty | |
Dhall.Test.Tutorial | |
Dhall.Test.TypeInference | |
Dhall.Test.Util | |
+ | |
+ if flag(cryptonite) | |
+ Build-Depends: | |
+ http-client-tls | |
+ CPP-Options: | |
+ -DUSE_CRYPTONITE | |
+ | |
+ if impl(ghcjs) | |
+ | |
Build-Depends: | |
base >= 4 && < 5 , | |
bytestring , | |
@@ -669,7 +689,6 @@ Test-Suite tasty | |
foldl < 1.5 , | |
generic-random >= 1.3.0.0 && < 1.4 , | |
http-client , | |
- http-client-tls , | |
lens-family-core , | |
megaparsec , | |
prettyprinter , | |
diff --git a/dhall/ghc-src/Dhall/Crypto.hs b/dhall/ghc-src/Dhall/Crypto.hs | |
index 282739ac..41236cc6 100644 | |
--- a/dhall/ghc-src/Dhall/Crypto.hs | |
+++ b/dhall/ghc-src/Dhall/Crypto.hs | |
@@ -1,3 +1,4 @@ | |
+{-# LANGUAGE CPP #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE GeneralizedNewtypeDeriving #-} | |
@@ -10,21 +11,33 @@ module Dhall.Crypto ( | |
, sha256DigestFromByteString | |
, sha256Hash | |
, toString | |
+ | |
) where | |
import Control.DeepSeq (NFData) | |
-import Crypto.Hash (SHA256) | |
-import Data.ByteArray (ByteArrayAccess, convert) | |
-import Data.ByteArray.Encoding (Base (Base16), convertToBase) | |
import Data.ByteString (ByteString) | |
import GHC.Generics (Generic) | |
-import qualified Crypto.Hash | |
import qualified Data.ByteString.Char8 as ByteString.Char8 | |
+#ifdef USE_CRYPTONITE | |
+import Data.ByteArray (ByteArrayAccess, convert) | |
+import Data.ByteArray.Encoding (Base (Base16), convertToBase) | |
+import Crypto.Hash (SHA256) | |
+import qualified Crypto.Hash | |
+#else | |
+ | |
+import qualified Crypto.Hash.SHA256 as SHA256 | |
+import qualified Data.ByteString.Base16 as Base16 | |
+#endif | |
+ | |
-- | A SHA256 digest | |
newtype SHA256Digest = SHA256Digest { unSHA256Digest :: ByteString } | |
- deriving (Eq, Generic, Ord, NFData, ByteArrayAccess) | |
+ deriving (Eq, Generic, Ord, NFData) | |
+ | |
+#ifdef USE_CRYPTONITE | |
+deriving instance ByteArrayAccess SHA256Digest | |
+#endif | |
instance Show SHA256Digest where | |
show = toString | |
@@ -33,16 +46,30 @@ instance Show SHA256Digest where | |
`Nothing` if the conversion fails | |
-} | |
sha256DigestFromByteString :: ByteString -> Maybe SHA256Digest | |
+#ifdef USE_CRYPTONITE | |
sha256DigestFromByteString bytes = SHA256Digest . convert <$> mh | |
where | |
mh = Crypto.Hash.digestFromByteString bytes :: Maybe (Crypto.Hash.Digest SHA256) | |
+#else | |
+sha256DigestFromByteString bs | |
+ | ByteString.Char8.length bs == 32 = Just (SHA256Digest bs) | |
+ | otherwise = Nothing | |
+#endif | |
-- | Hash a `ByteString` and return the hash as a `SHA256Digest` | |
sha256Hash :: ByteString -> SHA256Digest | |
+#ifdef USE_CRYPTONITE | |
sha256Hash bytes = SHA256Digest $ convert h | |
where | |
h = Crypto.Hash.hash bytes :: Crypto.Hash.Digest SHA256 | |
+#else | |
+sha256Hash = SHA256Digest . SHA256.hash | |
+#endif | |
-- | 'String' representation of a 'SHA256Digest' | |
toString :: SHA256Digest -> String | |
+#ifdef USE_CRYPTONITE | |
toString (SHA256Digest bytes) = ByteString.Char8.unpack $ convertToBase Base16 bytes | |
+#else | |
+toString (SHA256Digest bytes) = ByteString.Char8.unpack $ Base16.encode bytes | |
+#endif | |
diff --git a/dhall/ghc-src/Dhall/Import/Manager.hs b/dhall/ghc-src/Dhall/Import/Manager.hs | |
index 1926f41a..bfe6971a 100644 | |
--- a/dhall/ghc-src/Dhall/Import/Manager.hs | |
+++ b/dhall/ghc-src/Dhall/Import/Manager.hs | |
@@ -14,18 +14,50 @@ module Dhall.Import.Manager | |
( -- * Manager | |
Manager | |
, defaultNewManager | |
+ , tlsManagerSettings | |
+ , withSSL, | |
) where | |
import Network.HTTP.Client (Manager, newManager) | |
import qualified Network.HTTP.Client as HTTP | |
-#ifdef USE_HTTP_CLIENT_TLS | |
+#ifdef USE_CRYPTONITE | |
import Network.HTTP.Client.TLS (tlsManagerSettings) | |
+#elif defined(MIN_VERSION_http_client_openssl) | |
+import Network.HTTP.Client.OpenSSL (opensslManagerSettings, withOpenSSL) | |
+ | |
+import qualified OpenSSL.Session as SSL | |
+import qualified OpenSSL.X509.SystemStore as SSL | |
+#endif | |
+ | |
+-- | Wrap Main in SSL functionality. | |
+-- This is 'withOpenSSL' when we depend on @http-client-openssl@ and @HsOpenSSL@, | |
+-- or 'id' when we don't. | |
+withSSL :: IO a -> IO a | |
+ | |
+#if defined(MIN_VERSION_http_client_openssl) | |
+tlsManagerSettings :: HTTP.ManagerSettings | |
+tlsManagerSettings = opensslManagerSettings $ do | |
+ -- this is losely based on https://access.redhat.com/documentation/en-us/red_hat_enterprise_linux/7/html/security_guide/sec-hardening_tls_configuration | |
+ ctx <- SSL.context | |
+ SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv2 | |
+ SSL.contextAddOption ctx SSL.SSL_OP_NO_SSLv3 | |
+ SSL.contextAddOption ctx SSL.SSL_OP_NO_TLSv1 | |
+ SSL.contextSetCiphers ctx "ECDHE-ECDSA-AES256-GCM-SHA384:ECDHE-RSA-AES256-GCM-SHA384:ECDHE-ECDSA-CHACHA20-POLY1305:ECDHE-RSA-CHACHA20-POLY1305:ECDHE-ECDSA-AES128-GCM-SHA256:ECDHE-RSA-AES128-GCM-SHA256:ECDHE-ECDSA-AES256-SHA384:ECDHE-RSA-AES256-SHA384:ECDHE-ECDSA-AES128-SHA256:ECDHE-RSA-AES128-SHA256" | |
+ SSL.contextLoadSystemCerts ctx | |
+ SSL.contextSetVerificationMode ctx $ SSL.VerifyPeer True True Nothing | |
+ return ctx | |
+ | |
+withSSL = withOpenSSL | |
+#else | |
+withSSL = id | |
#endif | |
defaultNewManager :: IO Manager | |
defaultNewManager = newManager | |
-#ifdef USE_HTTP_CLIENT_TLS | |
+#ifdef USE_CRYPTONITE | |
+ tlsManagerSettings | |
+#elif defined(MIN_VERSION_http_client_openssl) | |
tlsManagerSettings | |
#else | |
HTTP.defaultManagerSettings | |
diff --git a/dhall/src/Dhall/Binary.hs b/dhall/src/Dhall/Binary.hs | |
index 17f5236f..b7916898 100644 | |
--- a/dhall/src/Dhall/Binary.hs | |
+++ b/dhall/src/Dhall/Binary.hs | |
@@ -64,7 +64,6 @@ import qualified Codec.CBOR.Decoding as Decoding | |
import qualified Codec.CBOR.Encoding as Encoding | |
import qualified Codec.CBOR.Read as Read | |
import qualified Codec.Serialise as Serialise | |
-import qualified Data.ByteArray | |
import qualified Data.ByteString | |
import qualified Data.ByteString.Lazy | |
import qualified Data.ByteString.Short | |
@@ -1180,7 +1179,7 @@ encodeImport import_ = | |
Encoding.encodeNull | |
Just digest -> | |
- Encoding.encodeBytes ("\x12\x20" <> Data.ByteArray.convert digest) | |
+ Encoding.encodeBytes ("\x12\x20" <> Dhall.Crypto.unSHA256Digest digest) | |
m = Encoding.encodeInt (case importMode of Code -> 0; RawText -> 1; Location -> 2;) | |
diff --git a/dhall/src/Dhall/Parser/Expression.hs b/dhall/src/Dhall/Parser/Expression.hs | |
index dfc358f5..a1035744 100644 | |
--- a/dhall/src/Dhall/Parser/Expression.hs | |
+++ b/dhall/src/Dhall/Parser/Expression.hs | |
@@ -8,7 +8,6 @@ | |
module Dhall.Parser.Expression where | |
import Control.Applicative (Alternative (..), liftA2, optional) | |
-import Data.ByteArray.Encoding (Base (..)) | |
import Data.Foldable (foldl') | |
import Data.Functor (void) | |
import Data.List.NonEmpty (NonEmpty (..)) | |
@@ -20,10 +19,10 @@ import Text.Parser.Combinators (choice, try, (<?>)) | |
import qualified Control.Monad | |
import qualified Control.Monad.Combinators as Combinators | |
import qualified Control.Monad.Combinators.NonEmpty as Combinators.NonEmpty | |
-import qualified Data.ByteArray.Encoding | |
import qualified Data.ByteString | |
import qualified Data.Char as Char | |
import qualified Data.List | |
+import qualified Data.ByteString.Base16 | |
import qualified Data.List.NonEmpty as NonEmpty | |
import qualified Data.Sequence | |
import qualified Data.Text | |
@@ -1057,7 +1056,7 @@ importHash_ = do | |
_ <- text "sha256:" | |
t <- count 64 (satisfy hexdig <?> "hex digit") | |
let strictBytes16 = Data.Text.Encoding.encodeUtf8 t | |
- strictBytes <- case Data.ByteArray.Encoding.convertFromBase Base16 strictBytes16 of | |
+ strictBytes <- case Data.ByteString.Base16.decode strictBytes16 of | |
Left string -> fail string | |
Right strictBytes -> return (strictBytes :: Data.ByteString.ByteString) | |
case Dhall.Crypto.sha256DigestFromByteString strictBytes of | |
diff --git a/dhall/tests/Dhall/Test/Import.hs b/dhall/tests/Dhall/Test/Import.hs | |
index a745bd45..5c6cf161 100644 | |
--- a/dhall/tests/Dhall/Test/Import.hs | |
+++ b/dhall/tests/Dhall/Test/Import.hs | |
@@ -20,12 +20,13 @@ import qualified Dhall.Import as Import | |
import qualified Dhall.Parser as Parser | |
import qualified Dhall.Test.Util as Test.Util | |
import qualified Network.HTTP.Client as HTTP | |
-import qualified Network.HTTP.Client.TLS as HTTP | |
import qualified System.FilePath as FilePath | |
import qualified Test.Tasty as Tasty | |
import qualified Test.Tasty.HUnit as Tasty.HUnit | |
import qualified Turtle | |
+import qualified Dhall.Import.Manager | |
+ | |
importDirectory :: FilePath | |
importDirectory = "./dhall-lang/tests/import" | |
@@ -85,7 +86,7 @@ successTest path = do | |
let httpManager = | |
HTTP.newManager | |
- HTTP.tlsManagerSettings | |
+ Dhall.Import.Manager.tlsManagerSettings | |
{ HTTP.managerResponseTimeout = HTTP.responseTimeoutMicro (120 * 1000 * 1000) } | |
let load = | |
State.evalStateT | |
diff --git a/dhall/tests/Dhall/Test/Main.hs b/dhall/tests/Dhall/Test/Main.hs | |
index 244fb767..73cf87ef 100644 | |
--- a/dhall/tests/Dhall/Test/Main.hs | |
+++ b/dhall/tests/Dhall/Test/Main.hs | |
@@ -19,6 +19,7 @@ import qualified Dhall.Test.Tags | |
import qualified Dhall.Test.TH | |
import qualified Dhall.Test.Tutorial | |
import qualified Dhall.Test.TypeInference | |
+import qualified Dhall.Import.Manager | |
import qualified GHC.IO.Encoding | |
import qualified System.Directory | |
import qualified System.Environment | |
@@ -26,7 +27,7 @@ import qualified System.IO | |
import qualified Test.Tasty | |
getAllTests :: IO TestTree | |
-getAllTests = do | |
+getAllTests = Dhall.Import.Manager.withSSL $ do | |
normalizationTests <- Dhall.Test.Normalization.getTests | |
parsingTests <- Dhall.Test.Parser.getTests | |
-- | |
2.31.1 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment