From f609499402160aa908e6435b8a61f7cb1f258cfe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Roman=20Smr=C5=BE?= Date: Thu, 16 May 2019 20:31:51 +0200 Subject: Key storage interface --- erebos.cabal | 5 ++++- src/PubKey.hs | 22 ++++++++++++------- src/Storage.hs | 49 +----------------------------------------- src/Storage/Internal.hs | 57 +++++++++++++++++++++++++++++++++++++++++++++++++ src/Storage/Key.hs | 36 +++++++++++++++++++++++++++++++ 5 files changed, 112 insertions(+), 57 deletions(-) create mode 100644 src/Storage/Internal.hs create mode 100644 src/Storage/Key.hs diff --git a/erebos.cabal b/erebos.cabal index 17948b2..a51e61a 100644 --- a/erebos.cabal +++ b/erebos.cabal @@ -21,10 +21,13 @@ executable erebos other-modules: Identity, Network, PubKey, - Storage + Storage, + Storage.Internal + Storage.Key default-extensions: FlexibleContexts, FlexibleInstances, + FunctionalDependencies, LambdaCase, TupleSections diff --git a/src/PubKey.hs b/src/PubKey.hs index 787ada3..0022343 100644 --- a/src/PubKey.hs +++ b/src/PubKey.hs @@ -1,7 +1,7 @@ module PubKey ( PublicKey, SecretKey, + KeyPair(generateKeys), loadKey, Signature(sigKey), Signed, signedData, signedSignature, - generateKeys, sign, signAdd, ) where @@ -11,10 +11,12 @@ import Control.Monad.Except import Crypto.Error import qualified Crypto.PubKey.Ed25519 as ED +import Data.ByteArray import Data.ByteString (ByteString) import qualified Data.Text as T import Storage +import Storage.Key data PublicKey = PublicKey ED.PublicKey deriving (Show) @@ -39,6 +41,17 @@ signedData = signedData_ signedSignature :: Signed a -> [Stored Signature] signedSignature = signedSignature_ +instance KeyPair SecretKey PublicKey where + keyGetPublic (SecretKey _ pub) = pub + keyGetData (SecretKey sec _) = convert sec + keyFromData kdata spub = SecretKey <$> maybeCryptoError (ED.secretKey kdata) <*> pure spub + generateKeys st = do + secret <- ED.generateSecretKey + public <- wrappedStore st $ PublicKey $ ED.toPublic secret + let pair = SecretKey secret public + storeKey pair + return (pair, public) + instance Storable PublicKey where store' (PublicKey pk) = storeRec $ do storeText "type" $ T.pack "ed25519" @@ -76,13 +89,6 @@ instance Storable a => Storable (Signed a) where throwError "signature verification failed" return $ Signed sdata sigs - -generateKeys :: Storage -> IO (SecretKey, Stored PublicKey) -generateKeys st = do - secret <- ED.generateSecretKey - public <- wrappedStore st $ PublicKey $ ED.toPublic secret - return (SecretKey secret public, public) - sign :: SecretKey -> Stored a -> IO (Signed a) sign secret val = signAdd secret $ Signed val [] diff --git a/src/Storage.hs b/src/Storage.hs index 25c7a75..caf9d30 100644 --- a/src/Storage.hs +++ b/src/Storage.hs @@ -51,7 +51,6 @@ import qualified Codec.MIME.Type as MIME import qualified Codec.MIME.Parse as MIME import Control.Arrow -import Control.Exception import Control.Monad import Control.Monad.Except import Control.Monad.Reader @@ -86,16 +85,10 @@ import Data.Time.Format import Data.Time.LocalTime import System.Directory -import System.FilePath -import System.IO import System.IO.Unsafe -import System.Posix.Files -import System.Posix.IO -import System.Posix.Types +import Storage.Internal -data Storage = Storage FilePath - deriving (Eq, Ord) openStorage :: FilePath -> IO Storage openStorage path = do @@ -325,46 +318,6 @@ replaceHead obj prev = do showRefL ref = showRef ref `B.append` BC.singleton '\n' -openFdParents :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd -openFdParents path omode fmode flags = do - createDirectoryIfMissing True (takeDirectory path) - openFd path omode fmode flags - -writeFileOnce :: FilePath -> BL.ByteString -> IO () -writeFileOnce file content = bracket - (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })) - hClose $ \h -> do - fileExist file >>= \case - True -> removeLink locked - False -> do BL.hPut h content - rename locked file - where locked = file ++ ".lock" - -writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ()) -writeFileChecked file prev content = bracket - (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })) - hClose $ \h -> do - (prev,) <$> fileExist file >>= \case - (Nothing, True) -> do - current <- B.readFile file - removeLink locked - return $ Left $ Just current - (Nothing, False) -> do B.hPut h content - rename locked file - return $ Right () - (Just expected, True) -> do - current <- B.readFile file - if current == expected then do B.hPut h content - rename locked file - return $ return () - else do removeLink locked - return $ Left $ Just current - (Just _, False) -> do - removeLink locked - return $ Left Nothing - where locked = file ++ ".lock" - - class Storable a where store' :: a -> Store load' :: Load a diff --git a/src/Storage/Internal.hs b/src/Storage/Internal.hs new file mode 100644 index 0000000..6a86dea --- /dev/null +++ b/src/Storage/Internal.hs @@ -0,0 +1,57 @@ +module Storage.Internal where + +import Control.Exception + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL + +import System.Directory +import System.FilePath +import System.IO +import System.Posix.Files +import System.Posix.IO +import System.Posix.Types + +data Storage = Storage FilePath + deriving (Eq, Ord) + + +openFdParents :: FilePath -> OpenMode -> Maybe FileMode -> OpenFileFlags -> IO Fd +openFdParents path omode fmode flags = do + createDirectoryIfMissing True (takeDirectory path) + openFd path omode fmode flags + +writeFileOnce :: FilePath -> BL.ByteString -> IO () +writeFileOnce file content = bracket + (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })) + hClose $ \h -> do + fileExist file >>= \case + True -> removeLink locked + False -> do BL.hPut h content + rename locked file + where locked = file ++ ".lock" + +writeFileChecked :: FilePath -> Maybe ByteString -> ByteString -> IO (Either (Maybe ByteString) ()) +writeFileChecked file prev content = bracket + (fdToHandle =<< openFdParents locked WriteOnly (Just $ unionFileModes ownerReadMode ownerWriteMode) (defaultFileFlags { exclusive = True })) + hClose $ \h -> do + (prev,) <$> fileExist file >>= \case + (Nothing, True) -> do + current <- B.readFile file + removeLink locked + return $ Left $ Just current + (Nothing, False) -> do B.hPut h content + rename locked file + return $ Right () + (Just expected, True) -> do + current <- B.readFile file + if current == expected then do B.hPut h content + rename locked file + return $ return () + else do removeLink locked + return $ Left $ Just current + (Just _, False) -> do + removeLink locked + return $ Left Nothing + where locked = file ++ ".lock" diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs new file mode 100644 index 0000000..3ed4a66 --- /dev/null +++ b/src/Storage/Key.hs @@ -0,0 +1,36 @@ +module Storage.Key ( + KeyPair(..), + storeKey, loadKey, +) where + +import Data.ByteArray +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as BL + +import System.FilePath +import System.IO.Error + +import Storage +import Storage.Internal + +class Storable pub => KeyPair sec pub | sec -> pub, pub -> sec where + generateKeys :: Storage -> IO (sec, Stored pub) + keyGetPublic :: sec -> Stored pub + keyGetData :: sec -> ScrubbedBytes + keyFromData :: ScrubbedBytes -> Stored pub -> Maybe sec + + +keyStorage :: Storage -> FilePath +keyStorage (Storage base) = base "keys" + +keyFilePath :: KeyPair sec pub => Stored pub -> FilePath +keyFilePath pkey = keyStorage (storedStorage pkey) (BC.unpack $ showRef $ storedRef pkey) + +storeKey :: KeyPair sec pub => sec -> IO () +storeKey key = writeFileOnce (keyFilePath $ keyGetPublic key) (BL.fromStrict $ convert $ keyGetData key) + +loadKey :: KeyPair sec pub => Stored pub -> IO (Maybe sec) +loadKey spub = do + tryIOError (BC.readFile (keyFilePath spub)) >>= \case + Right kdata -> return $ keyFromData (convert kdata) spub + Left _ -> return Nothing -- cgit v1.2.3