Skip to content

Add safe conversion to HexString #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 28 additions & 7 deletions src/Data/HexString.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,11 @@
module Data.HexString ( HexString
, hexString
, hexString'
, fromBinary
, fromBinary'
, toBinary
, fromBytes
, fromBytes'
, toBytes
, toText ) where

Expand All @@ -27,33 +30,51 @@ data HexString =
deriving ( Show, Eq, Ord )

instance FromJSON HexString where
parseJSON = withText "HexString" $ pure . hexString . TE.encodeUtf8
parseJSON = withText "HexString" $ toParser . TE.encodeUtf8
where
toParser input = case hexString' input of
(Just value) -> pure value
Nothing -> fail ("Not a valid hex string: " ++ show input)

instance ToJSON HexString where
toJSON = String . toText

-- | Smart constructor which validates that all the text are actually
-- hexadecimal characters.
hexString :: BS.ByteString -> HexString
hexString bs =
hexString' :: BS.ByteString -> Maybe 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: " ++ show bs)
then Just (HexString bs)
else Nothing

hexString :: BS.ByteString -> HexString
hexString bs = case hexString' bs of
Just hex -> hex
Nothing -> error ("Not a valid hex string: " ++ show bs)

-- | Converts a 'B.Binary' to a 'Maybe HexString' value
fromBinary' :: B.Binary a => a -> Maybe HexString
fromBinary' = hexString' . BS16.encode . BSL.toStrict . B.encode

-- | Converts a 'B.Binary' to a 'HexString' value
fromBinary :: B.Binary a => a -> HexString
fromBinary :: B.Binary a => a -> HexString
fromBinary = hexString . BS16.encode . 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 . fst . BS16.decode $ 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 -> Maybe HexString
fromBytes' = hexString' . BS16.encode

-- | 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.
Expand Down
4 changes: 4 additions & 0 deletions test/Data/HexStringSpec.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
module Data.HexStringSpec where

import Data.HexString ( hexString
, hexString'
, fromBytes
, toBytes )

Expand All @@ -20,6 +21,9 @@ spec = do
putStrLn (show (hexString (BS8.pack "`"))) `shouldThrow` anyErrorCall
putStrLn (show (hexString (BS8.pack "g"))) `shouldThrow` anyErrorCall

it "should return nothing when rejecting" $
(hexString' (BS8.pack "/")) `shouldBe` Nothing

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"
Expand Down