diff options
author | joe <joe@jerkface.net> | 2017-09-04 15:47:00 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-09-04 15:47:00 -0400 |
commit | 279605e44d6078f4171e81f5a9539e414d1a3d25 (patch) | |
tree | e230bb7ef61bbbc556b267ea28600d112eff0193 | |
parent | 2e0d1e945c4c0e298176d58cf68df8191b698c1a (diff) |
Moniod instance for Sized (and Contravariant instance).
-rw-r--r-- | ToxCrypto.hs | 32 |
1 files changed, 30 insertions, 2 deletions
diff --git a/ToxCrypto.hs b/ToxCrypto.hs index e3bc57f9..87f64c9a 100644 --- a/ToxCrypto.hs +++ b/ToxCrypto.hs | |||
@@ -53,6 +53,7 @@ import Data.ByteString as B | |||
53 | import qualified Data.ByteString.Base16 as Base16 | 53 | import qualified Data.ByteString.Base16 as Base16 |
54 | import qualified Data.ByteString.Char8 as C8 | 54 | import qualified Data.ByteString.Char8 as C8 |
55 | import Data.Data | 55 | import Data.Data |
56 | import Data.Functor.Contravariant | ||
56 | import Data.Kind | 57 | import Data.Kind |
57 | import Data.Ord | 58 | import Data.Ord |
58 | import Data.Serialize as S | 59 | import Data.Serialize as S |
@@ -100,8 +101,25 @@ authAndBytes (Encrypted bs) = (auth,bs') | |||
100 | (as,bs') = B.splitAt 16 bs | 101 | (as,bs') = B.splitAt 16 bs |
101 | Right auth = decode as | 102 | Right auth = decode as |
102 | 103 | ||
103 | data Size a = ConstSize Int | 104 | -- | Info about a type's serialized length. Either the length is known |
104 | | VarSize (a -> Int) | 105 | -- independently of the value, or the length depends on the value. |
106 | data Size a | ||
107 | = VarSize (a -> Int) | ||
108 | | ConstSize !Int | ||
109 | deriving Typeable | ||
110 | |||
111 | instance Contravariant Size where | ||
112 | contramap f sz = case sz of | ||
113 | ConstSize n -> ConstSize n | ||
114 | VarSize g -> VarSize (\x -> g (f x)) | ||
115 | |||
116 | instance Monoid (Size a) where | ||
117 | ConstSize x `mappend` ConstSize y = ConstSize (x + y) | ||
118 | VarSize f `mappend` ConstSize y = VarSize $ \x -> f x + y | ||
119 | ConstSize x `mappend` VarSize g = VarSize $ \y -> x + g y | ||
120 | VarSize f `mappend` VarSize g = VarSize $ \x -> f x + g x | ||
121 | mempty = ConstSize 0 | ||
122 | |||
105 | 123 | ||
106 | class Sized a where size :: Size a | 124 | class Sized a where size :: Size a |
107 | 125 | ||
@@ -111,6 +129,11 @@ instance Sized a => Serialize (Encrypted a) where | |||
111 | ConstSize n -> Encrypted <$> getBytes (16 + n) -- 16 extra for Poly1305 mac | 129 | ConstSize n -> Encrypted <$> getBytes (16 + n) -- 16 extra for Poly1305 mac |
112 | put = putEncrypted | 130 | put = putEncrypted |
113 | 131 | ||
132 | instance Sized a => Sized (Encrypted a) where | ||
133 | size = case size of | ||
134 | ConstSize n -> ConstSize $ n + 16 | ||
135 | VarSize f -> VarSize $ \x -> f x + 16 | ||
136 | |||
114 | instance (Sized a, Sized b) => Sized (a,b) where | 137 | instance (Sized a, Sized b) => Sized (a,b) where |
115 | size = case (size :: Size a, size :: Size b) of | 138 | size = case (size :: Size a, size :: Size b) of |
116 | (ConstSize a , ConstSize b) -> ConstSize $ a + b | 139 | (ConstSize a , ConstSize b) -> ConstSize $ a + b |
@@ -250,6 +273,11 @@ data Assym a = Assym | |||
250 | } | 273 | } |
251 | deriving (Functor,Foldable,Traversable) | 274 | deriving (Functor,Foldable,Traversable) |
252 | 275 | ||
276 | instance Sized a => Sized (Assym a) where | ||
277 | size = case size of | ||
278 | ConstSize a -> ConstSize $ a + 24 + 32 | ||
279 | VarSize f -> VarSize $ \Assym { assymData = x } -> f x + 24 + 32 | ||
280 | |||
253 | -- | Field order: senderKey, then nonce This is the format used by | 281 | -- | Field order: senderKey, then nonce This is the format used by |
254 | -- Ping/Pong/GetNodes/SendNodes. | 282 | -- Ping/Pong/GetNodes/SendNodes. |
255 | -- | 283 | -- |