Implement key persistence for server

ChangeLog.md

@@ -1,4 +1,4 @@
-# Revision history for hanafudapi
+# Revision history for hanafuda-server
 
 ## 0.2.3.0  -- 2019-08-24
 

hanafuda-server.cabal

@@ -1,4 +1,4 @@
--- Initial hanafudapi.cabal generated by cabal init.  For further 
+-- Initial hanafuda-server.cabal generated by cabal init.  For further
 -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                hanafuda-server
@@ -35,6 +35,8 @@ executable hanafudapi
   build-depends:       base >=4.9 && <4.13
                      , bytestring
                      , containers >= 0.5.9
+                     , directory
+                     , filepath
                      , unordered-containers
                      , hanafuda >= 0.3.3
                      , hanafuda-protocol >= 0.1.0

src/Config.hs

@@ -1,6 +1,10 @@
 module Config (
-    listenPort
+      libDir
+    , listenPort
   ) where
 
+libDir :: FilePath
+libDir = "/var/lib/hanafuda-server"
+
 listenPort :: Int
 listenPort = 3000

src/Keys.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 module Keys (
       T(..)
     , getKeys
@@ -5,19 +6,54 @@ module Keys (
     , secret
   ) where
 
+import Config (libDir)
+import Control.Monad.State (MonadState(..), StateT(..), evalStateT, lift)
+import Crypto.Saltine.Class (IsEncoding(..))
 import qualified Crypto.Saltine.Core.SecretBox as Encrypt (Key, newKey)
 import qualified Crypto.Saltine.Core.Sign as Sign (
     Keypair, PublicKey, SecretKey, newKeypair
   )
+import qualified Data.ByteString as BS (
+    ByteString, length, readFile, singleton, splitAt, uncons, writeFile
+  )
+import System.Directory (createDirectoryIfMissing, doesFileExist)
+import System.Exit (die)
+import System.FilePath ((</>))
 
 data T = T {
       encrypt :: Encrypt.Key
     , sign :: Sign.Keypair
   }
 
+serialize :: T -> BS.ByteString
+serialize (T {encrypt, sign = (secretKey, publicKey)}) =
+  mconcat [encodeKey encrypt, encodeKey secretKey, encodeKey publicKey]
+  where
+    encodeKey key =
+      let encodedKey = encode key in
+      (BS.singleton . toEnum $ BS.length encodedKey) <> encodedKey
+
+unserialize :: BS.ByteString -> Maybe T
+unserialize = evalStateT $ T <$> decodeKey <*> ((,) <$> decodeKey <*> decodeKey)
+  where
+    decodeKey :: IsEncoding a => StateT BS.ByteString Maybe a
+    decodeKey = do
+      keyLength <- fromEnum <$> StateT BS.uncons
+      lift . decode =<< state (BS.splitAt keyLength)
+
 getKeys :: IO T
 getKeys = do
-  T <$> Encrypt.newKey <*> Sign.newKeypair
+  fileExists <- doesFileExist keyRing
+  if fileExists
+  then BS.readFile keyRing >>= tryUnserialize
+  else do
+    newT <- T <$> Encrypt.newKey <*> Sign.newKeypair
+    createDirectoryIfMissing True libDir
+    BS.writeFile keyRing $ serialize newT
+    return newT
+  where
+    keyRing = libDir </> "keys"
+    tryUnserialize = maybe (die "Could not unserialize key") return . unserialize
 
 public :: Sign.Keypair -> Sign.PublicKey
 public = snd