\subsection{Bytes}

Arbitrary byte array.

\begin{code}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData    #-}
module Network.Tox.SaveData.Bytes
    ( Bytes (..)
    ) where

import           Data.Binary               (Binary (..))
import qualified Data.Binary.Get           as Get
import qualified Data.Binary.Put           as Put
import qualified Data.ByteString.Lazy      as LBS
import           Data.MessagePack          (MessagePack)
import           GHC.Generics              (Generic)
import           Test.QuickCheck.Arbitrary (Arbitrary (..))

newtype Bytes = Bytes LBS.ByteString
    deriving (Bytes -> Bytes -> Bool
(Bytes -> Bytes -> Bool) -> (Bytes -> Bytes -> Bool) -> Eq Bytes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bytes -> Bytes -> Bool
$c/= :: Bytes -> Bytes -> Bool
== :: Bytes -> Bytes -> Bool
$c== :: Bytes -> Bytes -> Bool
Eq, Int -> Bytes -> ShowS
[Bytes] -> ShowS
Bytes -> String
(Int -> Bytes -> ShowS)
-> (Bytes -> String) -> ([Bytes] -> ShowS) -> Show Bytes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bytes] -> ShowS
$cshowList :: [Bytes] -> ShowS
show :: Bytes -> String
$cshow :: Bytes -> String
showsPrec :: Int -> Bytes -> ShowS
$cshowsPrec :: Int -> Bytes -> ShowS
Show, ReadPrec [Bytes]
ReadPrec Bytes
Int -> ReadS Bytes
ReadS [Bytes]
(Int -> ReadS Bytes)
-> ReadS [Bytes]
-> ReadPrec Bytes
-> ReadPrec [Bytes]
-> Read Bytes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bytes]
$creadListPrec :: ReadPrec [Bytes]
readPrec :: ReadPrec Bytes
$creadPrec :: ReadPrec Bytes
readList :: ReadS [Bytes]
$creadList :: ReadS [Bytes]
readsPrec :: Int -> ReadS Bytes
$creadsPrec :: Int -> ReadS Bytes
Read, (forall x. Bytes -> Rep Bytes x)
-> (forall x. Rep Bytes x -> Bytes) -> Generic Bytes
forall x. Rep Bytes x -> Bytes
forall x. Bytes -> Rep Bytes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bytes x -> Bytes
$cfrom :: forall x. Bytes -> Rep Bytes x
Generic)

instance MessagePack Bytes

instance Binary Bytes where
    get :: Get Bytes
get = ByteString -> Bytes
Bytes (ByteString -> Bytes) -> Get ByteString -> Get Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
Get.getRemainingLazyByteString
    put :: Bytes -> Put
put (Bytes ByteString
bs) = ByteString -> Put
Put.putLazyByteString ByteString
bs

instance Arbitrary Bytes where
    arbitrary :: Gen Bytes
arbitrary = ByteString -> Bytes
Bytes (ByteString -> Bytes)
-> ([Word8] -> ByteString) -> [Word8] -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
LBS.pack ([Word8] -> Bytes) -> Gen [Word8] -> Gen Bytes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary

\end{code}