summaryrefslogtreecommitdiff
path: root/src/Storage/Key.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-11-17 20:28:44 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2023-11-18 20:03:24 +0100
commit88a7bb50033baab3c2d0eed7e4be868e8966300a (patch)
tree861631a1e5e7434b92a8f19ef8f7b783790e1d1f /src/Storage/Key.hs
parent5b908c86320ee73f2722c85f8a47fa03ec093c6c (diff)
Split to library and executable parts
Diffstat (limited to 'src/Storage/Key.hs')
-rw-r--r--src/Storage/Key.hs84
1 files changed, 0 insertions, 84 deletions
diff --git a/src/Storage/Key.hs b/src/Storage/Key.hs
deleted file mode 100644
index 7730f9f..0000000
--- a/src/Storage/Key.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-module Storage.Key (
- KeyPair(..),
- storeKey, loadKey, loadKeyMb,
- moveKeys,
-) where
-
-import Control.Concurrent.MVar
-import Control.Monad
-import Control.Monad.Except
-
-import Data.ByteArray
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.ByteString.Lazy as BL
-import qualified Data.Map as M
-
-import System.Directory
-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
-
-
-keyFilePath :: KeyPair sec pub => FilePath -> Stored pub -> FilePath
-keyFilePath sdir pkey = sdir </> "keys" </> (BC.unpack $ showRef $ storedRef pkey)
-
-storeKey :: KeyPair sec pub => sec -> IO ()
-storeKey key = do
- let spub = keyGetPublic key
- case stBacking $ storedStorage spub of
- StorageDir { dirPath = dir } -> writeFileOnce (keyFilePath dir spub) (BL.fromStrict $ convert $ keyGetData key)
- StorageMemory { memKeys = kstore } -> modifyMVar_ kstore $ return . M.insert (refDigest $ storedRef spub) (keyGetData key)
-
-loadKey :: (KeyPair sec pub, MonadIO m, MonadError String m) => Stored pub -> m sec
-loadKey pub = maybe (throwError $ "secret key not found for " <> show (storedRef pub)) return =<< loadKeyMb pub
-
-loadKeyMb :: (KeyPair sec pub, MonadIO m) => Stored pub -> m (Maybe sec)
-loadKeyMb spub = liftIO $ run $ storedStorage spub
- where
- run st = tryOneLevel (stBacking st) >>= \case
- key@Just {} -> return key
- Nothing | Just parent <- stParent st -> run parent
- | otherwise -> return Nothing
- tryOneLevel = \case
- StorageDir { dirPath = dir } -> tryIOError (BC.readFile (keyFilePath dir spub)) >>= \case
- Right kdata -> return $ keyFromData (convert kdata) spub
- Left _ -> return Nothing
- StorageMemory { memKeys = kstore } -> (flip keyFromData spub <=< M.lookup (refDigest $ storedRef spub)) <$> readMVar kstore
-
-moveKeys :: MonadIO m => Storage -> Storage -> m ()
-moveKeys from to = liftIO $ do
- case (stBacking from, stBacking to) of
- (StorageDir { dirPath = fromPath }, StorageDir { dirPath = toPath }) -> do
- files <- listDirectory (fromPath </> "keys")
- forM_ files $ \file -> do
- renameFile (fromPath </> "keys" </> file) (toPath </> "keys" </> file)
-
- (StorageDir { dirPath = fromPath }, StorageMemory { memKeys = toKeys }) -> do
- let move m file
- | Just dgst <- readRefDigest (BC.pack file) = do
- let path = fromPath </> "keys" </> file
- key <- convert <$> BC.readFile path
- removeFile path
- return $ M.insert dgst key m
- | otherwise = return m
- files <- listDirectory (fromPath </> "keys")
- modifyMVar_ toKeys $ \keys -> foldM move keys files
-
- (StorageMemory { memKeys = fromKeys }, StorageDir { dirPath = toPath }) -> do
- modifyMVar_ fromKeys $ \keys -> do
- forM_ (M.assocs keys) $ \(dgst, key) ->
- writeFileOnce (toPath </> "keys" </> (BC.unpack $ showRefDigest dgst)) (BL.fromStrict $ convert key)
- return M.empty
-
- (StorageMemory { memKeys = fromKeys }, StorageMemory { memKeys = toKeys }) -> do
- modifyMVar_ fromKeys $ \fkeys -> do
- modifyMVar_ toKeys $ return . M.union fkeys
- return M.empty