Skip to content

Instantly share code, notes, and snippets.

Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save phadej/03bd6cbb6ea9bde11512528eb072d855 to your computer and use it in GitHub Desktop.
Save phadej/03bd6cbb6ea9bde11512528eb072d855 to your computer and use it in GitHub Desktop.
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