serialization for tunings

3 files changed, 51 insertions, 6 deletions

diff --git a/Serialization.hs b/Serialization.hs
index 3c23137..172c6f9 100644
--- a/Serialization.hs
+++ b/Serialization.hs
@@ -1,15 +1,54 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Serialization where
 
 import Types
+import Cost
 import Raaz.Core.Encode
+import qualified Crypto.Argon2 as Argon2
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as B8
 import Data.Monoid
 import Data.Word
 import Text.Read
 
+instance Encodable ExpensiveHashTunable where
+	toByteString (UseArgon2 o _) = B.intercalate (B.singleton sepChar)
+		[ showb (Argon2.hashIterations o)
+		, showb (Argon2.hashMemory o)
+		, showb (Argon2.hashParallelism o)
+		, case Argon2.hashVariant o of
+			Argon2.Argon2i -> "argon2i"
+			Argon2.Argon2d -> "argon2d"
+		]
+	  where
+		showb = B8.pack . show
+	fromByteString b = case B.split sepChar b of
+		(i:m:p:v:[]) -> do
+			o <- Argon2.HashOptions
+				<$> readb i
+				<*> readb m
+				<*> readb p
+				<*> case v of
+					"argon2i" -> return Argon2.Argon2i
+					"argon2d" -> return Argon2.Argon2d
+					_ -> Nothing
+			return $ UseArgon2 o unknownCost
+		_ -> Nothing
+	  where
+		readb = readMaybe . B8.unpack
+
+instance Encodable EncryptionTunable where
+	toByteString UseAES256 = "AES"
+	fromByteString "AES" = Just UseAES256
+	fromByteString _  = Nothing
+
+instance Encodable DecryptionPuzzleTunable where
+	toByteString (KeyBlindingLeftSide _) = ">"
+	fromByteString ">" = Just (KeyBlindingLeftSide unknownCost)
+	fromByteString _  = Nothing
+
 -- TODO
 -- | An EncryptedSecretKey is serialized as first a md5sum of the rest
 -- of the content, and then a SelfDescription EncryptedSecretKey,
@@ -22,8 +61,8 @@ import Text.Read
 -- For example "gpg Joey Hess"
 instance Encodable KeyIdent where
 	toByteString (KeyIdent (KeyType t) (Name n)) =
-		t <> B.singleton identSepChar <> n
-	fromByteString b = case B.break (== identSepChar) b of
+		t <> B.singleton sepChar <> n
+	fromByteString b = case B.break (== sepChar) b of
 		(t, n)
 			| B.null n -> Nothing
 			| otherwise -> Just $
@@ -33,8 +72,8 @@ instance Encodable KeyIdent where
 -- For example "1 gpg Joey Hess"
 instance Encodable ObjectIdent where
 	toByteString (ObjectIdent (ShardNum n) keyident) =
-		B8.pack (show n) <> B.singleton identSepChar <> toByteString keyident
-	fromByteString b = case B.break (== identSepChar) b of
+		B8.pack (show n) <> B.singleton sepChar <> toByteString keyident
+	fromByteString b = case B.break (== sepChar) b of
 		(ns, rest)
 			| B.null ns -> Nothing
 			| otherwise -> do
@@ -42,5 +81,5 @@ instance Encodable ObjectIdent where
 				n <- readMaybe (B8.unpack ns)
 				return $ ObjectIdent (ShardNum n) keyident
 
-identSepChar :: Word8
-identSepChar = 32
+sepChar :: Word8
+sepChar = 32
diff --git a/Types.hs b/Types.hs
index 7873175..41c3a00 100644
--- a/Types.hs
+++ b/Types.hs
@@ -42,12 +42,15 @@ data Tunables = Tunables
 
 -- | An expensive hash, used to make it hard to crack an encrypted secret key.
 data ExpensiveHashTunable = UseArgon2 Argon2.HashOptions (Cost CreationOp)
+	deriving (Show)
 
 -- | What encryption to use.
 data EncryptionTunable = UseAES256
+	deriving (Show)
 
 -- | An additional puzzle that makes decryption more expensive.
 data DecryptionPuzzleTunable = KeyBlindingLeftSide (Cost DecryptionOp)
+	deriving (Show)
 
 defaultTunables :: Tunables
 defaultTunables = Tunables
diff --git a/Types/Cost.hs b/Types/Cost.hs
index c742848..f880bfe 100644
--- a/Types/Cost.hs
+++ b/Types/Cost.hs
@@ -11,6 +11,9 @@ data Cost op
 	| CombinedCost (Cost op) (Cost op)
 	deriving (Show)
 
+unknownCost :: Cost op
+unknownCost = CPUCost (Seconds 0)
+
 newtype Seconds = Seconds Integer
 	deriving (Num)