63 lines
1.8 KiB
Haskell
63 lines
1.8 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module Keys (
|
|
T(..)
|
|
, getKeys
|
|
, public
|
|
, 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
|
|
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
|
|
|
|
secret :: Sign.Keypair -> Sign.SecretKey
|
|
secret = fst
|