[WIP] use base64 over base64-bytestring

chainweb.cabal

@@ -325,8 +325,7 @@ library
         , attoparsec >= 0.13
         , base >= 4.12 && < 5
         , base16-bytestring >= 0.1
-        , base64-bytestring >= 1.0 && < 1.1
-            -- due to change in error message that is inlined in pact
+        , base64 >= 0.5 && < 0.6
         , binary >= 0.8
         , bytestring >= 0.10
         , case-insensitive >= 1.2
@@ -506,8 +505,7 @@ test-suite chainweb-tests
         , aeson-pretty
         , async >= 2.2
         , base >= 4.12 && < 5
-        , base64-bytestring >= 1.0 && < 1.1
-            -- due to change in error message that is inlined in pact
+        , base64 >= 0.5 && < 0.6
         , bytestring >= 0.10
         , case-insensitive >= 1.2
         , chainweb-storage >= 0.1

default.nix

@@ -1,3 +1,9 @@
+let
+  libbase64HSSrc = builtins.fetchTarball {
+    url = "https://github.com/chessai/hs-libbase64-bindings/archive/e8a5194742f41ce4109b05098a2859e8052ad1c1.tar.gz";
+    sha256 = "1xqfjqb1ghh8idnindc6gfr62d78m5cc6jpbhv1hja8lkdrl8qf8";
+  };
+in
 { compiler ? "ghc8107"
 , rev      ? "7a94fcdda304d143f9a40006c033d7e190311b54"
 , sha256   ? "0d643wp3l77hv2pmg2fi7vyxn4rwy0iyr8djcw1h5x72315ck9ik"
@@ -7,7 +13,11 @@
       inherit sha256; }) {
       config.allowBroken = false;
       config.allowUnfree = true;
-      overlays = [];
+      overlays = [
+        (self: super: {
+          libbase64 = self.callPackage "${libbase64HSSrc}/libbase64.nix" {};
+        })
+      ];
     }
 , returnShellEnv ? false
 , mkDerivation ? null
@@ -106,6 +116,14 @@ pkgs.haskell.packages.${compiler}.developPackage {
       prettyprinter = dontCheck super.prettyprinter;
       aeson         = dontCheck super.aeson;
       generic-data  = dontCheck super.generic-data;
+
+      libbase64-bindings = (import libbase64HSSrc { inherit pkgs compiler; }).libbase64-bindings;
+      base64 = self.callCabal2nix "base64" (pkgs.fetchFromGitHub {
+        owner = "chessai";
+        repo = "base64";
+        rev = "fbd919624ab85bab8dda5558262ce30724e96efa";
+        sha256 = "0grrixnbkjdny60hrqrjqrl23vjkngrf7gn1y2mkmv9vm5s7r8w9";
+      }) {};
   };
 
   source-overrides = {

src/Chainweb/Mempool/Mempool.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
@@ -98,9 +99,11 @@ import Crypto.Hash (hash)
 import Crypto.Hash.Algorithms (SHA512t_256)
 
 import Data.Aeson
+import Data.Bifunctor (first)
 import Data.Bits (bit, shiftL, shiftR, (.&.))
 import Data.ByteArray (convert)
-import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.Base64.Types as B64
+import qualified Data.ByteString.Base64.URL as B64U
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Short as SB
@@ -703,7 +706,8 @@ mockCodec = Codec mockEncode mockDecode
 
 mockEncode :: MockTx -> ByteString
 mockEncode (MockTx nonce (GasPrice (ParsedDecimal price)) limit meta) =
-  B64.encode $
+  B64.extractBase64 $
+  B64U.encodeBase64' $
   runPutS $ do
     putWord64le $ fromIntegral nonce
     putDecimal price
@@ -746,7 +750,7 @@ getDecimal = do
 
 mockDecode :: ByteString -> Either String MockTx
 mockDecode s = do
-    s' <- B64.decode s
+    s' <- first T.unpack $ B64U.decodeBase64 $ B64.assertBase64 @'B64.UrlPadded @_ s
     runGetEitherS (MockTx <$> getI64 <*> getPrice <*> getGL <*> getMeta) s'
   where
     getPrice = GasPrice . ParsedDecimal <$> getDecimal

src/Chainweb/Utils.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -242,6 +243,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Base64 as B64
+import qualified Data.Base64.Types as B64
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Lazy as BL
@@ -604,15 +606,16 @@ iso8601DateTimeFormat = iso8601DateFormat (Just "%H:%M:%SZ")
 --
 decodeB64Text :: MonadThrow m => T.Text -> m B.ByteString
 decodeB64Text = fromEitherM
-    . first (Base64DecodeException . T.pack)
-    . B64.decode
+    . first Base64DecodeException
+    . B64.decodeBase64
+    . B64.assertBase64 @'B64.StdPadded @_
     . T.encodeUtf8
 {-# INLINE decodeB64Text #-}
 
 -- | Encode a binary value to a textual base64 representation.
 --
 encodeB64Text :: B.ByteString -> T.Text
-encodeB64Text = T.decodeUtf8 . B64.encode
+encodeB64Text = B64.extractBase64 . B64.encodeBase64
 {-# INLINE encodeB64Text #-}
 
 -- | Decode a binary value from a textual base64-url representation. A
@@ -621,15 +624,16 @@ encodeB64Text = T.decodeUtf8 . B64.encode
 --
 decodeB64UrlText :: MonadThrow m => T.Text -> m B.ByteString
 decodeB64UrlText = fromEitherM
-    . first (Base64DecodeException . T.pack)
-    . B64U.decode
+    . first Base64DecodeException
+    . B64U.decodeBase64
+    . B64.assertBase64 @'B64.UrlPadded @_
     . T.encodeUtf8
 {-# INLINE decodeB64UrlText #-}
 
 -- | Encode a binary value to a textual base64-url representation.
 --
 encodeB64UrlText :: B.ByteString -> T.Text
-encodeB64UrlText = T.decodeUtf8 . B64U.encode
+encodeB64UrlText = B64.extractBase64 . B64U.encodeBase64
 {-# INLINE encodeB64UrlText #-}
 
 -- | Decode a binary value from a textual base64-url without padding
@@ -638,8 +642,9 @@ encodeB64UrlText = T.decodeUtf8 . B64U.encode
 --
 decodeB64UrlNoPaddingText :: MonadThrow m => T.Text -> m B.ByteString
 decodeB64UrlNoPaddingText = fromEitherM
-    . first (Base64DecodeException . T.pack)
-    . B64U.decode
+    . first Base64DecodeException
+    . B64U.decodeBase64
+    . B64.assertBase64 @'B64.UrlPadded @_
     . T.encodeUtf8
     . pad
   where
@@ -650,14 +655,14 @@ decodeB64UrlNoPaddingText = fromEitherM
 -- representation.
 --
 encodeB64UrlNoPaddingText :: B.ByteString -> T.Text
-encodeB64UrlNoPaddingText = T.dropWhileEnd (== '=') . T.decodeUtf8 . B64U.encode
+encodeB64UrlNoPaddingText = T.dropWhileEnd (== '=') . B64.extractBase64 . B64U.encodeBase64
 {-# INLINE encodeB64UrlNoPaddingText #-}
 
 -- | Encode a binary value to a base64-url (without padding) JSON encoding.
 --
 b64UrlNoPaddingTextEncoding :: B.ByteString -> Encoding
 b64UrlNoPaddingTextEncoding t =
-    Aeson.unsafeToEncoding $ BB.char8 '\"' <> BB.byteString (B8.dropWhileEnd (== '=') $ B64U.encode t) <> BB.char8 '\"'
+    Aeson.unsafeToEncoding $ BB.char8 '\"' <> BB.byteString (B8.dropWhileEnd (== '=') $ B64.extractBase64 $ B64U.encodeBase64' t) <> BB.char8 '\"'
 
 -- -------------------------------------------------------------------------- --
 -- ** JSON

src/Data/LogMessage.hs

@@ -60,6 +60,7 @@ import Control.DeepSeq
 import Data.Aeson
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64.URL as B64
+import qualified Data.Base64.Types as B64
 import qualified Data.ByteString.Lazy as BL
 import Data.Proxy
 import Data.String
@@ -200,8 +201,8 @@ data BinaryLog
     deriving anyclass (NFData)
 
 instance LogMessage BinaryLog where
-    logText (BinaryLog a) = T.decodeUtf8 $ B64.encode a
-    logText (BinaryLogLazy a) = T.decodeUtf8 . B64.encode $ BL.toStrict a
+    logText (BinaryLog a) = B64.extractBase64 $ B64.encodeBase64 a
+    logText (BinaryLogLazy a) = B64.extractBase64 $ B64.encodeBase64 $ BL.toStrict a
     {-# INLINE logText #-}
 
 -- | Static textual log messages using 'Symbol' literals from 'GHC.TypeLits'.

test/Chainweb/Test/BlockHeader/Genesis.hs

@@ -12,6 +12,7 @@
 
 module Chainweb.Test.BlockHeader.Genesis ( tests ) where
 
+import qualified Data.Base64.Types as B64
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Lazy as BL
@@ -54,7 +55,7 @@ blockHashes =
     BB.toLazyByteString . foldMap (hash . snd) . sortBy (compare `on` fst) . HM.toList
   where
     hash :: BlockHeader -> BB.Builder
-    hash = BB.byteString . B64U.encode . runPutS . encodeBlockHash . _blockHash
+    hash = BB.byteString . B64.extractBase64 . B64U.encodeBase64' . runPutS . encodeBlockHash . _blockHash
 
 blockHash :: ChainwebVersion -> TestTree
 blockHash v = golden (sshow v <> "-block-hashes") $

test/Chainweb/Test/Pact/PactMultiChainTest.hs

@@ -16,6 +16,7 @@ import Control.Monad
 import Control.Monad.Catch
 import Control.Monad.Reader
 import Data.Aeson (object, (.=))
+import qualified Data.Base64.Types as B64
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.HashMap.Strict as HM
 import Data.IORef
@@ -1079,7 +1080,7 @@ buildXProof
     -> PactTestM (ContProof, PactId)
 buildXProof scid bh i sendTx = do
     bdb <- view menvBdb
-    proof <- liftIO $ ContProof . B64U.encode . encodeToByteString <$>
+    proof <- liftIO $ ContProof . B64.extractBase64 . B64U.encodeBase64' . encodeToByteString <$>
       createTransactionOutputProof_ (_bdbWebBlockHeaderDb bdb) (_bdbPayloadDb bdb) chain0 scid bh i
     pid <- getPactId sendTx
     return (proof,pid)

test/Chainweb/Test/Pact/SPV.hs

@@ -35,6 +35,7 @@ import Control.Monad
 import Control.Lens (set)
 
 import Data.Aeson as Aeson
+import qualified Data.Base64.Types as B64
 import qualified Data.ByteString.Base64.URL as B64U
 import qualified Data.ByteString.Char8 as B8
 
@@ -539,7 +540,7 @@ createSuccess time (TestBlockDb wdb pdb _c) pidv sid tid bhe = do
             True -> return mempty
             False -> do
                 q <- toJSON <$> createTransactionOutputProof_ wdb pdb tid sid bhe 0
-                let proof = Just . ContProof .  B64U.encode . toStrict . Aeson.encode $ q
+                let proof = Just . ContProof .  B64.extractBase64 . B64U.encodeBase64' . toStrict . Aeson.encode $ q
                 createCont tid pidv proof time
                     `finally` writeIORef ref True
 
@@ -557,7 +558,7 @@ createWrongTargetChain time (TestBlockDb wdb pdb _c) pidv sid tid bhe = do
             False -> do
                 q <- toJSON <$> createTransactionOutputProof_ wdb pdb tid sid bhe 0
 
-                let proof = Just . ContProof .  B64U.encode . toStrict . Aeson.encode $ q
+                let proof = Just . ContProof .  B64.extractBase64 . B64U.encodeBase64' . toStrict . Aeson.encode $ q
 
                 createCont sid pidv proof time
                     `finally` writeIORef ref True
@@ -593,7 +594,7 @@ createProofBadTargetChain time (TestBlockDb wdb pdb _c) pidv sid tid bhe = do
                 tid' <- chainIdFromText "2"
                 q <- toJSON <$> createTransactionOutputProof_ wdb pdb tid' sid bhe 0
 
-                let proof = Just . ContProof .  B64U.encode . toStrict . Aeson.encode $ q
+                let proof = Just . ContProof . B64.extractBase64 . B64U.encodeBase64' . toStrict . Aeson.encode $ q
 
                 createCont sid pidv proof time
                     `finally` writeIORef ref True