\begin{code}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module Network.Tox.SaveData.Friend where

import           Data.Binary               (Binary (..))
import qualified Data.Binary.Get           as Get
import qualified Data.Binary.Put           as Put
import qualified Data.ByteString           as BS
import           Data.Monoid               ((<>))
import           Data.Word                 (Word32, Word64, Word8)
import           Network.Tox.Crypto.Key    (PublicKey)
import           Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
\end{code}

Friend:

The integers in this structure are stored in Big Endian format.

\begin{tabular}{l|l}
  Length        & Contents \\
  \hline
  \texttt{1}    & \texttt{uint8\_t} Status \\
  \texttt{32}   & Long term public key \\
  \texttt{1024} & Friend request message as a byte string \\
  \texttt{1}    & PADDING \\
  \texttt{2}    & \texttt{uint16\_t} Size of the friend request message \\
  \texttt{128}  & Name as a byte string \\
  \texttt{2}    & \texttt{uint16\_t} Size of the name \\
  \texttt{1007} & Status message as a byte string \\
  \texttt{1}    & PADDING \\
  \texttt{2}    & \texttt{uint16\_t} Size of the status message \\
  \texttt{1}    & \texttt{uint8\_t} User status (see also: \texttt{USERSTATUS}) \\
  \texttt{3}    & PADDING \\
  \texttt{4}    & \texttt{uint32\_t} Nospam (only used for sending a friend request) \\
  \texttt{8}    & \texttt{uint64\_t} Last seen time \\
\end{tabular}

Status can be one of:

\begin{tabular}{l|l}
  Status & Meaning \\
  \hline
  0      & Not a friend \\
  1      & Friend added \\
  2      & Friend request sent \\
  3      & Confirmed friend \\
  4      & Friend online \\
\end{tabular}

\begin{code}

data Friend = Friend
    { Friend -> Word8
status        :: Word8
    , Friend -> PublicKey
publicKey     :: PublicKey
    , Friend -> ByteString
friendRequest :: BS.ByteString
    , Friend -> ByteString
name          :: BS.ByteString
    , Friend -> ByteString
statusMessage :: BS.ByteString
    , Friend -> Word8
userStatus    :: Word8
    , Friend -> Word32
nospam        :: Word32
    , Friend -> Word64
lastSeenTime  :: Word64
    }
    deriving (Friend -> Friend -> Bool
(Friend -> Friend -> Bool)
-> (Friend -> Friend -> Bool) -> Eq Friend
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Friend -> Friend -> Bool
$c/= :: Friend -> Friend -> Bool
== :: Friend -> Friend -> Bool
$c== :: Friend -> Friend -> Bool
Eq, Int -> Friend -> ShowS
[Friend] -> ShowS
Friend -> String
(Int -> Friend -> ShowS)
-> (Friend -> String) -> ([Friend] -> ShowS) -> Show Friend
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Friend] -> ShowS
$cshowList :: [Friend] -> ShowS
show :: Friend -> String
$cshow :: Friend -> String
showsPrec :: Int -> Friend -> ShowS
$cshowsPrec :: Int -> Friend -> ShowS
Show, ReadPrec [Friend]
ReadPrec Friend
Int -> ReadS Friend
ReadS [Friend]
(Int -> ReadS Friend)
-> ReadS [Friend]
-> ReadPrec Friend
-> ReadPrec [Friend]
-> Read Friend
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Friend]
$creadListPrec :: ReadPrec [Friend]
readPrec :: ReadPrec Friend
$creadPrec :: ReadPrec Friend
readList :: ReadS [Friend]
$creadList :: ReadS [Friend]
readsPrec :: Int -> ReadS Friend
$creadsPrec :: Int -> ReadS Friend
Read)

maxFriendRequestLen :: Int
maxFriendRequestLen :: Int
maxFriendRequestLen = Int
1024

maxNameLen :: Int
maxNameLen :: Int
maxNameLen = Int
128

maxStatusMessageLen :: Int
maxStatusMessageLen :: Int
maxStatusMessageLen = Int
1007

instance Binary Friend where
    get :: Get Friend
get = do
        Word8
status           <- Get Word8
Get.getWord8
        PublicKey
publicKey        <- Get PublicKey
forall t. Binary t => Get t
get
        ByteString
friendRequest'   <- Int -> Get ByteString
Get.getByteString Int
maxFriendRequestLen
        Word8
_                <- Get Word8
Get.getWord8
        Word16
friendRequestLen <- Get Word16
Get.getWord16be
        ByteString
name'            <- Int -> Get ByteString
Get.getByteString Int
maxNameLen
        Word16
nameLen          <- Get Word16
Get.getWord16be
        ByteString
statusMessage'   <- Int -> Get ByteString
Get.getByteString Int
maxStatusMessageLen
        Word8
_                <- Get Word8
Get.getWord8
        Word16
statusMessageLen <- Get Word16
Get.getWord16be
        Word8
userStatus       <- Get Word8
Get.getWord8
        ByteString
_                <- Int -> Get ByteString
Get.getByteString Int
3
        Word32
nospam           <- Get Word32
Get.getWord32be
        Word64
lastSeenTime     <- Get Word64
Get.getWord64be

        let friendRequest :: ByteString
friendRequest = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
friendRequestLen) ByteString
friendRequest'
        let name :: ByteString
name = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
nameLen) ByteString
name'
        let statusMessage :: ByteString
statusMessage = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
statusMessageLen) ByteString
statusMessage'

        Friend -> Get Friend
forall (m :: * -> *) a. Monad m => a -> m a
return Friend :: Word8
-> PublicKey
-> ByteString
-> ByteString
-> ByteString
-> Word8
-> Word32
-> Word64
-> Friend
Friend{Word8
Word32
Word64
ByteString
PublicKey
statusMessage :: ByteString
name :: ByteString
friendRequest :: ByteString
lastSeenTime :: Word64
nospam :: Word32
userStatus :: Word8
publicKey :: PublicKey
status :: Word8
lastSeenTime :: Word64
nospam :: Word32
userStatus :: Word8
statusMessage :: ByteString
name :: ByteString
friendRequest :: ByteString
publicKey :: PublicKey
status :: Word8
..}

    put :: Friend -> Put
put Friend {Word8
Word32
Word64
ByteString
PublicKey
lastSeenTime :: Word64
nospam :: Word32
userStatus :: Word8
statusMessage :: ByteString
name :: ByteString
friendRequest :: ByteString
publicKey :: PublicKey
status :: Word8
lastSeenTime :: Friend -> Word64
nospam :: Friend -> Word32
userStatus :: Friend -> Word8
statusMessage :: Friend -> ByteString
name :: Friend -> ByteString
friendRequest :: Friend -> ByteString
publicKey :: Friend -> PublicKey
status :: Friend -> Word8
..} = do
        let friendRequestLen :: Int
friendRequestLen = ByteString -> Int
BS.length ByteString
friendRequest
        let friendRequest' :: ByteString
friendRequest' = ByteString
friendRequest
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
maxFriendRequestLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
friendRequestLen) Word8
0

        let nameLen :: Int
nameLen = ByteString -> Int
BS.length ByteString
name
        let name' :: ByteString
name' = ByteString
name
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
maxNameLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nameLen) Word8
0

        let statusMessageLen :: Int
statusMessageLen = ByteString -> Int
BS.length ByteString
statusMessage
        let statusMessage' :: ByteString
statusMessage' = ByteString
statusMessage
                ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Word8 -> ByteString
BS.replicate (Int
maxStatusMessageLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
statusMessageLen) Word8
0

        Word8 -> Put
Put.putWord8            Word8
status
        PublicKey -> Put
forall t. Binary t => t -> Put
put                     PublicKey
publicKey
        ByteString -> Put
Put.putByteString       ByteString
friendRequest'
        Word8 -> Put
Put.putWord8            Word8
0
        Word16 -> Put
Put.putWord16be         (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
friendRequestLen)
        ByteString -> Put
Put.putByteString       ByteString
name'
        Word16 -> Put
Put.putWord16be         (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nameLen)
        ByteString -> Put
Put.putByteString       ByteString
statusMessage'
        Word8 -> Put
Put.putWord8            Word8
0
        Word16 -> Put
Put.putWord16be         (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
statusMessageLen)
        Word8 -> Put
Put.putWord8            Word8
userStatus
        ByteString -> Put
Put.putByteString       ByteString
"\0\0\0"
        Word32 -> Put
Put.putWord32be         Word32
nospam
        Word64 -> Put
Put.putWord64be         Word64
lastSeenTime

instance Arbitrary Friend where
    arbitrary :: Gen Friend
arbitrary = Word8
-> PublicKey
-> ByteString
-> ByteString
-> ByteString
-> Word8
-> Word32
-> Word64
-> Friend
Friend
        (Word8
 -> PublicKey
 -> ByteString
 -> ByteString
 -> ByteString
 -> Word8
 -> Word32
 -> Word64
 -> Friend)
-> Gen Word8
-> Gen
     (PublicKey
      -> ByteString
      -> ByteString
      -> ByteString
      -> Word8
      -> Word32
      -> Word64
      -> Friend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (PublicKey
   -> ByteString
   -> ByteString
   -> ByteString
   -> Word8
   -> Word32
   -> Word64
   -> Friend)
-> Gen PublicKey
-> Gen
     (ByteString
      -> ByteString -> ByteString -> Word8 -> Word32 -> Word64 -> Friend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen PublicKey
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (ByteString
   -> ByteString -> ByteString -> Word8 -> Word32 -> Word64 -> Friend)
-> Gen ByteString
-> Gen
     (ByteString -> ByteString -> Word8 -> Word32 -> Word64 -> Friend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> ([Word8] -> [Word8]) -> [Word8] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
maxFriendRequestLen ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary)
        Gen
  (ByteString -> ByteString -> Word8 -> Word32 -> Word64 -> Friend)
-> Gen ByteString
-> Gen (ByteString -> Word8 -> Word32 -> Word64 -> Friend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> ([Word8] -> [Word8]) -> [Word8] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
maxNameLen ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary)
        Gen (ByteString -> Word8 -> Word32 -> Word64 -> Friend)
-> Gen ByteString -> Gen (Word8 -> Word32 -> Word64 -> Friend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Word8] -> ByteString
BS.pack ([Word8] -> ByteString)
-> ([Word8] -> [Word8]) -> [Word8] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
maxStatusMessageLen ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Word8]
forall a. Arbitrary a => Gen a
arbitrary)
        Gen (Word8 -> Word32 -> Word64 -> Friend)
-> Gen Word8 -> Gen (Word32 -> Word64 -> Friend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Word32 -> Word64 -> Friend)
-> Gen Word32 -> Gen (Word64 -> Friend)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Word64 -> Friend) -> Gen Word64 -> Gen Friend
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary

\end{code}