{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE KindSignatures    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData        #-}
module Network.Tox.C.Type where

import qualified Data.ByteString           as BS
import           Data.MessagePack          (MessagePack)
import           GHC.Generics              (Generic)
import           GHC.TypeNats              (Nat)
import           Test.QuickCheck.Arbitrary (Arbitrary (..))


newtype FixedByteString (size :: Nat) = FixedByteString BS.ByteString
    deriving (Eq (FixedByteString size)
Eq (FixedByteString size)
-> (FixedByteString size -> FixedByteString size -> Ordering)
-> (FixedByteString size -> FixedByteString size -> Bool)
-> (FixedByteString size -> FixedByteString size -> Bool)
-> (FixedByteString size -> FixedByteString size -> Bool)
-> (FixedByteString size -> FixedByteString size -> Bool)
-> (FixedByteString size
    -> FixedByteString size -> FixedByteString size)
-> (FixedByteString size
    -> FixedByteString size -> FixedByteString size)
-> Ord (FixedByteString size)
FixedByteString size -> FixedByteString size -> Bool
FixedByteString size -> FixedByteString size -> Ordering
FixedByteString size
-> FixedByteString size -> FixedByteString size
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
forall (size :: Nat). Eq (FixedByteString size)
forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Ordering
forall (size :: Nat).
FixedByteString size
-> FixedByteString size -> FixedByteString size
min :: FixedByteString size
-> FixedByteString size -> FixedByteString size
$cmin :: forall (size :: Nat).
FixedByteString size
-> FixedByteString size -> FixedByteString size
max :: FixedByteString size
-> FixedByteString size -> FixedByteString size
$cmax :: forall (size :: Nat).
FixedByteString size
-> FixedByteString size -> FixedByteString size
>= :: FixedByteString size -> FixedByteString size -> Bool
$c>= :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
> :: FixedByteString size -> FixedByteString size -> Bool
$c> :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
<= :: FixedByteString size -> FixedByteString size -> Bool
$c<= :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
< :: FixedByteString size -> FixedByteString size -> Bool
$c< :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
compare :: FixedByteString size -> FixedByteString size -> Ordering
$ccompare :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Ordering
$cp1Ord :: forall (size :: Nat). Eq (FixedByteString size)
Ord, FixedByteString size -> FixedByteString size -> Bool
(FixedByteString size -> FixedByteString size -> Bool)
-> (FixedByteString size -> FixedByteString size -> Bool)
-> Eq (FixedByteString size)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
/= :: FixedByteString size -> FixedByteString size -> Bool
$c/= :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
== :: FixedByteString size -> FixedByteString size -> Bool
$c== :: forall (size :: Nat).
FixedByteString size -> FixedByteString size -> Bool
Eq, Int -> FixedByteString size -> ShowS
[FixedByteString size] -> ShowS
FixedByteString size -> String
(Int -> FixedByteString size -> ShowS)
-> (FixedByteString size -> String)
-> ([FixedByteString size] -> ShowS)
-> Show (FixedByteString size)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (size :: Nat). Int -> FixedByteString size -> ShowS
forall (size :: Nat). [FixedByteString size] -> ShowS
forall (size :: Nat). FixedByteString size -> String
showList :: [FixedByteString size] -> ShowS
$cshowList :: forall (size :: Nat). [FixedByteString size] -> ShowS
show :: FixedByteString size -> String
$cshow :: forall (size :: Nat). FixedByteString size -> String
showsPrec :: Int -> FixedByteString size -> ShowS
$cshowsPrec :: forall (size :: Nat). Int -> FixedByteString size -> ShowS
Show, (forall x. FixedByteString size -> Rep (FixedByteString size) x)
-> (forall x. Rep (FixedByteString size) x -> FixedByteString size)
-> Generic (FixedByteString size)
forall x. Rep (FixedByteString size) x -> FixedByteString size
forall x. FixedByteString size -> Rep (FixedByteString size) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (size :: Nat) x.
Rep (FixedByteString size) x -> FixedByteString size
forall (size :: Nat) x.
FixedByteString size -> Rep (FixedByteString size) x
$cto :: forall (size :: Nat) x.
Rep (FixedByteString size) x -> FixedByteString size
$cfrom :: forall (size :: Nat) x.
FixedByteString size -> Rep (FixedByteString size) x
Generic)

instance MessagePack (FixedByteString size)

instance Arbitrary (FixedByteString size) where
    arbitrary :: Gen (FixedByteString size)
arbitrary = FixedByteString size -> Gen (FixedByteString size)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FixedByteString size -> Gen (FixedByteString size))
-> FixedByteString size -> Gen (FixedByteString size)
forall a b. (a -> b) -> a -> b
$ ByteString -> FixedByteString size
forall (size :: Nat). ByteString -> FixedByteString size
FixedByteString ByteString
"00000000000000000000000000000000"


type PublicKey = FixedByteString 32