{-# LANGUAGE DerivingStrategies #-}

module ZkFold.Base.Data.ByteString
  ( Binary (..)
  , toByteString
  , fromByteString
  , putWord8
  , getWord8
  , LittleEndian (..)
  ) where

import           Control.Applicative  (many)
import           Data.Binary
import           Data.Binary.Get
import           Data.Binary.Put
import qualified Data.ByteString      as Strict
import qualified Data.ByteString.Lazy as Lazy
import           Data.Foldable        (foldl')
import           Numeric.Natural      (Natural)
import           Prelude
import           Test.QuickCheck      (Arbitrary (..))

toByteString :: Binary a => a -> Strict.ByteString
toByteString :: forall a. Binary a => a -> ByteString
toByteString = ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString) -> (a -> Put) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Put
forall t. Binary t => t -> Put
put

fromByteString :: Binary a => Strict.ByteString -> Maybe a
fromByteString :: forall a. Binary a => ByteString -> Maybe a
fromByteString ByteString
x = case Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get a
forall t. Binary t => Get t
get (ByteString -> ByteString
Lazy.fromStrict ByteString
x) of
  Left (ByteString, ByteOffset, String)
_ -> Maybe a
forall a. Maybe a
Nothing
  Right (ByteString
leftover, ByteOffset
_, a
a) ->
    if ByteString -> Bool
Lazy.null ByteString
leftover then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing

-- Little-endian encoding for unsigned & unsized integers
-- un little, deux little, trois little endians
newtype LittleEndian = LittleEndian {LittleEndian -> Natural
unLittleEndian :: Natural}
  deriving stock (ReadPrec [LittleEndian]
ReadPrec LittleEndian
Int -> ReadS LittleEndian
ReadS [LittleEndian]
(Int -> ReadS LittleEndian)
-> ReadS [LittleEndian]
-> ReadPrec LittleEndian
-> ReadPrec [LittleEndian]
-> Read LittleEndian
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LittleEndian
readsPrec :: Int -> ReadS LittleEndian
$creadList :: ReadS [LittleEndian]
readList :: ReadS [LittleEndian]
$creadPrec :: ReadPrec LittleEndian
readPrec :: ReadPrec LittleEndian
$creadListPrec :: ReadPrec [LittleEndian]
readListPrec :: ReadPrec [LittleEndian]
Read, Int -> LittleEndian -> ShowS
[LittleEndian] -> ShowS
LittleEndian -> String
(Int -> LittleEndian -> ShowS)
-> (LittleEndian -> String)
-> ([LittleEndian] -> ShowS)
-> Show LittleEndian
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LittleEndian -> ShowS
showsPrec :: Int -> LittleEndian -> ShowS
$cshow :: LittleEndian -> String
show :: LittleEndian -> String
$cshowList :: [LittleEndian] -> ShowS
showList :: [LittleEndian] -> ShowS
Show)
  deriving newtype (LittleEndian -> LittleEndian -> Bool
(LittleEndian -> LittleEndian -> Bool)
-> (LittleEndian -> LittleEndian -> Bool) -> Eq LittleEndian
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LittleEndian -> LittleEndian -> Bool
== :: LittleEndian -> LittleEndian -> Bool
$c/= :: LittleEndian -> LittleEndian -> Bool
/= :: LittleEndian -> LittleEndian -> Bool
Eq, Eq LittleEndian
Eq LittleEndian =>
(LittleEndian -> LittleEndian -> Ordering)
-> (LittleEndian -> LittleEndian -> Bool)
-> (LittleEndian -> LittleEndian -> Bool)
-> (LittleEndian -> LittleEndian -> Bool)
-> (LittleEndian -> LittleEndian -> Bool)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> Ord LittleEndian
LittleEndian -> LittleEndian -> Bool
LittleEndian -> LittleEndian -> Ordering
LittleEndian -> LittleEndian -> LittleEndian
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LittleEndian -> LittleEndian -> Ordering
compare :: LittleEndian -> LittleEndian -> Ordering
$c< :: LittleEndian -> LittleEndian -> Bool
< :: LittleEndian -> LittleEndian -> Bool
$c<= :: LittleEndian -> LittleEndian -> Bool
<= :: LittleEndian -> LittleEndian -> Bool
$c> :: LittleEndian -> LittleEndian -> Bool
> :: LittleEndian -> LittleEndian -> Bool
$c>= :: LittleEndian -> LittleEndian -> Bool
>= :: LittleEndian -> LittleEndian -> Bool
$cmax :: LittleEndian -> LittleEndian -> LittleEndian
max :: LittleEndian -> LittleEndian -> LittleEndian
$cmin :: LittleEndian -> LittleEndian -> LittleEndian
min :: LittleEndian -> LittleEndian -> LittleEndian
Ord, Integer -> LittleEndian
LittleEndian -> LittleEndian
LittleEndian -> LittleEndian -> LittleEndian
(LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian)
-> (Integer -> LittleEndian)
-> Num LittleEndian
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: LittleEndian -> LittleEndian -> LittleEndian
+ :: LittleEndian -> LittleEndian -> LittleEndian
$c- :: LittleEndian -> LittleEndian -> LittleEndian
- :: LittleEndian -> LittleEndian -> LittleEndian
$c* :: LittleEndian -> LittleEndian -> LittleEndian
* :: LittleEndian -> LittleEndian -> LittleEndian
$cnegate :: LittleEndian -> LittleEndian
negate :: LittleEndian -> LittleEndian
$cabs :: LittleEndian -> LittleEndian
abs :: LittleEndian -> LittleEndian
$csignum :: LittleEndian -> LittleEndian
signum :: LittleEndian -> LittleEndian
$cfromInteger :: Integer -> LittleEndian
fromInteger :: Integer -> LittleEndian
Num, Int -> LittleEndian
LittleEndian -> Int
LittleEndian -> [LittleEndian]
LittleEndian -> LittleEndian
LittleEndian -> LittleEndian -> [LittleEndian]
LittleEndian -> LittleEndian -> LittleEndian -> [LittleEndian]
(LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian)
-> (Int -> LittleEndian)
-> (LittleEndian -> Int)
-> (LittleEndian -> [LittleEndian])
-> (LittleEndian -> LittleEndian -> [LittleEndian])
-> (LittleEndian -> LittleEndian -> [LittleEndian])
-> (LittleEndian -> LittleEndian -> LittleEndian -> [LittleEndian])
-> Enum LittleEndian
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: LittleEndian -> LittleEndian
succ :: LittleEndian -> LittleEndian
$cpred :: LittleEndian -> LittleEndian
pred :: LittleEndian -> LittleEndian
$ctoEnum :: Int -> LittleEndian
toEnum :: Int -> LittleEndian
$cfromEnum :: LittleEndian -> Int
fromEnum :: LittleEndian -> Int
$cenumFrom :: LittleEndian -> [LittleEndian]
enumFrom :: LittleEndian -> [LittleEndian]
$cenumFromThen :: LittleEndian -> LittleEndian -> [LittleEndian]
enumFromThen :: LittleEndian -> LittleEndian -> [LittleEndian]
$cenumFromTo :: LittleEndian -> LittleEndian -> [LittleEndian]
enumFromTo :: LittleEndian -> LittleEndian -> [LittleEndian]
$cenumFromThenTo :: LittleEndian -> LittleEndian -> LittleEndian -> [LittleEndian]
enumFromThenTo :: LittleEndian -> LittleEndian -> LittleEndian -> [LittleEndian]
Enum, Num LittleEndian
Ord LittleEndian
(Num LittleEndian, Ord LittleEndian) =>
(LittleEndian -> Rational) -> Real LittleEndian
LittleEndian -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: LittleEndian -> Rational
toRational :: LittleEndian -> Rational
Real, Enum LittleEndian
Real LittleEndian
(Real LittleEndian, Enum LittleEndian) =>
(LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> LittleEndian)
-> (LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian))
-> (LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian))
-> (LittleEndian -> Integer)
-> Integral LittleEndian
LittleEndian -> Integer
LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian)
LittleEndian -> LittleEndian -> LittleEndian
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: LittleEndian -> LittleEndian -> LittleEndian
quot :: LittleEndian -> LittleEndian -> LittleEndian
$crem :: LittleEndian -> LittleEndian -> LittleEndian
rem :: LittleEndian -> LittleEndian -> LittleEndian
$cdiv :: LittleEndian -> LittleEndian -> LittleEndian
div :: LittleEndian -> LittleEndian -> LittleEndian
$cmod :: LittleEndian -> LittleEndian -> LittleEndian
mod :: LittleEndian -> LittleEndian -> LittleEndian
$cquotRem :: LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian)
quotRem :: LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian)
$cdivMod :: LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian)
divMod :: LittleEndian -> LittleEndian -> (LittleEndian, LittleEndian)
$ctoInteger :: LittleEndian -> Integer
toInteger :: LittleEndian -> Integer
Integral)
instance Binary LittleEndian where
  get :: Get LittleEndian
get = do
    [Word8]
ns <- Get Word8 -> Get [Word8]
forall a. Get a -> Get [a]
forall (f :: Type -> Type) a. Alternative f => f a -> f [a]
many Get Word8
getWord8
    let accum :: a -> a -> a
accum a
n a
w8 = a
n a -> a -> a
forall a. Num a => a -> a -> a
* a
256 a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
w8
        littleEndian :: LittleEndian
littleEndian = Natural -> LittleEndian
LittleEndian ((Natural -> Word8 -> Natural) -> Natural -> [Word8] -> Natural
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Natural -> Word8 -> Natural
forall {a} {a}. (Integral a, Num a) => a -> a -> a
accum Natural
0 [Word8]
ns)
    LittleEndian -> Get LittleEndian
forall a. a -> Get a
forall (m :: Type -> Type) a. Monad m => a -> m a
return LittleEndian
littleEndian
  put :: LittleEndian -> Put
put (LittleEndian Natural
n)
    | Natural
n Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 = Put
forall a. Monoid a => a
mempty
    | Bool
otherwise =
      let (Natural
n', Natural
r) = Natural
n Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Natural
256
      in LittleEndian -> Put
forall t. Binary t => t -> Put
put (Natural -> LittleEndian
LittleEndian Natural
n') Put -> Put -> Put
forall a. Semigroup a => a -> a -> a
<> Word8 -> Put
putWord8 (Natural -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
r)
instance Arbitrary LittleEndian where
  arbitrary :: Gen LittleEndian
arbitrary = Integer -> LittleEndian
forall a. Num a => Integer -> a
fromInteger (Integer -> LittleEndian)
-> (Integer -> Integer) -> Integer -> LittleEndian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
abs (Integer -> LittleEndian) -> Gen Integer -> Gen LittleEndian
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary