Update Hexstring for binary #1

Merged
pitmutt merged 12 commits from dev into master 2024-03-12 18:54:02 +00:00
2 changed files with 30 additions and 34 deletions
Showing only changes of commit fe2df6f7d6 - Show all commits

View file

@ -8,9 +8,7 @@
module Data.HexString
( HexString(..)
, hexString
, fromBinary
, toBinary
, fromBytes
, fromRawBytes
, toBytes
, fromText
, toText
@ -23,7 +21,7 @@ import Data.Aeson
import Data.Word (Word8)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as BS16 (decodeLenient, encode)
import qualified Data.ByteString.Base16 as BS16 (decode, decodeLenient, encode)
import qualified Data.ByteString.Lazy as BSL
import Data.Structured
@ -39,11 +37,14 @@ import qualified Generics.SOP as SOP
-- are valid hex characters.
newtype HexString = HexString
{ hexBytes :: BS.ByteString
} deriving stock (Eq, Prelude.Show, GHC.Generic)
} deriving stock (Eq, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct HexString
instance Prelude.Show HexString where
show = T.unpack . toText
instance FromJSON HexString where
parseJSON = withText "HexString" $ pure . hexString . TE.encodeUtf8
@ -54,37 +55,32 @@ instance ToJSON HexString where
-- hexadecimal characters.
hexString :: BS.ByteString -> HexString
hexString bs =
let isValidHex :: Word8 -> Bool
isValidHex c
| (48 <= c) && (c < 58) = True
| (97 <= c) && (c < 103) = True
| otherwise = False
in if BS.all isValidHex bs
then HexString bs
else error ("Not a valid hex string: " ++ Prelude.show bs)
case BS16.decode bs of
Right s -> HexString s
Left e -> error e
-- | Converts a 'B.Binary' to a 'HexString' value
fromBinary :: B.Binary a => a -> HexString
fromBinary = hexString . BS16.encode . BSL.toStrict . B.encode
fromBinary = HexString . BSL.toStrict . B.encode
-- | Converts a 'HexString' to a 'B.Binary' value
toBinary :: B.Binary a => HexString -> a
toBinary (HexString bs) = B.decode . BSL.fromStrict . BS16.decodeLenient $ bs
toBinary (HexString bs) = (B.decode . BSL.fromStrict) bs
-- | Reads a 'BS.ByteString' as raw bytes and converts to hex representation. We
-- cannot use the instance Binary of 'BS.ByteString' because it provides
-- a leading length, which is not what we want when dealing with raw bytes.
fromBytes :: BS.ByteString -> HexString
fromBytes = hexString . BS16.encode
fromRawBytes :: BS.ByteString -> HexString
fromRawBytes = HexString
-- | Access to the raw bytes in a 'BS.ByteString' format.
toBytes :: HexString -> BS.ByteString
toBytes (HexString bs) = BS16.decodeLenient bs
toBytes (HexString bs) = bs
-- | Reads a human-readable hex string into a `HexString`
fromText :: T.Text -> HexString
fromText = hexString . BS16.decodeLenient . TE.encodeUtf8
fromText = hexString . TE.encodeUtf8
-- | Access to a 'T.Text' representation of the 'HexString'
toText :: HexString -> T.Text
toText (HexString bs) = TE.decodeUtf8 bs
toText (HexString bs) = (TE.decodeUtf8 . BS16.encode) bs

View file

@ -1,27 +1,27 @@
{-# LANGUAGE OverloadedStrings #-}
module Data.HexStringSpec where
import Data.HexString ( hexString
, fromBytes
, toBytes )
import Data.HexString (fromRawBytes, fromText, hexString, toBytes, toText)
import qualified Data.ByteString.Char8 as BS8
import Test.Hspec
import Test.Hspec
spec :: Spec
spec = do
describe "when constructing a hex string" $ do
it "should accept strings that fall within a valid range" $
hexString (BS8.pack "0123456789abcdef") `shouldBe` hexString (BS8.pack "0123456789abcdef")
it "should reject strings outside the range" $ do
putStrLn (show (hexString (BS8.pack "/"))) `shouldThrow` anyErrorCall
putStrLn (show (hexString (BS8.pack ":"))) `shouldThrow` anyErrorCall
putStrLn (show (hexString (BS8.pack "`"))) `shouldThrow` anyErrorCall
putStrLn (show (hexString (BS8.pack "g"))) `shouldThrow` anyErrorCall
print (hexString (BS8.pack "/")) `shouldThrow` anyErrorCall
print (hexString (BS8.pack ":")) `shouldThrow` anyErrorCall
print (hexString (BS8.pack "`")) `shouldThrow` anyErrorCall
print (hexString (BS8.pack "g")) `shouldThrow` anyErrorCall
describe "when interpreting a hex string" $ do
it "should convert the hex string properly when interpreting as bytes" $
toBytes (hexString (BS8.pack "ffff")) `shouldBe` BS8.pack "\255\255"
toBytes (hexString "ffff") `shouldBe` BS8.pack "\255\255"
it "should convert bytes to the proper hex string" $
fromBytes (BS8.pack "\255\255") `shouldBe` hexString (BS8.pack "ffff")
fromRawBytes (BS8.pack "\255\255") `shouldBe` hexString (BS8.pack "ffff")
it "should convert the hex string to text" $
toText (hexString "ffff") `shouldBe` "ffff"
it "should read text into the hex string" $
fromText "ffff" `shouldBe` hexString (BS8.pack "ffff")