Merge pull request #2323 from unisonweb/feature/compress

gzip and zlib compression builtins

parser-typechecker/package.yaml

@@ -44,6 +44,7 @@ library:
     - configurator
     - cryptonite
     - data-default
+    - deepseq
     - directory
     - either
     - fuzzyfind
@@ -109,6 +110,7 @@ library:
     - x509
     - x509-store
     - x509-system
+    - zlib
     - unison-codebase
     - unison-codebase-sqlite
     - unison-codebase-sync

parser-typechecker/src/Unison/Builtin.hs

@@ -436,6 +436,11 @@ builtinsSrc =
   , B "Bytes.size" $ bytes --> nat
   , B "Bytes.flatten" $ bytes --> bytes
 
+  , B "Bytes.zlib.compress" $ bytes --> bytes
+  , B "Bytes.zlib.decompress" $ bytes --> eithert text bytes
+  , B "Bytes.gzip.compress" $ bytes --> bytes
+  , B "Bytes.gzip.decompress" $ bytes --> eithert text bytes
+
    {- These are all `Bytes -> Bytes`, rather than `Bytes -> Text`.
       This is intentional: it avoids a round trip to `Text` if all
       you are doing with the bytes is dumping them to a file or a

parser-typechecker/src/Unison/Runtime/Builtin.hs

@@ -18,6 +18,9 @@ module Unison.Runtime.Builtin
   ) where
 
 import Control.Monad.State.Strict (State, modify, execState)
+import qualified Control.Exception.Safe as Exception
+import Control.Monad.Catch (MonadCatch)
+import Control.DeepSeq (NFData)
 
 import Unison.ABT.Normalized hiding (TTm)
 import Unison.Reference
@@ -1900,6 +1903,21 @@ declareForeigns = do
       in pure . Bytes.fromArray . hmac alg $ serializeValueLazy x
 
 
+  let
+    catchAll :: (MonadCatch m, MonadIO m, NFData a) => m a -> m (Either Text a)
+    catchAll e = do
+      e <- Exception.tryAnyDeep e
+      pure $ case e of
+        Left se -> Left (Text.pack (show se))
+        Right a -> Right a
+
+  declareForeign "Bytes.zlib.compress" boxDirect . mkForeign $ pure . Bytes.zlibCompress
+  declareForeign "Bytes.gzip.compress" boxDirect . mkForeign $ pure . Bytes.gzipCompress
+  declareForeign "Bytes.zlib.decompress" boxToEBoxBox . mkForeign $ \bs ->
+    catchAll (pure (Bytes.zlibDecompress bs))
+  declareForeign "Bytes.gzip.decompress" boxToEBoxBox . mkForeign $ \bs ->
+    catchAll (pure (Bytes.gzipDecompress bs))
+
   declareForeign "Bytes.toBase16" boxDirect . mkForeign $ pure . Bytes.toBase16
   declareForeign "Bytes.toBase32" boxDirect . mkForeign $ pure . Bytes.toBase32
   declareForeign "Bytes.toBase64" boxDirect . mkForeign $ pure . Bytes.toBase64

parser-typechecker/src/Unison/Util/Bytes.hs

@@ -3,6 +3,7 @@
 
 module Unison.Util.Bytes where
 
+import Control.DeepSeq (NFData(..))
 import Data.Bits (shiftR, shiftL, (.|.))
 import Data.Char
 import Data.Memory.PtrMethods (memCompare, memEqual)
@@ -17,6 +18,8 @@ import qualified Data.ByteArray as B
 import qualified Data.ByteArray.Encoding as BE
 import qualified Data.FingerTree as T
 import qualified Data.Text as Text
+import qualified Codec.Compression.Zlib as Zlib
+import qualified Codec.Compression.GZip as GZip
 
 -- Block is just `newtype Block a = Block ByteArray#`
 type ByteString = Block Word8
@@ -35,12 +38,27 @@ empty = Bytes mempty
 fromArray :: B.ByteArrayAccess ba => ba -> Bytes
 fromArray = snoc empty
 
+zlibCompress :: Bytes -> Bytes
+zlibCompress = fromLazyByteString . Zlib.compress . toLazyByteString
+
+gzipCompress :: Bytes -> Bytes
+gzipCompress = fromLazyByteString . GZip.compress . toLazyByteString
+
+gzipDecompress :: Bytes -> Bytes
+gzipDecompress = fromLazyByteString . GZip.decompress . toLazyByteString
+
+zlibDecompress :: Bytes -> Bytes
+zlibDecompress = fromLazyByteString . Zlib.decompress . toLazyByteString
+
 toArray :: forall bo . B.ByteArray bo => Bytes -> bo
 toArray b = B.concat (map B.convert (chunks b) :: [bo])
 
 toLazyByteString :: Bytes -> LB.ByteString
 toLazyByteString b = LB.fromChunks $ map B.convert $ chunks b
 
+fromLazyByteString :: LB.ByteString -> Bytes
+fromLazyByteString b = fromChunks (map (view . B.convert) $ LB.toChunks b)
+
 size :: Bytes -> Int
 size (Bytes bs) = getSum (T.measure bs)
 
@@ -212,7 +230,7 @@ fillBE :: Word64 -> Int -> Ptr Word8 -> IO ()
 fillBE n 0 p = poke p (fromIntegral n) >> return ()
 fillBE n i p = poke p (fromIntegral (shiftR n (i * 8)))
                    >> fillBE n (i - 1) (p `plusPtr` 1)
-  
+
 encodeNat64be :: Word64 -> Bytes
 encodeNat64be n = Bytes (T.singleton (view (B.unsafeCreate 8 (fillBE n 7))))
 
@@ -361,3 +379,9 @@ instance B.ByteArrayAccess bytes => B.ByteArrayAccess (View bytes) where
   length = viewSize
   withByteArray v f = B.withByteArray (unView v) $
     \ptr -> f (ptr `plusPtr` (viewOffset v))
+
+instance NFData (View bs) where
+  rnf bs = seq bs ()
+
+instance NFData Bytes where
+  rnf bs = rnf (chunks bs)

parser-typechecker/unison-parser-typechecker.cabal

@@ -228,6 +228,7 @@ library
     , cryptonite
     , data-default
     , data-memocombinators
+    , deepseq
     , directory
     , either
     , errors
@@ -298,6 +299,7 @@ library
     , x509
     , x509-store
     , x509-system
+    , zlib
   if flag(optimized)
     ghc-options: -funbox-strict-fields -O2
   default-language: Haskell2010

unison-src/transcripts-using-base/hashing.output.md

@@ -27,13 +27,15 @@ Unison has cryptographic builtins for hashing and computing [HMACs](https://en.w
   20. fromBase64            (Bytes -> Either Text Bytes)
   21. fromBase64UrlUnpadded (Bytes -> Either Text Bytes)
   22. fromList              ([Nat] -> Bytes)
-  23. size                  (Bytes -> Nat)
-  24. take                  (Nat -> Bytes -> Bytes)
-  25. toBase16              (Bytes -> Bytes)
-  26. toBase32              (Bytes -> Bytes)
-  27. toBase64              (Bytes -> Bytes)
-  28. toBase64UrlUnpadded   (Bytes -> Bytes)
-  29. toList                (Bytes -> [Nat])
+  23. gzip/                 (2 definitions)
+  24. size                  (Bytes -> Nat)
+  25. take                  (Nat -> Bytes -> Bytes)
+  26. toBase16              (Bytes -> Bytes)
+  27. toBase32              (Bytes -> Bytes)
+  28. toBase64              (Bytes -> Bytes)
+  29. toBase64UrlUnpadded   (Bytes -> Bytes)
+  30. toList                (Bytes -> [Nat])
+  31. zlib/                 (2 definitions)
 
 ```
 Notice the `fromBase16` and `toBase16` functions. Here's some convenience functions for converting `Bytes` to and from base-16 `Text`.