diff --git a/ChangeLog.md b/ChangeLog.md index 8d85522..9ab026c 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,4 +1,4 @@ -# Revision history for hanafudapi +# Revision history for hanafuda-server ## 0.2.3.0 -- 2019-08-24 diff --git a/hanafuda-server.cabal b/hanafuda-server.cabal index 6c2571b..7bf48aa 100644 --- a/hanafuda-server.cabal +++ b/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 diff --git a/src/Config.hs b/src/Config.hs index 6117553..98829f3 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -1,6 +1,10 @@ module Config ( - listenPort + libDir + , listenPort ) where +libDir :: FilePath +libDir = "/var/lib/hanafuda-server" + listenPort :: Int listenPort = 3000 diff --git a/src/Keys.hs b/src/Keys.hs index 2bd75dd..fbbd4f6 100644 --- a/src/Keys.hs +++ b/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