From 543c49361518b2141d816d2ce9a8bbf79a2fa031 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 30 Jan 2021 21:12:31 +0100
Subject: Storage: hexadecimal encoding of binary record items

---
 src/Storage.hs          | 19 ++++---------------
 src/Storage/Internal.hs | 28 +++++++++++++++++++++++-----
 2 files changed, 27 insertions(+), 20 deletions(-)

(limited to 'src')

diff --git a/src/Storage.hs b/src/Storage.hs
index 8bf8802..a7607b7 100644
--- a/src/Storage.hs
+++ b/src/Storage.hs
@@ -67,9 +67,8 @@ import Control.Monad.Writer
 import Crypto.Hash
 
 import qualified Data.Aeson as J
-import Data.ByteString (ByteString, singleton)
+import Data.ByteString (ByteString)
 import qualified Data.ByteArray as BA
-import Data.ByteArray.Encoding
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
@@ -151,17 +150,7 @@ isZeroRef (Ref _ h) = all (==0) $ BA.unpack h
 
 
 readRefDigest :: ByteString -> Maybe RefDigest
-readRefDigest = refDigestFromByteString . B.concat <=< readHex
-    where readHex bs | B.null bs = Just []
-          readHex bs = do (bx, bs') <- B.uncons bs
-                          (by, bs'') <- B.uncons bs'
-                          x <- hexDigit bx
-                          y <- hexDigit by
-                          (singleton (x * 16 + y) :) <$> readHex bs''
-          hexDigit x | x >= o '0' && x <= o '9' = Just $ x - o '0'
-                     | x >= o 'a' && x <= o 'z' = Just $ x - o 'a' + 10
-                     | otherwise                = Nothing
-          o = fromIntegral . ord
+readRefDigest = refDigestFromByteString <=< readHex @ ByteString
 
 refFromDigest :: Storage' c -> RefDigest -> IO (Maybe (Ref' c))
 refFromDigest st dgst = fmap (const $ Ref st dgst) <$> ioLoadBytesFromStorage st dgst
@@ -264,7 +253,7 @@ serializeRecItem name (RecText x) = [name, BC.pack ":t", BC.singleton ' ', escap
     where escaped = BC.concatMap escape $ encodeUtf8 x
           escape '\n' = BC.pack "\n\t"
           escape c    = BC.singleton c
-serializeRecItem name (RecBinary x) = [name, BC.pack ":b ", convertToBase Base64 x, BC.singleton '\n']
+serializeRecItem name (RecBinary x) = [name, BC.pack ":b ", showHex x, BC.singleton '\n']
 serializeRecItem name (RecDate x) = [name, BC.pack ":d", BC.singleton ' ', BC.pack (formatTime defaultTimeLocale "%s %z" x), BC.singleton '\n']
 serializeRecItem name (RecUUID x) = [name, BC.pack ":u", BC.singleton ' ', U.toASCIIBytes x, BC.singleton '\n']
 serializeRecItem name (RecJson x) = [name, BC.pack ":j", BC.singleton ' '] ++ BL.toChunks (J.encode x) ++ [BC.singleton '\n']
@@ -327,7 +316,7 @@ unsafeDeserializeObject st bytes =
                                     return $ RecInt num
                           "n" -> RecNum <$> parseRatio content
                           "t" -> return $ RecText $ decodeUtf8With lenientDecode content
-                          "b" -> either (const Nothing) (Just . RecBinary) $ convertFromBase Base64 content
+                          "b" -> RecBinary <$> readHex content
                           "d" -> RecDate <$> parseTimeM False defaultTimeLocale "%s %z" (BC.unpack content)
                           "u" -> RecUUID <$> U.fromASCIIBytes content
                           "j" -> RecJson <$> J.decode (BL.fromStrict content)
diff --git a/src/Storage/Internal.hs b/src/Storage/Internal.hs
index a625efb..59eb514 100644
--- a/src/Storage/Internal.hs
+++ b/src/Storage/Internal.hs
@@ -12,12 +12,13 @@ import Control.Monad.Identity
 import Crypto.Hash
 
 import Data.Bits
-import Data.ByteArray (ByteArrayAccess, ScrubbedBytes)
+import Data.ByteArray (ByteArray, ByteArrayAccess, ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
+import Data.Char
 import Data.Function
 import Data.Hashable
 import qualified Data.HashTable.IO as HT
@@ -100,10 +101,7 @@ showRef :: Ref' c -> ByteString
 showRef = showRefDigest . refDigest
 
 showRefDigest :: RefDigest -> ByteString
-showRefDigest = B.concat . map showHexByte . BA.unpack
-    where showHex x | x < 10    = x + 48
-                    | otherwise = x + 87
-          showHexByte x = B.pack [ showHex (x `div` 16), showHex (x `mod` 16) ]
+showRefDigest = showHex
 
 refDigestFromByteString :: ByteArrayAccess ba => ba -> Maybe RefDigest
 refDigestFromByteString = fmap RefDigest . digestFromByteString
@@ -111,6 +109,26 @@ refDigestFromByteString = fmap RefDigest . digestFromByteString
 hashToRefDigest :: BL.ByteString -> RefDigest
 hashToRefDigest = RefDigest . hashFinalize . hashUpdates hashInit . BL.toChunks
 
+showHex :: ByteArrayAccess ba => ba -> ByteString
+showHex = B.concat . map showHexByte . BA.unpack
+    where showHexChar x | x < 10    = x + o '0'
+                        | otherwise = x + o 'a' - 10
+          showHexByte x = B.pack [ showHexChar (x `div` 16), showHexChar (x `mod` 16) ]
+          o = fromIntegral . ord
+
+readHex :: ByteArray ba => ByteString -> Maybe ba
+readHex = return . BA.concat <=< readHex'
+    where readHex' bs | B.null bs = Just []
+          readHex' bs = do (bx, bs') <- B.uncons bs
+                           (by, bs'') <- B.uncons bs'
+                           x <- hexDigit bx
+                           y <- hexDigit by
+                           (B.singleton (x * 16 + y) :) <$> readHex' bs''
+          hexDigit x | x >= o '0' && x <= o '9' = Just $ x - o '0'
+                     | x >= o 'a' && x <= o 'z' = Just $ x - o 'a' + 10
+                     | otherwise                = Nothing
+          o = fromIntegral . ord
+
 
 newtype Generation = Generation Int
     deriving (Eq, Show)
-- 
cgit v1.2.3