{-# LANGUAGE OverloadedStrings, MultiParamTypeClasses #-}

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

module Shard 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

data ShardIdents = ShardIdents
	{ getIdents :: [StorableObjectIdent]
	, identsCreationCost :: Cost CreationOp
	, identsBruteForceCalc :: CostCalc BruteForceOp UnknownName
	}

instance Bruteforceable ShardIdents UnknownName where
	getBruteCostCalc = identsBruteForceCalc

-- | Generates identifiers to use for storing shards.
--
-- This is an expensive operation, to make it difficult for an attacker
-- to brute force known/guessed names and find matching shards.
-- The keyid is used as a salt, both to avoid collisions when the same
-- name is chosen for multiple keys, and to prevent the attacker
-- from using a rainbow table from names to expensivehashes.
shardIdents :: Tunables -> Name -> KeyId -> ShardIdents
shardIdents tunables (Name name) keyid =
	ShardIdents idents creationcost bruteforcecalc
  where
	(ExpensiveHash creationcost basename) =
		expensiveHash tunables (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..totalObjects (head (shardParams tunables))]
	bruteforcecalc = bruteForceLinearSearch creationcost

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

-- Throws AssertionFailed if the number of shares is too small.
combineShards :: Tunables -> [Shard] -> EncryptedSecretKey
combineShards tunables = mk . SS.decode . map decodeshard
  where
	mk b = EncryptedSecretKey (BL.toStrict b) unknownCostCalc
	decodeshard (Shard sharenum so) = decodeShare sharenum sharesneeded $
		fromStorableObject so
	sharesneeded = neededObjects $ head $ shardParams 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 shards
-- 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
		}