Implement tests
This commit is contained in:
parent
309dd06a2e
commit
fe2df6f7d6
2 changed files with 30 additions and 34 deletions
|
@ -8,9 +8,7 @@
|
||||||
module Data.HexString
|
module Data.HexString
|
||||||
( HexString(..)
|
( HexString(..)
|
||||||
, hexString
|
, hexString
|
||||||
, fromBinary
|
, fromRawBytes
|
||||||
, toBinary
|
|
||||||
, fromBytes
|
|
||||||
, toBytes
|
, toBytes
|
||||||
, fromText
|
, fromText
|
||||||
, toText
|
, toText
|
||||||
|
@ -23,7 +21,7 @@ import Data.Aeson
|
||||||
import Data.Word (Word8)
|
import Data.Word (Word8)
|
||||||
|
|
||||||
import qualified Data.ByteString as BS
|
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 qualified Data.ByteString.Lazy as BSL
|
||||||
|
|
||||||
import Data.Structured
|
import Data.Structured
|
||||||
|
@ -39,11 +37,14 @@ import qualified Generics.SOP as SOP
|
||||||
-- are valid hex characters.
|
-- are valid hex characters.
|
||||||
newtype HexString = HexString
|
newtype HexString = HexString
|
||||||
{ hexBytes :: BS.ByteString
|
{ hexBytes :: BS.ByteString
|
||||||
} deriving stock (Eq, Prelude.Show, GHC.Generic)
|
} deriving stock (Eq, GHC.Generic)
|
||||||
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
|
||||||
deriving anyclass (Data.Structured.Show)
|
deriving anyclass (Data.Structured.Show)
|
||||||
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct HexString
|
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct HexString
|
||||||
|
|
||||||
|
instance Prelude.Show HexString where
|
||||||
|
show = T.unpack . toText
|
||||||
|
|
||||||
instance FromJSON HexString where
|
instance FromJSON HexString where
|
||||||
parseJSON = withText "HexString" $ pure . hexString . TE.encodeUtf8
|
parseJSON = withText "HexString" $ pure . hexString . TE.encodeUtf8
|
||||||
|
|
||||||
|
@ -54,37 +55,32 @@ instance ToJSON HexString where
|
||||||
-- hexadecimal characters.
|
-- hexadecimal characters.
|
||||||
hexString :: BS.ByteString -> HexString
|
hexString :: BS.ByteString -> HexString
|
||||||
hexString bs =
|
hexString bs =
|
||||||
let isValidHex :: Word8 -> Bool
|
case BS16.decode bs of
|
||||||
isValidHex c
|
Right s -> HexString s
|
||||||
| (48 <= c) && (c < 58) = True
|
Left e -> error e
|
||||||
| (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)
|
|
||||||
|
|
||||||
-- | Converts a 'B.Binary' to a 'HexString' value
|
-- | 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
|
fromBinary = HexString . BSL.toStrict . B.encode
|
||||||
|
|
||||||
-- | Converts a 'HexString' to a 'B.Binary' value
|
-- | Converts a 'HexString' to a 'B.Binary' value
|
||||||
toBinary :: B.Binary a => HexString -> a
|
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
|
-- | Reads a 'BS.ByteString' as raw bytes and converts to hex representation. We
|
||||||
-- cannot use the instance Binary of 'BS.ByteString' because it provides
|
-- 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.
|
-- a leading length, which is not what we want when dealing with raw bytes.
|
||||||
fromBytes :: BS.ByteString -> HexString
|
fromRawBytes :: BS.ByteString -> HexString
|
||||||
fromBytes = hexString . BS16.encode
|
fromRawBytes = HexString
|
||||||
|
|
||||||
-- | Access to the raw bytes in a 'BS.ByteString' format.
|
-- | Access to the raw bytes in a 'BS.ByteString' format.
|
||||||
toBytes :: HexString -> BS.ByteString
|
toBytes :: HexString -> BS.ByteString
|
||||||
toBytes (HexString bs) = BS16.decodeLenient bs
|
toBytes (HexString bs) = bs
|
||||||
|
|
||||||
-- | Reads a human-readable hex string into a `HexString`
|
-- | Reads a human-readable hex string into a `HexString`
|
||||||
fromText :: T.Text -> HexString
|
fromText :: T.Text -> HexString
|
||||||
fromText = hexString . BS16.decodeLenient . TE.encodeUtf8
|
fromText = hexString . TE.encodeUtf8
|
||||||
|
|
||||||
-- | Access to a 'T.Text' representation of the 'HexString'
|
-- | Access to a 'T.Text' representation of the 'HexString'
|
||||||
toText :: HexString -> T.Text
|
toText :: HexString -> T.Text
|
||||||
toText (HexString bs) = TE.decodeUtf8 bs
|
toText (HexString bs) = (TE.decodeUtf8 . BS16.encode) bs
|
||||||
|
|
|
@ -1,27 +1,27 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Data.HexStringSpec where
|
module Data.HexStringSpec where
|
||||||
|
|
||||||
import Data.HexString ( hexString
|
import Data.HexString (fromRawBytes, fromText, hexString, toBytes, toText)
|
||||||
, fromBytes
|
|
||||||
, toBytes )
|
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BS8
|
import qualified Data.ByteString.Char8 as BS8
|
||||||
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
|
|
||||||
spec :: Spec
|
spec :: Spec
|
||||||
spec = do
|
spec = do
|
||||||
describe "when constructing a hex string" $ 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
|
it "should reject strings outside the range" $ do
|
||||||
putStrLn (show (hexString (BS8.pack "/"))) `shouldThrow` anyErrorCall
|
print (hexString (BS8.pack "/")) `shouldThrow` anyErrorCall
|
||||||
putStrLn (show (hexString (BS8.pack ":"))) `shouldThrow` anyErrorCall
|
print (hexString (BS8.pack ":")) `shouldThrow` anyErrorCall
|
||||||
putStrLn (show (hexString (BS8.pack "`"))) `shouldThrow` anyErrorCall
|
print (hexString (BS8.pack "`")) `shouldThrow` anyErrorCall
|
||||||
putStrLn (show (hexString (BS8.pack "g"))) `shouldThrow` anyErrorCall
|
print (hexString (BS8.pack "g")) `shouldThrow` anyErrorCall
|
||||||
|
|
||||||
describe "when interpreting a hex string" $ do
|
describe "when interpreting a hex string" $ do
|
||||||
it "should convert the hex string properly when interpreting as bytes" $
|
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" $
|
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")
|
||||||
|
|
Loading…
Reference in a new issue