{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}

{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module Share where

import Types
import Tunables
import ExpensiveHash
import Cost
import qualified Crypto.SecretSharing.Internal as SS
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Raaz.Core.Encode as Raaz
import qualified Raaz.Hash.Sha256 as Raaz
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Monoid
import Control.DeepSeq

data ShareIdents = ShareIdents
	{ getIdents :: [StorableObjectIdent]
	-- ^ An infinite list of idents to use for shares.
	, identsCreationCost :: Cost CreationOp
	, identsBruteForceCalc :: CostCalc BruteForceOp UnknownName
	}

instance NFData ShareIdents where
	rnf = rnf . getIdents

instance HasCreationCost ShareIdents where
	getCreationCost = identsCreationCost

instance Bruteforceable ShareIdents UnknownName where
	getBruteCostCalc = identsBruteForceCalc

-- | Generates identifiers to use for storing shares.
--
-- This is an expensive operation, to make it difficult for an attacker
-- to brute force known/guessed names and find matching shares.
-- The keyid or filename is used as a salt, to avoid collisions
-- when the same name is chosen for multiple keys.
shareIdents :: Tunables -> Name -> SecretKeySource -> ShareIdents
shareIdents tunables (Name name) keyid =
	ShareIdents idents creationcost bruteforcecalc
  where
	(ExpensiveHash creationcost basename) =
		expensiveHash hashtunables (Salt keyid) name
	mk n = StorableObjectIdent $ Raaz.toByteString $ mksha $
		E.encodeUtf8 $ basename <> T.pack (show n)
	mksha :: B.ByteString -> Raaz.Base16
	mksha = Raaz.encode . Raaz.sha256
	idents = map mk [1..]
	bruteforcecalc = bruteForceLinearSearch creationcost
	hashtunables = nameGenerationHash $ nameGenerationTunable tunables

genShares :: EncryptedSecretKey -> Tunables -> IO [Share]
genShares (EncryptedSecretKey esk _) tunables = do 
	shares <- SS.encode
		(neededObjects $ shareParams tunables)
		(totalObjects $ shareParams tunables)
		(BL.fromStrict esk)
	return $ map (\(n, share) -> Share n (StorableObject $ encodeShare share))
		(zip [1..] shares)

combineShares :: Tunables -> [Share] -> Either String EncryptedSecretKey
combineShares tunables shares
	| null shares =
		Left "No shares could be downloaded. Perhaps you entered the wrong name or password?"
	| length shares < neededObjects (shareParams tunables) = 
		Left "Not enough shares are currently available to reconstruct your data."
	| otherwise = Right $ mk $ SS.decode $ map decodeshare shares
  where
	mk b = EncryptedSecretKey (BL.toStrict b) unknownCostCalc
	decodeshare (Share sharenum so) = decodeShare sharenum sharesneeded $
		fromStorableObject so
	sharesneeded = neededObjects $ shareParams tunables

-- | This efficient encoding relies on the share using a finite field of
-- size 256, so it maps directly to bytes.
--
-- Note that this does not include the share number in the encoded
-- bytestring. This prevents an attacker from partitioning their shares
-- by share number.
encodeShare :: SS.Share -> B.ByteString
encodeShare = B.pack . map (fromIntegral . SS.shareValue) . SS.theShare

decodeShare :: Int -> Int -> B.ByteString -> SS.Share
decodeShare sharenum sharesneeded = SS.Share . map mk . B.unpack
  where
	mk w = SS.ByteShare
		{ SS.shareId = sharenum
		, SS.reconstructionThreshold = sharesneeded
		, SS.shareValue = fromIntegral w
		}