summaryrefslogtreecommitdiff
path: root/src/Storage
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2019-05-16 20:31:51 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2019-05-16 20:31:51 +0200
commitf609499402160aa908e6435b8a61f7cb1f258cfe (patch)
treed73a0ec33e0dca2bbbc1fda716aad627915fa941 /src/Storage
parent779c6fbd4d73b718ea64f22114f1d12463479d67 (diff)
Key storage interface
Diffstat (limited to 'src/Storage')
-rw-r--r--src/Storage/Internal.hs57
-rw-r--r--src/Storage/Key.hs36
2 files changed, 93 insertions, 0 deletions
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