module Legacy.Haskoin.V0102.Network.Haskoin.Util
( toStrictBS
, toLazyBS
, stringToBS
, bsToString
, bsToInteger
, integerToBS
, bsToHex
, hexToBS
, encode'
, decode'
, runPut'
, runGet'
, decodeOrFail'
, runGetOrFail'
, fromDecode
, fromRunGet
, decodeToEither
, decodeToMaybe
, isolate
) where
import Control.Monad (guard)
import Numeric (readHex)
import Data.Binary (Binary, encode, decode, decodeOrFail)
import Data.Binary.Get
(Get, runGetOrFail, getByteString, ByteOffset, runGet)
import Data.Binary.Put (Put, runPut)
import Data.Bits ((.|.), shiftL, shiftR)
import Data.List (unfoldr)
import Data.List.Split (chunksOf)
import Data.Word (Word8)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL
toStrictBS :: BL.ByteString -> BS.ByteString
toStrictBS = BS.concat . BL.toChunks
toLazyBS :: BS.ByteString -> BL.ByteString
toLazyBS bs = BL.fromChunks [bs]
stringToBS :: String -> BS.ByteString
stringToBS = C.pack
bsToString :: BS.ByteString -> String
bsToString = C.unpack
bsToInteger :: BS.ByteString -> Integer
bsToInteger = foldr f 0 . reverse . BS.unpack
where
f w n = toInteger w .|. shiftL n 8
integerToBS :: Integer -> BS.ByteString
integerToBS 0 = BS.pack [0]
integerToBS i
| i > 0 = BS.pack $ reverse $ unfoldr f i
| otherwise = error "integerToBS not defined for negative values"
where
f 0 = Nothing
f x = Just (fromInteger x :: Word8, x `shiftR` 8)
bsToHex :: BS.ByteString -> String
bsToHex = bsToString . toStrictBS . BSB.toLazyByteString . BSB.byteStringHex
hexToBS :: String -> Maybe BS.ByteString
hexToBS xs = BS.pack <$> mapM hexWord (chunksOf 2 xs)
where
hexWord x = do
guard $ length x == 2
let hs = readHex x
guard $ not $ null hs
let [(w, s)] = hs
guard $ null s
return w
encode'
:: Binary a
=> a -> BS.ByteString
encode' = toStrictBS . encode
decode'
:: Binary a
=> BS.ByteString -> a
decode' = decode . toLazyBS
runGet'
:: Binary a
=> Get a -> BS.ByteString -> a
runGet' m = runGet m . toLazyBS
runPut' :: Put -> BS.ByteString
runPut' = toStrictBS . runPut
decodeOrFail'
:: Binary a
=> BS.ByteString
-> Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)
decodeOrFail' bs =
case decodeOrFail $ toLazyBS bs of
Left (lbs, o, err) -> Left (toStrictBS lbs, o, err)
Right (lbs, o, res) -> Right (toStrictBS lbs, o, res)
runGetOrFail'
:: Binary a
=> Get a
-> BS.ByteString
-> Either (BS.ByteString, ByteOffset, String) (BS.ByteString, ByteOffset, a)
runGetOrFail' m bs =
case runGetOrFail m $ toLazyBS bs of
Left (lbs, o, err) -> Left (toStrictBS lbs, o, err)
Right (lbs, o, res) -> Right (toStrictBS lbs, o, res)
fromDecode
:: Binary a
=> BS.ByteString
-> b
-> (a -> b)
-> b
fromDecode bs def f = either (const def) (f . lst) $ decodeOrFail' bs
where
lst (_, _, c) = c
fromRunGet
:: Binary a
=> Get a
-> BS.ByteString
-> b
-> (a -> b)
-> b
fromRunGet m bs def f = either (const def) (f . lst) $ runGetOrFail' m bs
where
lst (_, _, c) = c
decodeToEither
:: Binary a
=> BS.ByteString -> Either String a
decodeToEither bs =
case decodeOrFail' bs of
Left (_, _, err) -> Left err
Right (_, _, res) -> Right res
decodeToMaybe
:: Binary a
=> BS.ByteString -> Maybe a
decodeToMaybe bs = fromDecode bs Nothing Just
isolate
:: Binary a
=> Int -> Get a -> Get a
isolate i g = do
bs <- getByteString i
case runGetOrFail' g bs of
Left (_, _, err) -> fail err
Right (unconsumed, _, res)
| BS.null unconsumed -> return res
| otherwise -> fail "Isolate: unconsumed input"