keysafe 0.20160819 → 0.20160831
raw patch · 25 files changed
+912/−300 lines, 25 filesdep +aesondep +http-clientdep +networkdep −dice-entropy-conduitdep −finite-fielddep −polynomialdep ~binary
Dependencies added: aeson, http-client, network, secret-sharing, servant, servant-client, servant-server, socks, stm, transformers, wai, warp
Dependencies removed: dice-entropy-conduit, finite-field, polynomial, vector
Dependency ranges changed: binary
Files
- CHANGELOG +19/−0
- CmdLine.hs +44/−6
- Cost.hs +41/−6
- Crypto/SecretSharing/Internal.hs +0/−152
- ExpensiveHash.hs +35/−11
- Gpg.hs +13/−7
- HTTP.hs +93/−0
- HTTP/Client.hs +23/−0
- HTTP/Server.hs +105/−0
- INSTALL +43/−0
- Makefile +32/−0
- Share.hs +22/−7
- Storage.hs +9/−9
- Storage/Local.hs +39/−29
- Storage/Network.hs +93/−7
- TODO +31/−5
- Tests.hs +143/−0
- Tunables.hs +26/−14
- Types.hs +4/−2
- Types/Cost.hs +11/−15
- Types/Storage.hs +14/−3
- keysafe.cabal +22/−12
- keysafe.desktop +8/−0
- keysafe.hs +27/−15
- keysafe.service +15/−0
CHANGELOG view
@@ -1,3 +1,22 @@+keysafe (0.20160831) unstable; urgency=medium++ * Server implementation is ready for initial deployment.+ * Keysafe as a client is not yet ready for production use.+ * Removed embedded copy of secret-sharing library, since finite-field+ only supports prime fields. This caused shares to be twice the size of+ the input value.+ * Reduced chunk size to 32kb due to share size doubling.+ * Fix gpg secret key list parser to support gpg 2.+ * Tuned argon2 hash parameters on better hardware than my fanless laptop.+ * Improve time estimates, taking into account the number of cores.+ * Added basic test suite.+ * Added options: --store-directory --test --port --address+ * Added a Makefile+ * Added a systemd service file.+ * Added a desktop file.++ -- Joey Hess <id@joeyh.name> Wed, 31 Aug 2016 15:43:30 -0400+ keysafe (0.20160819) unstable; urgency=medium * First release of keysafe. This is not yet ready for production use.
CmdLine.hs view
@@ -6,32 +6,43 @@ module CmdLine where import Types+import Types.Storage import Tunables import qualified Gpg import Options.Applicative import qualified Data.ByteString.UTF8 as BU8 import System.Directory+import Network.Wai.Handler.Warp (Port) data CmdLine = CmdLine { mode :: Maybe Mode , secretkeysource :: Maybe SecretKeySource , localstorage :: Bool+ , localstoragedirectory :: Maybe LocalStorageDirectory , gui :: Bool , testMode :: Bool , customShareParams :: Maybe ShareParams+ , serverConfig :: ServerConfig } -data Mode = Backup | Restore | UploadQueued | Benchmark+data Mode = Backup | Restore | UploadQueued | Server | Benchmark | Test deriving (Show) +data ServerConfig = ServerConfig+ { serverPort :: Port+ , serverAddress :: String+ }+ parse :: Parser CmdLine parse = CmdLine- <$> optional (backup <|> restore <|> uploadqueued <|> benchmark)+ <$> optional (backup <|> restore <|> uploadqueued <|> server <|> benchmark <|> test) <*> optional (gpgswitch <|> fileswitch) <*> localstorageswitch+ <*> localstoragedirectory <*> guiswitch <*> testmodeswitch <*> optional (ShareParams <$> totalobjects <*> neededobjects)+ <*> serverconfig where backup = flag' Backup ( long "backup"@@ -45,10 +56,18 @@ ( long "uploadqueued" <> help "Upload any data to servers that was queued by a previous --backup run." )+ server = flag' Server+ ( long "server"+ <> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/"+ ) benchmark = flag' Benchmark ( long "benchmark" <> help "Benchmark speed of keysafe's cryptographic primitives." )+ test = flag' Test+ ( long "test"+ <> help "Run test suite."+ ) gpgswitch = GpgKey . KeyId . BU8.fromString <$> strOption ( long "gpgkeyid" <> metavar "KEYID"@@ -61,8 +80,13 @@ ) localstorageswitch = switch ( long "store-local"- <> help "Store data locally, in ~/.keysafe/objects/local/. (The default is to store data in the cloud.)"+ <> help "Store data locally. (The default is to store data in the cloud.)" )+ localstoragedirectory = optional $ LocalStorageDirectory <$> option str+ ( long "store-directory"+ <> metavar "DIR"+ <> help "Where to store data locally. (default: ~/.keysafe/objects/)"+ ) testmodeswitch = switch ( long "testmode" <> help "Avoid using expensive cryptographic operations to secure data. Use for testing only, not with real secret keys."@@ -74,14 +98,28 @@ totalobjects = option auto ( long "totalshares" <> metavar "M"- <> help ("Configure the number of shares to split encrypted secret key into. Default: " ++ show (totalObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)")+ <> help ("Configure the number of shares to split encrypted secret key into. (default: " ++ show (totalObjects (shareParams defaultTunables)) ++ ") (When this option is used to back up a key, it must also be provided at restore time.)") ) neededobjects = option auto ( long "neededshares" <> metavar "N"- <> help ("Configure the number of shares needed to restore. Default: " ++ show (neededObjects (shareParams defaultTunables)) ++ " (When this option is used to back up a key, it must also be provided at restore time.)")+ <> help ("Configure the number of shares needed to restore. (default: " ++ show (neededObjects (shareParams defaultTunables)) ++ ") (When this option is used to back up a key, it must also be provided at restore time.)") )-+ serverconfig = ServerConfig+ <$> option auto+ ( long "port"+ <> metavar "P"+ <> value 80+ <> showDefault+ <> help "Port for server to listen on."+ )+ <*> option str+ ( long "address"+ <> metavar "A"+ <> value "127.0.0.1"+ <> showDefault+ <> help "Address for server to bind to. (Use \"*\" to bind to all addresses.)"+ ) get :: IO CmdLine get = execParser opts where
Cost.hs view
@@ -11,19 +11,36 @@ ) where import Types.Cost+import Data.List+import Data.Maybe+import Text.Read -- | Cost in seconds, with the type of hardware needed. totalCost :: Cost op -> (Seconds, [UsingHardware])-totalCost (CPUCost s) = (s, [UsingCPU])+totalCost (CPUCost s _) = (s, [UsingCPU]) raiseCostPower :: Cost c -> Entropy e -> Cost c-raiseCostPower c (Entropy e) = adjustCost c (* 2^e)+raiseCostPower c (Entropy e) = mapCost (* 2^e) c -adjustCost :: Cost c -> (Seconds -> Seconds) -> Cost c-adjustCost (CPUCost s) f = CPUCost (f s)+mapCost :: (Integer -> Integer) -> Cost op -> Cost op+mapCost f (CPUCost (Seconds n) d) = CPUCost (Seconds (f n)) d +type NumCores = Integer++showCostMinutes :: NumCores -> Cost op -> String+showCostMinutes numcores (CPUCost (Seconds n) (Divisibility d))+ | n' < 61 = "1 minute"+ | otherwise = show (n' `div` 60) ++ " minutes"+ where+ n' = n `div` min numcores d++-- If an operation took n seconds on a number of cores,+-- multiply to get the CPUCost, which is for a single core.+coreCost :: NumCores -> Seconds -> Divisibility -> Cost op+coreCost cores (Seconds n) d = CPUCost (Seconds (cores * n)) d+ castCost :: Cost a -> Cost b-castCost (CPUCost s) = CPUCost s+castCost (CPUCost s d) = CPUCost s d -- | CostCalc for a brute force linear search through an entropy space -- in which each step entails paying a cost.@@ -40,6 +57,10 @@ data DataCenterPrice = DataCenterPrice { instanceCpuCores :: Integer+ , instanceCpuCoreMultiplier :: Integer+ -- ^ If the cores are twice as fast as the commodity hardware+ -- that keysafe's cost estimates are based on, use 2 to indicate+ -- this, etc. , instanceCostPerHour :: Cents } @@ -47,6 +68,7 @@ spotAWS :: DataCenterPrice spotAWS = DataCenterPrice { instanceCpuCores = 36+ , instanceCpuCoreMultiplier = 2 , instanceCostPerHour = Cents 33 } @@ -63,7 +85,7 @@ cpuyears = cpuseconds `div` (60*60*24*365) costpercpuyear = Cents $ fromIntegral (instanceCostPerHour dc) * 24 * 365- `div` instanceCpuCores dc+ `div` (instanceCpuCores dc * instanceCpuCoreMultiplier dc) costcents = Cents cpuyears * costpercpuyear newtype Cents = Cents Integer@@ -112,3 +134,16 @@ in if yprev < y - 1 then go (s:" ...":t) y ys else go (s:t) y ys++-- Number of physical cores. This is not the same as+-- getNumProcessors, which includes hyper-threading.+getNumCores :: IO (Maybe NumCores)+getNumCores = getmax . mapMaybe parse . lines <$> readFile "/proc/cpuinfo"+ where+ getmax [] = Nothing+ getmax l = Just $+ maximum l + 1 -- add 1 because /proc/cpuinfo counts from 0+ parse l+ | "core id" `isPrefixOf` l =+ readMaybe $ drop 1 $ dropWhile (/= ':') l+ | otherwise = Nothing
− Crypto/SecretSharing/Internal.hs
@@ -1,152 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, GeneralizedNewtypeDeriving, TemplateHaskell #-} --------------------------------------------------------------------------------- |--- Module : Crypto.SecretSharing.Internal--- Copyright : Peter Robinson 2014--- License : LGPL--- --- Maintainer : Peter Robinson <peter.robinson@monoid.at>--- Stability : experimental--- Portability : portable--- --------------------------------------------------------------------------------module Crypto.SecretSharing.Internal-where-import Math.Polynomial.Interpolation--import Data.ByteString.Lazy( ByteString )-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BLC-import qualified Data.List as L-import Data.Char-import Data.Vector( Vector )-import qualified Data.Vector as V-import Data.Typeable-import Control.Exception-import Control.Monad-import Data.Binary( Binary )-import GHC.Generics-import Data.FiniteField.PrimeField as PF-import Data.FiniteField.Base(FiniteField,order)-import System.Random.Dice------ | A share of an encoded byte. -data ByteShare = ByteShare - { shareId :: !Int -- ^ the index of this share - , reconstructionThreshold :: !Int -- ^ number of shares required for - -- reconstruction- , shareValue :: !Int -- ^ the value of p(shareId) where p(x) is the - -- generated (secret) polynomial- }- deriving(Typeable,Eq,Generic)--instance Show ByteShare where- show = show . shareValue ---- | A share of the encoded secret.-data Share = Share - { theShare :: ![ByteShare] }- deriving(Typeable,Eq,Generic)--instance Show Share where- show s = show (shareId $ head $ theShare s,BLC.pack $ map (chr . shareValue) $ theShare s)--instance Binary ByteShare-instance Binary Share---- | Encodes a 'ByteString' as a list of n shares, m of which are required for--- reconstruction.--- Lives in the 'IO' to access a random source.-encode :: Int -- ^ m - -> Int -- ^ n- -> ByteString -- ^ the secret that we want to share- -> IO [Share] -- a list of n-shares (per byte) -encode m n bstr - | n >= prime || m > n = throw $ AssertionFailed $ - "encode: require n < " ++ show prime ++ " and m<=n."- | BL.null bstr = return []- | otherwise = do- let len = max 1 ((fromIntegral $ BL.length bstr) * (m-1))- coeffs <- (groupInto (m-1) . map fromIntegral . take len ) - `liftM` (getDiceRolls prime len)- let byteVecs = zipWith (encodeByte m n) coeffs $- map fromIntegral $ BL.unpack bstr - return [ Share $ map (V.! (i-1)) byteVecs | i <- [1..n] ]----- | Reconstructs a (secret) bytestring from a list of (at least @m@) shares. --- Throws 'AssertionFailed' if the number of shares is too small.-decode :: [Share] -- ^ list of at least @m@ shares- -> ByteString -- ^ reconstructed secret-decode [] = BL.pack []-decode shares@((Share s):_) - | length shares < reconstructionThreshold (head s) = throw $ AssertionFailed - "decode: not enough shares for reconstruction."- | otherwise =- let origLength = length s in- let byteVecs = map (V.fromList . theShare) shares in- let byteShares = [ map ((V.! (i-1))) byteVecs | i <- [1..origLength] ] in- BL.pack . map (fromInteger . PF.toInteger . number) - . map decodeByte $ byteShares- --encodeByte :: Int -> Int -> Polyn -> FField -> Vector ByteShare-encodeByte m n coeffs secret = - V.fromList[ ByteShare i m $ fromInteger . PF.toInteger . number $ - evalPolynomial (secret:coeffs) (fromIntegral i::FField) - | i <- [1..n] - ]---decodeByte :: [ByteShare] -> FField-decodeByte ss =- let m = reconstructionThreshold $ head ss in- if length ss < m- then throw $ AssertionFailed "decodeByte: insufficient number of shares for reconstruction!"- else- let shares = take m ss - pts = map (\s -> (fromIntegral $ shareId s,fromIntegral $ shareValue s)) - shares - in- polyInterp pts 0----- | Groups a list into blocks of certain size. Running time: /O(n)/-groupInto :: Int -> [a] -> [[a]]-groupInto num as- | num < 0 = throw $ AssertionFailed "groupInto: Need positive number as argument."- | otherwise = - let (fs,ss) = L.splitAt num as in- if L.null ss - then [fs]- else fs : groupInto num ss ----- | A finite prime field. All computations are performed in this field.------ This is modified from the secret-sharing library to use 256--- instead of 1021. That allows values in the field to be efficiently--- packed into bytes. It's beleived that the finite field can be a power of--- a prime number (in this case, 2).-newtype FField = FField { number :: $(primeField $ fromIntegral (256 :: Integer)) }- deriving(Show,Read,Ord,Eq,Num,Fractional,Generic,Typeable,FiniteField)- ---- | The size of the finite field-prime :: Int-prime = fromInteger $ order (0 :: FField)----- | A polynomial over the finite field given as a list of coefficients.-type Polyn = [FField] ---- | Evaluates the polynomial at a given point.-evalPolynomial :: Polyn -> FField -> FField-evalPolynomial coeffs x =- foldr (\c res -> c + (x * res)) 0 coeffs--- let clist = zipWith (\pow c -> (\x -> c * (x^pow))) [0..] coeffs --- in L.foldl' (+) 0 [ c x | c <- clist ]-
ExpensiveHash.hs view
@@ -13,12 +13,14 @@ import Serialization () import qualified Data.Text as T import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BU8 import qualified Crypto.Argon2 as Argon2 import Raaz.Core.Encode import Data.Time.Clock import Control.DeepSeq import Control.Monad import Data.Monoid+import Data.Maybe -- | A hash that is expensive to calculate. --@@ -46,18 +48,29 @@ in sb <> B.replicate (8 - B.length sb ) 32 benchmarkExpensiveHash :: Int -> ExpensiveHashTunable -> Cost op -> IO (BenchmarkResult (Cost op))-benchmarkExpensiveHash rounds tunables expected = do+benchmarkExpensiveHash rounds tunables@(UseArgon2 _ hashopts) expected = do+ numcores <- fromIntegral . fromMaybe (error "Unknown number of physical cores.") + <$> getNumCores start <- getCurrentTime- forM_ [1..rounds] $ \_ -> do+ forM_ [1..rounds] $ \n -> do+ -- Must vary the data being hashed to avoid laziness+ -- caching hash results.+ let base = BU8.fromString (show n) let ExpensiveHash _ t = expensiveHash tunables- (Salt (GpgKey (KeyId ("dummy" :: B.ByteString))))- ("himom" :: B.ByteString)+ (Salt (GpgKey (KeyId (base <> "dummy"))))+ (base <> "himom") t `deepseq` return () end <- getCurrentTime let diff = floor $ end `diffUTCTime` start- let actual = CPUCost $ Seconds diff+ let maxthreads = Argon2.hashParallelism hashopts+ let actual = CPUCost (Seconds diff) (Divisibility $ fromIntegral maxthreads)+ -- The expected cost is for a single core, so adjust it+ -- based on the number of cores, up to a maximum of the number+ -- of threads that the hash is configred to use.+ let usedcores = min maxthreads numcores+ let adjustedexpected = mapCost (`div` fromIntegral usedcores) expected return $ BenchmarkResult- { expectedBenchmark = expected+ { expectedBenchmark = adjustedexpected , actualBenchmark = actual } @@ -65,12 +78,23 @@ benchmarkTunables tunables = do putStrLn "/proc/cpuinfo:" putStrLn =<< readFile "/proc/cpuinfo"- putStrLn "Note that expected times are for 1 core machine."- putStrLn "If this machine has 2 cores, the actual times should be half the expected times."- putStrLn "Benchmarking 16 rounds of key generation hash..."- print =<< benchmarkExpensiveHash 16+ + -- Rather than run all 256 rounds of this hash, which would+ -- probably take on the order of 1 hour, run only 16, and scale+ -- the expected cost accordingly.+ let normalrounds = fromIntegral $ + 256 * randomSaltBytes (keyEncryptionKeyTunable tunables)+ putStrLn $ "Benchmarking 16/" ++ show normalrounds ++ " rounds of key encryption key hash..."+ r <- benchmarkExpensiveHash 16 (keyEncryptionKeyHash $ keyEncryptionKeyTunable tunables)- (mapCost (`div` 16) $ randomSaltBytesBruteForceCost $ keyEncryptionKeyTunable tunables)+ (mapCost (`div` (normalrounds `div` 16)) $ randomSaltBytesBruteForceCost $ keyEncryptionKeyTunable tunables)+ print r+ putStrLn $ "Estimated time for " ++ show normalrounds ++ " rounds of key encryption key hash..."+ print $ BenchmarkResult+ { expectedBenchmark = mapCost (* 16) (expectedBenchmark r)+ , actualBenchmark = mapCost (* 16) (actualBenchmark r)+ }+ putStrLn "Benchmarking 1 round of name generation hash..." print =<< benchmarkExpensiveHash 1 (nameGenerationHash $ nameGenerationTunable tunables)
Gpg.hs view
@@ -11,7 +11,6 @@ import UI import System.Process import Data.List.Split-import Data.Maybe import System.IO import System.Exit import qualified Data.ByteString as B@@ -37,13 +36,20 @@ anyKey = GpgKey (KeyId "") listSecretKeys :: IO [(Name, KeyId)]-listSecretKeys = mapMaybe parse . lines <$> readProcess "gpg"- ["--batch", "--with-colons", "--list-secret-keys"] ""+listSecretKeys = map mk . parse . lines <$> readProcess "gpg"+ ["--batch", "--with-colons", "--list-secret-keys", "--fixed-list-mode"] "" where- parse l = case splitOn ":" l of- ("sec":_:_:_:kid:_:_:_:_:n:_) -> Just - (Name (BU8.fromString n), KeyId (BU8.fromString kid))- _ -> Nothing+ parse = extract [] Nothing . map (splitOn ":")+ extract c (Just keyid) (("uid":_:_:_:_:_:_:_:_:userid:_):rest) =+ extract ((userid, keyid):c) Nothing rest+ extract c (Just keyid) rest =+ extract (("", keyid):c) Nothing rest+ extract c _ [] = c+ extract c _ (("sec":_:_:_:keyid:_):rest) =+ extract c (Just keyid) rest+ extract c k (_:rest) =+ extract c k rest+ mk (userid, keyid) = (Name (BU8.fromString userid), KeyId (BU8.fromString keyid)) getSecretKey :: KeyId -> IO SecretKey getSecretKey (KeyId kid) = do
+ HTTP.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module HTTP where++import Types+import Types.Storage+import Serialization ()+import Servant.API+import Data.Text+import Data.Aeson.Types+import GHC.Generics hiding (V1)+import qualified Data.Text.Encoding as T+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Raaz.Core.Encode as Raaz++-- | Keysafe's http API+type HttpAPI = + "keysafe" :> V1 :> "motd" :> Get '[JSON] Motd+ :<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam+ :> Get '[JSON] (ProofOfWorkRequirement StorableObject)+ :<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam+ :> ReqBody '[OctetStream] StorableObject+ :> Put '[JSON] (ProofOfWorkRequirement StoreResult)+ :<|> "keysafe" :> V1 :> "stats" :> "countobjects" :> POWParam+ :> Get '[JSON] (ProofOfWorkRequirement CountResult)++type V1 = "v1"++newtype Motd = Motd Text+ deriving (Generic)++data ProofOfWorkRequirement t+ = Result t+ | ProofOfWorkRequirement+ { leadingZeros :: Int+ , argon2Iterations :: Int+ }+ deriving (Generic)++newtype ProofOfWork = ProofOfWork Text++type POWParam = QueryParam "proofofwork" ProofOfWork++type ObjectIdent = Capture "ident" StorableObjectIdent++instance ToJSON Motd+instance FromJSON Motd+instance ToJSON t => ToJSON (ProofOfWorkRequirement t)+instance FromJSON t => FromJSON (ProofOfWorkRequirement t)++instance FromHttpApiData ProofOfWork where+ parseUrlPiece = Right . ProofOfWork+instance ToHttpApiData ProofOfWork where+ toUrlPiece (ProofOfWork t) = t++-- StorableObjectIdent contains a hash, which is valid UTF-8.+instance ToHttpApiData StorableObjectIdent where+ toUrlPiece (StorableObjectIdent b) = T.decodeUtf8 b+instance FromHttpApiData StorableObjectIdent where+ parseUrlPiece = Right . StorableObjectIdent . T.encodeUtf8++instance MimeRender OctetStream StorableObject where+ mimeRender _ = L.fromStrict . Raaz.toByteString+instance MimeUnrender OctetStream StorableObject where+ mimeUnrender _ = maybe (Left "object encoding error") Right + . Raaz.fromByteString . L.toStrict++-- StorableObject contains an arbitrary bytestring; it is not UTF-8 encoded.+-- So, to convert it to Text for Aeson, base64 encode it.+instance ToJSON StorableObject where+ toJSON (StorableObject b) = object [ "data" .= b64 b ]+instance FromJSON StorableObject where+ parseJSON (Object v) = StorableObject <$> (unb64 =<< v .: "data")+ parseJSON invalid = typeMismatch "StorableObject" invalid++b64 :: B.ByteString -> Text+b64 v = T.decodeUtf8 $ Raaz.toByteString (Raaz.encode v :: Raaz.Base64)++unb64 :: Monad m => Text -> m B.ByteString+unb64 t = maybe (fail "bad base64 data") (return . Raaz.decodeFormat) f+ where+ f = Raaz.fromByteString (T.encodeUtf8 t) :: Maybe Raaz.Base64
+ HTTP/Client.hs view
@@ -0,0 +1,23 @@+{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module HTTP.Client where++import HTTP+import Types+import Types.Storage+import Servant.API+import Servant.Client+import Data.Proxy+import Network.HTTP.Client (Manager)++httpAPI :: Proxy HttpAPI+httpAPI = Proxy++motd :: Manager -> BaseUrl -> ClientM Motd+getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (ProofOfWorkRequirement StorableObject)+putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Manager -> BaseUrl -> ClientM (ProofOfWorkRequirement StoreResult)+countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (ProofOfWorkRequirement CountResult)+motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI
+ HTTP/Server.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module HTTP.Server (runServer) where++import HTTP+import Types+import Types.Storage+import Tunables+import Storage.Local+import Serialization ()+import Servant+import Network.Wai+import Network.Wai.Handler.Warp+import Control.Monad.IO.Class+import Control.Concurrent+import Control.Concurrent.STM+import Data.String+import qualified Data.ByteString as B++data ServerState = ServerState+ { obscurerRequest :: TMVar ()+ , storageDirectory :: Maybe LocalStorageDirectory+ }++newServerState :: Maybe LocalStorageDirectory -> IO ServerState+newServerState d = ServerState+ <$> newEmptyTMVarIO+ <*> pure d++runServer :: Maybe LocalStorageDirectory -> String -> Port -> IO ()+runServer d bindaddress port = do+ st <- newServerState d+ _ <- forkIO $ obscurerThread st+ runSettings settings (app st)+ where+ settings = setHost host $ setPort port $ defaultSettings + host = fromString bindaddress++serverStorage :: ServerState -> Storage+serverStorage st = localStorage (storageDir $ storageDirectory st) "server"++app :: ServerState -> Application+app st = serve userAPI (server st)++userAPI :: Proxy HttpAPI+userAPI = Proxy++server :: ServerState -> Server HttpAPI+server st = motd+ :<|> getObject st+ :<|> putObject st+ :<|> countObjects st++motd :: Handler Motd+motd = return $ Motd "Hello World!"++getObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)+getObject st i _pow = do+ r <- liftIO $ retrieveShare (serverStorage st) dummyShareNum i+ liftIO $ requestObscure st+ case r of+ RetrieveSuccess (Share _n o) -> return $ Result o+ RetrieveFailure _ -> throwError err404++putObject :: ServerState -> StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (ProofOfWorkRequirement StoreResult)+putObject st i _pow o = do+ if validObjectsize o+ then do+ r <- liftIO $ storeShare (serverStorage st) i (Share dummyShareNum o)+ liftIO $ requestObscure st+ return $ Result r+ else return $ Result $ StoreFailure "invalid object size"++validObjectsize :: StorableObject -> Bool+validObjectsize o = any (sz ==) knownObjectSizes+ where+ sz = B.length (fromStorableObject o)++countObjects :: ServerState -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)+countObjects st _pow = liftIO $ Result <$> countShares (serverStorage st)++-- | 1 is a dummy value; the server does not know the actual share numbers.+dummyShareNum :: ShareNum+dummyShareNum = 1++-- | This thread handles obscuring the shares after put and get operations.+-- Since obscuring can be an expensive process when there are many shares,+-- the thread runs a maximum of once per half-hour.+obscurerThread :: ServerState -> IO ()+obscurerThread st = do+ _ <- obscureShares (serverStorage st)+ putStrLn "obscured shares"+ threadDelay (1000000*60*30)+ _ <- atomically $ takeTMVar (obscurerRequest st)+ obscurerThread st++requestObscure :: ServerState -> IO ()+requestObscure st = do+ _ <- atomically $ tryPutTMVar (obscurerRequest st) ()+ return ()
+ INSTALL view
@@ -0,0 +1,43 @@+## Quick installation++This installs keysafe to ~/.local/bin, and is sufficient to use keysafe+to back up or restore your private key.++First install Haskell's stack tool, the zlib, g++, readline and argon2+libraries, and zenity. For example, on a Debian system:++ sudo apt-get install haskell-stack \+ zlib1g-dev g++ libreadline-dev libargon2-0-dev zenity++Then to build and install keysafe, run this in the keysafe directory:++ stack install++Note that there is a manpage, but stack doesn't install it yet.++## System-wide installation++This installs keysafe in /usr/bin, and includes the man page, +desktop file, systemd service file, etc.++Start by installing the dependencies as shown in Quick installation.++Then, in the keysafe directory:++ make+ sudo make install++## Packaging++You will probably want to use the Makefile.+Set PREFIX to install to a different location.+Set BUILDER=cabal to use cabal rather than the default stack to build.++The make install target creates a keysafe user. Use the install-files+target to avoid doing that at package build time. You may create the+keysafe user at package install time instead, although it is only used+by the keysafe server.++While keysafe ships with a systemd service file, distributions should +not enable it to be started by default. (Or can put it in its own+keysafe-server package.)
+ Makefile view
@@ -0,0 +1,32 @@+PREFIX?=+# Can be stack or cabal+BUILDER?=stack++build: keysafe++keysafe:+ $(BUILDER) build+ if [ "$(BUILDER)" = stack ]; then \+ ln -sf $$(find .stack-work/ -name keysafe -type f | grep build/keysafe/keysafe | tail -n 1) keysafe; \+ else \+ ln -sf dist/build/keysafe/keysafe keysafe; \+ fi++clean:+ rm -rf keysafe dist .stack-work++install: install-files+ useradd --system keysafe+ chmod 700 $(PREFIX)/var/lib/keysafe+ chown keysafe:keysafe $(PREFIX)/var/lib/keysafe++install-files: keysafe+ install -d $(PREFIX)/var/lib/keysafe+ install -d $(PREFIX)/usr/bin+ install -s -m 0755 keysafe $(PREFIX)/usr/bin/keysafe+ install -d $(PREFIX)/usr/share/man/man1+ install -m 0644 keysafe.1 $(PREFIX)/usr/share/man/man1/keysafe.1+ install -d $(PREFIX)/lib/systemd/system+ install -m 0644 keysafe.service $(PREFIX)/lib/systemd/system/keysafe.service+ install -d $(PREFIX)/usr/share/applications/+ install -m 0644 keysafe.desktop $(PREFIX)/usr/share/applications/keysafe.desktop
@@ -19,6 +19,7 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified Data.Set as S+import Data.Word import Data.Monoid data ShareIdents = ShareIdents@@ -92,20 +93,34 @@ 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+encodeShare = B.pack . concatMap (encodeShare' . SS.shareValue) . SS.theShare decodeShare :: Int -> Int -> B.ByteString -> SS.Share-decodeShare sharenum sharesneeded = SS.Share . map mk . B.unpack+decodeShare sharenum sharesneeded = SS.Share . map mk . decodeShare' . B.unpack where- mk w = SS.ByteShare+ mk v = SS.ByteShare { SS.shareId = sharenum , SS.reconstructionThreshold = sharesneeded- , SS.shareValue = fromIntegral w+ , SS.shareValue = v }++-- | Each input byte generates a share in a finite field of size 1021,+-- so encode it as the product of two bytes. This is inneffient; if the+-- finite field was 255 then the encoded share would be the same size as+-- the input. But, the finite-field library used by secret-sharing does+-- not support a non-prime size.+encodeShare' :: Int -> [Word8]+encodeShare' v =+ let (q, r) = quotRem v 255+ in [fromIntegral q, fromIntegral r]++decodeShare' :: [Word8] -> [Int]+decodeShare' = go []+ where+ go c [] = reverse c+ go c (q:r:rest) = go (((255 * fromIntegral q) + fromIntegral r):c) rest+ go _ _ = error "Badly encoded share has odd number of bytes"
Storage.hs view
@@ -16,15 +16,15 @@ import Control.Monad import qualified Data.Set as S -allStorageLocations :: IO StorageLocations-allStorageLocations = do+allStorageLocations :: Maybe LocalStorageDirectory -> IO StorageLocations+allStorageLocations d = do servers <- networkServers return $ StorageLocations $- map networkStorage servers <> map uploadQueue servers+ map networkStorage servers <> map (uploadQueue d) servers -localStorageLocations :: StorageLocations-localStorageLocations = StorageLocations $- map (localStorage . ("local" </>) . show)+localStorageLocations :: Maybe LocalStorageDirectory -> StorageLocations+localStorageLocations d = StorageLocations $+ map (localStorage (storageDir d) . ("local" </>) . show) [1..100 :: Int] type UpdateProgress = IO ()@@ -99,7 +99,7 @@ -- all of them. go (unusedlocs++[loc]) usedlocs' rest shares' -uploadQueued :: IO ()-uploadQueued = do+uploadQueued :: Maybe LocalStorageDirectory -> IO ()+uploadQueued d = do servers <- networkServers- forM_ servers $ \s -> moveShares (uploadQueue s) (networkStorage s)+ forM_ servers $ \s -> moveShares (uploadQueue d s) (networkStorage s)
Storage/Local.hs view
@@ -3,7 +3,7 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Storage.Local (localStorage, uploadQueue) where+module Storage.Local (localStorage, storageDir, testStorageDir, uploadQueue) where import Types import Types.Storage@@ -23,25 +23,27 @@ import Control.Exception import Control.Monad +type GetShareDir = Section -> IO FilePath+ newtype Section = Section String -localStorage :: String -> Storage-localStorage n = Storage- { storeShare = store section- , retrieveShare = retrieve section- , obscureShares = obscure section- , countShares = count section- , moveShares = move section+localStorage :: GetShareDir -> String -> Storage+localStorage getsharedir n = Storage+ { storeShare = store section getsharedir+ , retrieveShare = retrieve section getsharedir+ , obscureShares = obscure section getsharedir+ , countShares = count section getsharedir+ , moveShares = move section getsharedir } where section = Section n -uploadQueue :: Server -> Storage-uploadQueue s = localStorage ("uploadqueue" </> serverName s)+uploadQueue :: Maybe LocalStorageDirectory -> Server -> Storage+uploadQueue d s = localStorage (storageDir d) ("uploadqueue" </> serverName s) -store :: Section -> StorableObjectIdent -> Share -> IO StoreResult-store section i s = onError (StoreFailure . show) $ do- dir <- shareDir section+store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult+store section getsharedir i s = onError (StoreFailure . show) $ do+ dir <- getsharedir section createDirectoryIfMissing True dir let dest = dir </> shareFile i exists <- doesFileExist dest@@ -57,9 +59,9 @@ renameFile tmp dest return StoreSuccess -retrieve :: Section -> ShareNum -> StorableObjectIdent -> IO RetrieveResult-retrieve section n i = onError (RetrieveFailure . show) $ do- dir <- shareDir section+retrieve :: Section -> GetShareDir -> ShareNum -> StorableObjectIdent -> IO RetrieveResult+retrieve section getsharedir n i = onError (RetrieveFailure . show) $ do+ dir <- getsharedir section fd <- openFd (dir </> shareFile i) ReadOnly Nothing defaultFileFlags h <- fdToHandle fd b <- B.hGetContents h@@ -75,22 +77,22 @@ -- -- Note that the contents of shares is never changed, so it's ok to set the -- mtime to the epoch; backup programs won't be confused.-obscure :: Section -> IO ObscureResult-obscure section = onError (ObscureFailure . show) $ do- dir <- shareDir section+obscure :: Section -> GetShareDir -> IO ObscureResult+obscure section getsharedir = onError (ObscureFailure . show) $ do+ dir <- getsharedir section fs <- filter isShareFile <$> getDirectoryContents dir mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs return ObscureSuccess -count :: Section -> IO CountResult-count section = onError (CountFailure . show) $ do- dir <- shareDir section+count :: Section -> GetShareDir -> IO CountResult+count section getsharedir = onError (CountFailure . show) $ do+ dir <- getsharedir section CountResult . genericLength . filter isShareFile <$> getDirectoryContents dir -move :: Section -> Storage -> IO ()-move section storage = do- dir <- shareDir section+move :: Section -> GetShareDir -> Storage -> IO ()+move section getsharedir storage = do+ dir <- getsharedir section fs <- getDirectoryContents dir forM_ fs $ \f -> case fromShareFile f of Nothing -> return ()@@ -99,7 +101,7 @@ -- matter because we're not going to be -- recombining the share, just sending its contents -- on the the server.- r <- retrieve section 0 i+ r <- retrieve section getsharedir 0 i case r of RetrieveFailure _ -> return () RetrieveSuccess share -> do@@ -115,13 +117,21 @@ Left e -> f e Right r -> r -shareDir :: Section -> IO FilePath-shareDir (Section section) = do+storageDir :: Maybe LocalStorageDirectory -> GetShareDir+storageDir Nothing (Section section) = do u <- getUserEntryForID =<< getEffectiveUserID return $ homeDirectory u </> dotdir </> section+storageDir (Just (LocalStorageDirectory d)) (Section section) =+ pure $ d </> section +testStorageDir :: FilePath -> GetShareDir+testStorageDir tmpdir = storageDir (Just (LocalStorageDirectory tmpdir))++-- | The takeFileName ensures that, if the StorableObjectIdent somehow+-- contains a path (eg starts with "../" or "/"), it is not allowed+-- to point off outside the shareDir. shareFile :: StorableObjectIdent -> FilePath-shareFile i = U8.toString (toByteString i) <> ext+shareFile i = takeFileName (U8.toString (toByteString i)) <> ext fromShareFile :: FilePath -> Maybe StorableObjectIdent fromShareFile f
Storage/Network.hs view
@@ -5,15 +5,47 @@ {-# LANGUAGE OverloadedStrings #-} -module Storage.Network (Server(..), networkServers, networkStorage) where+module Storage.Network (+ Server(..),+ networkServers,+ networkStorage,+ torableManager+) where import Types import Types.Storage+import Data.List+import Data.Char+import HTTP+import HTTP.Client+import Servant.Client+import Network.Wai.Handler.Warp (Port)+import Network.HTTP.Client hiding (port, host)+import Network.HTTP.Client.Internal (Connection, makeConnection)+import Control.Monad.Trans.Except (ExceptT, runExceptT)+import qualified Network.Socket+import Network.Socket.ByteString (sendAll, recv)+import Network.Socks5+import qualified Data.ByteString.UTF8 as BU8 -newtype Server = Server { serverName :: String }+type HostName = String +data Server = Server+ { serverName :: HostName+ , serverPort :: Port+ }++serverUrl :: Server -> BaseUrl+serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) ""++-- | These can be either tor .onion addresses, or regular hostnames.+-- Using tor is highly recommended, to avoid correlation attacks. networkServers :: IO [Server]-networkServers = return [] -- none yet+networkServers = return + [ Server "localhost" 4242+ , Server "localhost" 4242+ , Server "localhost" 4242+ ] networkStorage :: Server -> Storage networkStorage server = Storage@@ -25,10 +57,14 @@ } store :: Server -> StorableObjectIdent -> Share -> IO StoreResult-store _server _i _s = return $ StoreFailure "network storage not implemented yet"+store srv i (Share _n o) = + serverRequest srv StoreFailure id $ \pow ->+ putObject i pow o retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult-retrieve _server _n _i = return $ RetrieveFailure "network storage not implemented yet"+retrieve srv n i = + serverRequest srv RetrieveFailure (RetrieveSuccess . Share n) $+ getObject i -- | Servers should automatically obscure, so do nothing. -- (Could upload chaff.)@@ -36,8 +72,58 @@ obscure _ = return ObscureSuccess count :: Server -> IO CountResult-count _server = return $ CountFailure "network storage not implemented yet"+count srv = serverRequest srv CountFailure id countObjects -- | Not needed for servers. move :: Server -> Storage -> IO ()-move _ _ = return ()+move _ _ = error "move is not implemented for servers"++serverRequest+ :: Server+ -> (String -> a)+ -> (r -> a)+ -> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (ProofOfWorkRequirement r))+ -> IO a+serverRequest srv onerr onsuccess a = + -- A new Manager is allocated for each request, rather than reusing+ -- any connection. This is a feature; it makes correlation attacks+ -- harder because the server can't tell if two connections+ -- (over tor) came from the same user.+ go Nothing =<< torableManager+ where+ url = serverUrl srv+ go pow manager = do+ res <- runExceptT $ a pow manager url+ case res of+ Left err -> return $ onerr $ + "server failure: " ++ show err+ Right (Result r) -> return $ onsuccess r+ Right needpow -> error "NEEDPOW" -- loop with pow++-- | HTTP Manager supporting tor .onion and regular hosts+torableManager :: IO Manager+torableManager = newManager $ defaultManagerSettings+ { managerRawConnection = return conn+ }+ where+ conn addr host port+ | ".onion" `isSuffixOf` map toLower host = torConnection host port+ | otherwise = do+ regular <- managerRawConnection defaultManagerSettings+ regular addr host port++torConnection :: HostName -> Port -> IO Connection+torConnection onionaddress p = do+ (socket, _) <- socksConnect torsockconf socksaddr+ socketConnection socket 8192+ where+ torsocksport = 9050+ torsockconf = defaultSocksConf "127.0.0.1" torsocksport+ socksdomain = SocksAddrDomainName (BU8.fromString onionaddress)+ socksaddr = SocksAddress socksdomain (fromIntegral p)++socketConnection :: Network.Socket.Socket -> Int -> IO Connection+socketConnection socket chunksize = makeConnection+ (recv socket chunksize)+ (sendAll socket)+ (Network.Socket.close socket)
TODO view
@@ -1,11 +1,37 @@-* test suite (eg, test basic storage and restore of various size data)-* tune hashes on more powerful hardware than thermal throttling laptop-* store to servers+Soon:++* Run a key restore and make sure it takes 35 to 50 minutes.+* client/server Proof Of Work+* Implement the different categories of servers in the server list.+* Include an example tor hidden service config+* Get some keysafe servers set up.+* Keep a local record of keys that have been backed up, and the tunables+ and password entropy. This will allow warning later if the crack estimate+ has to be revised downward for some reason, or if a server is+ compromised. * Run --uploadqueued periodically (systemd timer?)++Later:+ * improve restore progress bar points (update after every hash try)+* If we retrieved enough shares successfully, but decrypt failed, must+ be a wrong password, so prompt for re-entry and retry with those shares.+* Don't require --totalshares and --neededshares on restore when unusual+ values were used for backup. Instead, probe until enough shares are found+ to restore.+* --no-jargon which makes the UI avoid terms like "secret key" and "crack+ password". Do usability testing!+* --key-value=$N which eliminates the question about password value,+ and rejects passwords that would cost less than $N to crack at current+ rates. This should add a combo box to the password entry form in the+ GUI to let the user adjust the $N there.+* --name and --othername to allow specifying those at the command line,+ bypassing the prompts. With these and --key-value, keysafe would only+ prompt for the password.++Wishlist:+ * Keep secret keys in locked memory until they're encrypted. (Raaz makes this possible to do.) Would be nice, but not super-important, since gpg secret keys are passphrase protected anyway..-* If we retrieved enough shares successfully, but decrypt failed, must- be a wrong password, so prompt for re-entry and retry with those shares.
+ Tests.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE OverloadedStrings #-}++{- Copyright 2016 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Tests where++import Types+import Tunables+import Encryption+import Share+import Storage+import Storage.Local+import Control.Exception+import System.Directory+import System.Posix.Temp+import System.IO+import qualified Data.ByteString.UTF8 as BU8+import qualified Data.ByteString as B+import qualified Data.Set as S+import Data.Monoid++type TestDesc = B.ByteString++type TestResult = Either String ()++type Test = (TestDesc, IO TestResult)++testSuccess :: IO TestResult+testSuccess = return $ Right ()++testFailed :: String -> IO TestResult+testFailed = return . Left++runTest :: Test -> IO Bool+runTest (d, t) = do+ putStr $ "testing: " ++ show d ++ " ..."+ hFlush stdout+ r <- t+ case r of+ Right () -> do+ putStrLn "ok"+ return True+ Left e -> do+ putStrLn $ "failed: " ++ show e+ return False++runTests :: IO ()+runTests = do+ r <- mapM runTest tests+ if all (== True) r+ then putStrLn "All tests succeeded."+ else error "Tests failed. Report a bug!"++tests :: [Test]+tests = + [ backupRestoreTest "very small" $ + testSecretKey 1+ , backupRestoreTest "full size" $ + testSecretKey (objectSize testModeTunables)+ , backupRestoreTest "two chunks" $+ testSecretKey (objectSize testModeTunables + 1)+ , backupRestoreTest "many chunks" $+ testSecretKey (objectSize testModeTunables * 10)+ , stableNamingTest "stable naming"+ ]++testSecretKey :: Int -> SecretKey+testSecretKey sz = SecretKey $ BU8.fromString $ take sz $ concatMap show [1..sz]++withTestStorageLocations :: (StorageLocations -> IO a) -> IO a+withTestStorageLocations a = bracket setup cleanup go+ where+ setup = mkdtemp "keysafe-test"+ cleanup = removeDirectoryRecursive+ go tmpdir = a $ StorageLocations $+ map (localStorage (testStorageDir tmpdir) . show)+ [1..100 :: Int]++-- | Test of backup and restore of a SecretKey.+backupRestoreTest :: TestDesc -> SecretKey -> Test+backupRestoreTest testdesc secretkey =+ ("backup and restore (" <> testdesc <> ")", runtest)+ where+ runtest = withTestStorageLocations $ \storagelocations -> do+ backup storagelocations+ restore storagelocations++ backup storagelocations = do+ kek <- genKeyEncryptionKey tunables name password+ let esk = encrypt tunables kek secretkey+ shares <- genShares esk tunables+ let sis = shareIdents tunables name secretkeysource+ _ <- storeShares storagelocations sis shares (return ())+ return ()++ restore storagelocations = do+ let sis = shareIdents tunables name secretkeysource+ (shares, sis') <- retrieveShares storagelocations sis (return ())+ let candidatekeys = candidateKeyEncryptionKeys tunables name password+ case combineShares tunables [shares] of+ Left e -> testFailed e+ Right esk -> restorerest storagelocations [shares] sis' $+ tryDecrypt candidatekeys esk+ + restorerest storagelocations firstshares sis r = case r of+ DecryptFailed -> testFailed "DecryptFailed"+ DecryptSuccess restoredsecretkey ->+ if restoredsecretkey == secretkey+ then testSuccess+ else testFailed "restore yielded different value than was backed up"+ DecryptIncomplete kek -> do+ (nextshares, sis') <- retrieveShares storagelocations sis (return ())+ let shares = firstshares ++ [nextshares]+ case combineShares tunables shares of+ Left e -> testFailed e+ Right esk -> restorerest storagelocations shares sis' $+ decrypt kek esk+ + name = Name testdesc+ password = Password "password"+ secretkeysource = GpgKey (KeyId "dummy")+ -- testModeTunables is used, to avoid this taking a very+ -- long time to run.+ tunables = testModeTunables++-- | It's important that StorableObjectIdent generation be stable;+-- any change to it will cause shards to get lost.+stableNamingTest :: TestDesc -> Test+stableNamingTest testdesc = (testdesc, runtest $ map snd knownTunings)+ where+ runtest [] = testFailed "not stable!"+ runtest (tunables:rest) = do+ let sis = shareIdents tunables name secretkeysource+ if S.member knownvalue (head (identsStream sis))+ then testSuccess+ else runtest rest++ name = Name "stable name"+ secretkeysource = GpgKey (KeyId "stable keyid")+ knownvalue = StorableObjectIdent "18b112da9108b4b5e21fa07cfc672e11688110e4c2dc56c8365f0de488cca8cb"
Tunables.hs view
@@ -38,6 +38,8 @@ -- ^ a StorableObject is exactly this many bytes in size -- (must be a multiple of AES block size 16, and cannot be smaller -- than 256 bytes)+ , shareOverhead :: Int+ -- ^ Share encoding overhead as a multiple of the objectSize , nameGenerationTunable :: NameGenerationTunable , keyEncryptionKeyTunable :: KeyEncryptionKeyTunable , encryptionTunable :: EncryptionTunable@@ -79,25 +81,25 @@ data EncryptionTunable = UseAES256 deriving (Show) +-- | Tunables used by default to backup. defaultTunables :: Tunables defaultTunables = Tunables { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 }- , objectSize = 1024*64 -- 64 kb- -- The nameGenerationHash was benchmarked at 661 seconds CPU time- -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz.- -- Since cost is measured per core, we double that.+ , objectSize = 1024*32 -- 32 kb+ , shareOverhead = 2+ -- The nameGenerationHash was benchmarked at 600 seconds+ -- on a 2 core Intel(R) Core(TM) i5-5200U CPU @ 2.20GHz. , nameGenerationTunable = NameGenerationTunable- { nameGenerationHash = argon2 10000 (CPUCost (Seconds (2*600)))+ { nameGenerationHash = argon2 10000 (coreCost 2 (Seconds 600) d) } , keyEncryptionKeyTunable = KeyEncryptionKeyTunable- { keyEncryptionKeyHash = argon2 115 (CPUCost (Seconds 0))+ { keyEncryptionKeyHash = argon2 169 (CPUCost (Seconds 12) d) , randomSaltBytes = 1 -- The keyEncryptionKeyHash is run 256 times per -- random salt byte to brute-force, and its parameters -- were chosen so the total brute forcing time is 50 minutes,- -- on a 2 core Intel(R) Core(TM) i5-4210Y CPU @ 1.50GHz.- -- Since cost is measured per core, we double that.- , randomSaltBytesBruteForceCost = CPUCost (Seconds (2*50*60))+ -- on a 2 core Intel(R) Core(TM) i5-5200U CPU @ 2.20GHz.+ , randomSaltBytesBruteForceCost = coreCost 2 (Seconds (50*60)) d } , encryptionTunable = UseAES256 }@@ -105,25 +107,35 @@ argon2 i c = UseArgon2 c $ Argon2.HashOptions { Argon2.hashIterations = i , Argon2.hashMemory = 131072 -- 128 mebibtyes per thread- , Argon2.hashParallelism = 4 -- 4 threads+ , Argon2.hashParallelism =+ let Divisibility n = d+ in fromIntegral n , Argon2.hashVariant = Argon2.Argon2i }+ d = Divisibility 4 -- argon2 uses 4 threads -- | Dials back hash difficulty, lies about costs. -- Not for production use! testModeTunables :: Tunables testModeTunables = Tunables { shareParams = ShareParams { totalObjects = 3, neededObjects = 2 }- , objectSize = 1024*64+ , objectSize = 1024*32+ , shareOverhead = 2 , nameGenerationTunable = NameGenerationTunable- { nameGenerationHash = weakargon2 (CPUCost (Seconds (2*600)))+ { nameGenerationHash = weakargon2 (coreCost 2 (Seconds 600) d) } , keyEncryptionKeyTunable = KeyEncryptionKeyTunable- { keyEncryptionKeyHash = weakargon2 (CPUCost (Seconds 0))+ { keyEncryptionKeyHash = weakargon2 (CPUCost (Seconds 12) d) , randomSaltBytes = 1- , randomSaltBytesBruteForceCost = CPUCost (Seconds (2*50*60))+ , randomSaltBytesBruteForceCost = coreCost 2 (Seconds (50*60)) d } , encryptionTunable = UseAES256 } where weakargon2 c = UseArgon2 c Argon2.defaultHashOptions+ d = Divisibility 4++knownObjectSizes :: [Int]+knownObjectSizes = map (calc . snd) knownTunings+ where+ calc t = objectSize t * shareOverhead t
Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-} {- Copyright 2016 Joey Hess <id@joeyh.name> -@@ -11,9 +11,11 @@ import qualified Data.ByteString as B import Data.String import Control.DeepSeq+import GHC.Generics (Generic) -- | keysafe stores secret keys. newtype SecretKey = SecretKey B.ByteString+ deriving (Eq) -- | The secret key, encrypted with a password, in fixed size chunks. data EncryptedSecretKey = EncryptedSecretKey [B.ByteString] (CostCalc BruteForceOp UnknownPassword)@@ -29,7 +31,7 @@ -- | An object in a form suitable to be stored on a keysafe server. newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString }- deriving (Show, Eq, Ord)+ deriving (Show, Eq, Ord, Generic) -- | An identifier for a StorableObject newtype StorableObjectIdent = StorableObjectIdent B.ByteString
Types/Cost.hs view
@@ -9,30 +9,26 @@ -- | An estimated cost to perform an operation. data Cost op - = CPUCost Seconds -- ^ using 1 CPU core+ = CPUCost Seconds Divisibility+ -- ^ cost in Seconds, using 1 physical CPU core deriving (Show, Eq, Ord) -unknownCost :: Cost op-unknownCost = CPUCost (Seconds 0)- newtype Seconds = Seconds Integer deriving (Num, Eq, Ord, Show) +-- | How many CPU cores a single run of an operation can be divided amoung.+newtype Divisibility = Divisibility Integer+ deriving (Show, Eq, Ord)+ data UsingHardware = UsingCPU | UsingGPU | UsingASIC deriving (Show) instance Monoid (Cost t) where- mempty = CPUCost (Seconds 0)- CPUCost (Seconds a) `mappend` CPUCost (Seconds b) =- CPUCost (Seconds (a+b))--mapCost :: (Integer -> Integer) -> Cost op -> Cost op-mapCost f (CPUCost (Seconds n)) = CPUCost (Seconds (f n))--showCostMinutes :: Cost op -> String-showCostMinutes (CPUCost (Seconds n))- | n < 61 = "1 minute"- | otherwise = show (n `div` 60) ++ " minutes"+ mempty = CPUCost (Seconds 0) (Divisibility 1)+ CPUCost (Seconds a) (Divisibility x) `mappend` CPUCost (Seconds b) (Divisibility y) =+ -- Take maximum divisibility, to avoid over-estimating+ -- the total cost.+ CPUCost (Seconds (a+b)) (Divisibility $ max x y) -- | Operations whose cost can be measured. data DecryptionOp
Types/Storage.hs view
@@ -4,16 +4,21 @@ -} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric #-} module Types.Storage where import Types+import GHC.Generics+import Data.Aeson.Types -- | All known locations where shares can be stored, ordered with -- preferred locations first. newtype StorageLocations = StorageLocations [Storage] deriving (Monoid) +newtype LocalStorageDirectory = LocalStorageDirectory FilePath+ -- | Storage interface. This can be used both for local storage, -- an upload queue, or a remote server. --@@ -31,12 +36,18 @@ } data StoreResult = StoreSuccess | StoreAlreadyExists | StoreFailure String- deriving (Show)+ deriving (Show, Generic) data RetrieveResult = RetrieveSuccess Share | RetrieveFailure String+ deriving (Generic) data ObscureResult = ObscureSuccess | ObscureFailure String- deriving (Show)+ deriving (Show, Generic) data CountResult = CountResult Integer | CountFailure String- deriving (Show)+ deriving (Show, Generic)++instance ToJSON StoreResult+instance FromJSON StoreResult+instance ToJSON CountResult+instance FromJSON CountResult
keysafe.cabal view
@@ -1,5 +1,5 @@ Name: keysafe-Version: 0.20160819+Version: 0.20160831 Cabal-Version: >= 1.8 Maintainer: Joey Hess <joey@kitenet.net> Author: Joey Hess@@ -20,16 +20,21 @@ Extra-Source-Files: CHANGELOG TODO+ INSTALL keysafe.1+ keysafe.service+ keysafe.desktop+ Makefile Executable keysafe Main-Is: keysafe.hs- GHC-Options: -Wall -fno-warn-tabs -O2+ GHC-Options: -threaded -Wall -fno-warn-tabs -O2 Build-Depends: base (>= 4.5 && < 5.0) , bytestring == 0.10.* , deepseq == 1.4.* , random == 1.1.*+ , secret-sharing == 1.0.* , raaz == 0.0.2 , time == 1.5.* , containers == 0.5.*@@ -44,15 +49,17 @@ , optparse-applicative == 0.12.* , readline == 1.0.* , zxcvbn-c == 1.0.*-- -- Inlined to change the finite field size to 256- -- for efficient serialization.- -- secret-sharing == 1.0.*- , dice-entropy-conduit >= 1.0.0.0- , binary >=0.5.1.1- , vector >=0.10.11.0- , finite-field >=0.8.0- , polynomial >= 0.7.1+ , servant == 0.7.*+ , servant-server == 0.7.*+ , servant-client == 0.7.*+ , aeson == 0.11.*+ , wai == 3.2.*+ , warp == 3.2.*+ , http-client == 0.4.*+ , transformers == 0.4.*+ , stm == 2.4.*+ , socks == 0.5.*+ , network == 2.6.* -- Temporarily inlined due to https://github.com/ocharles/argon2/issues/3 -- argon2 == 1.1.* Extra-Libraries: argon2@@ -61,17 +68,20 @@ Crypto.Argon2 CmdLine Cost- Crypto.SecretSharing.Internal Encryption Entropy ExpensiveHash Gpg+ HTTP+ HTTP.Client+ HTTP.Server SecretKey Serialization Share Storage Storage.Local Storage.Network+ Tests Tunables Types Types.Cost
+ keysafe.desktop view
@@ -0,0 +1,8 @@+[Desktop Entry]+Type=Application+Version=1.0+Name=Keysafe+Comment=Back up or restore your private Gnupg key with Keysafe+Terminal=false+Exec=/usr/bin/keysafe+Categories=Network;
keysafe.hs view
@@ -14,10 +14,12 @@ import Encryption import Entropy import ExpensiveHash+import Tests import Cost import SecretKey import Share import Storage+import HTTP.Server import qualified Gpg import Data.Maybe import Data.Time.Clock@@ -41,8 +43,8 @@ return (mkt testModeTunables, [mkt testModeTunables]) else return (mkt defaultTunables, map (mkt . snd) knownTunings) storagelocations <- if CmdLine.localstorage cmdline- then return localStorageLocations- else allStorageLocations+ then pure $ localStorageLocations (CmdLine.localstoragedirectory cmdline)+ else allStorageLocations (CmdLine.localstoragedirectory cmdline) dispatch cmdline ui storagelocations tunables possibletunables dispatch :: CmdLine.CmdLine -> UI -> StorageLocations -> Tunables -> [Tunables] -> IO ()@@ -61,9 +63,16 @@ go CmdLine.Restore Nothing = restore storagelocations ui possibletunables Gpg.anyKey go CmdLine.UploadQueued _ =- uploadQueued+ uploadQueued (CmdLine.localstoragedirectory cmdline)+ go (CmdLine.Server) _ =+ runServer+ (CmdLine.localstoragedirectory cmdline)+ (CmdLine.serverAddress $ CmdLine.serverConfig cmdline)+ (CmdLine.serverPort $ CmdLine.serverConfig cmdline) go CmdLine.Benchmark _ = benchmarkTunables tunables+ go CmdLine.Test _ =+ runTests backup :: StorageLocations -> UI -> Tunables -> SecretKeySource -> SecretKey -> IO () backup storagelocations ui tunables secretkeysource secretkey = do@@ -74,6 +83,7 @@ go theirname where go theirname = do+ cores <- fromMaybe 1 <$> getNumCores Name othername <- fromMaybe (error "aborting on no othername") <$> promptName ui "Enter other name" othernamedesc Nothing validateName@@ -82,7 +92,7 @@ let sis = shareIdents tunables name secretkeysource let cost = getCreationCost kek <> getCreationCost sis r <- withProgressIncremental ui "Encrypting and storing data"- (encryptdesc cost) $ \addpercent -> do+ (encryptdesc cost cores) $ \addpercent -> do let esk = encrypt tunables kek secretkey shares <- genShares esk tunables _ <- esk `deepseq` addpercent 25@@ -156,8 +166,8 @@ crackdesc crackcost thisyear = unlines $ "Rough estimate of the cost to crack your password: " : costOverTimeTable crackcost thisyear- encryptdesc cost = unlines- [ "This will probably take around " ++ showCostMinutes cost+ encryptdesc cost cores = unlines+ [ "This will probably take around " ++ showCostMinutes cores cost , "" , "(It's a feature that this takes a while; it makes it hard" , "for anyone to find your data, or crack your password.)"@@ -176,6 +186,7 @@ restore :: StorageLocations -> UI -> [Tunables] -> SecretKeySource -> IO () restore storagelocations ui possibletunables secretkeydest = do+ cores <- fromMaybe 1 <$> getNumCores username <- userName Name theirname <- fromMaybe (error "Aborting on no username") <$> promptName ui "Enter your name"@@ -199,14 +210,14 @@ Left e -> showError ui e Right esk -> do final <- withProgress ui "Decrypting"- (decryptdesc cost) $ \setpercent ->+ (decryptdesc cost cores) $ \setpercent -> go tunables [shares] sis setpercent $ tryDecrypt candidatekeys esk final where go tunables firstshares sis setpercent r = case r of DecryptFailed -> return $- showError ui "Decryption failed! Unknown why it would fail at this point."+ showError ui "Decryption failed! Probably you entered the wrong password." DecryptSuccess secretkey -> do _ <- setpercent 100 writeSecretKey secretkeydest secretkey@@ -237,8 +248,8 @@ passworddesc = unlines [ "Enter the password to unlock your secret key." ]- decryptdesc cost = unlines- [ "This will probably take around " ++ showCostMinutes cost+ decryptdesc cost cores = unlines+ [ "This will probably take around " ++ showCostMinutes cores cost , "" , "(It's a feature that this takes so long; it prevents cracking your password.)" , ""@@ -246,7 +257,7 @@ ] -- | Try each possible tunable until the initial set of --- shares are found, the return the shares, and+-- shares are found, and return the shares, and -- ShareIdents to download subsequent sets. downloadInitialShares :: StorageLocations@@ -254,8 +265,9 @@ -> (Tunables -> ShareIdents) -> [Tunables] -> IO (Maybe (Tunables, S.Set Share, ShareIdents))-downloadInitialShares storagelocations ui mksis possibletunables =- withProgressIncremental ui "Downloading encrypted data" message $ \addpercent -> do+downloadInitialShares storagelocations ui mksis possibletunables = do+ cores <- fromMaybe 1 <$> getNumCores+ withProgressIncremental ui "Downloading encrypted data" (message cores) $ \addpercent -> do go possibletunables addpercent where go [] _ = return Nothing@@ -272,9 +284,9 @@ else return $ Just (tunables, shares, sis') possiblesis = map mksis possibletunables- message = unlines+ message cores = unlines [ "This will probably take around "- ++ showCostMinutes (mconcat $ map getCreationCost possiblesis)+ ++ showCostMinutes cores (mconcat $ map getCreationCost possiblesis) , "" , "(It's a feature that this takes a while; it makes it hard" , "for anyone else to find your data.)"
+ keysafe.service view
@@ -0,0 +1,15 @@+[Unit]+Description=keysafe server++[Service]+ExecStart=/usr/bin/keysafe --server --port 4242 --store-directory=/var/lib/keysafe/+InaccessiblePaths=/home /etc+ReadWritePaths=/var/lib/keysafe+User=keysafe+Group=keysafe+StandardInput=null+StandardOutput=journal+StandardError=journal++[Install]+WantedBy=multi-user.target