From 772b38d154e871166e4ef1f56bc696f0f84ed146 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Date: Mon, 3 May 2021 12:38:31 +0100
Subject: [PATCH] simplify KeyHash type, store key hash in DB as binary (#122)

---
 apps/smp-server/Main.hs                     |  7 +++--
 src/Simplex/Messaging/Agent/Transmission.hs |  4 +--
 src/Simplex/Messaging/Crypto.hs             | 33 +++++----------------
 src/Simplex/Messaging/Transport.hs          |  4 +--
 4 files changed, 16 insertions(+), 32 deletions(-)

diff --git a/apps/smp-server/Main.hs b/apps/smp-server/Main.hs
index 2de39e47c..a5151f9bb 100644
--- a/apps/smp-server/Main.hs
+++ b/apps/smp-server/Main.hs
@@ -8,6 +8,7 @@ module Main where
 
 import Control.Monad (unless, when)
 import qualified Crypto.Store.PKCS8 as S
+import Data.ByteString.Base64 (encode)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (toLower)
 import Data.Functor (($>))
@@ -55,7 +56,7 @@ main = do
   ini <- readCreateIni opts
   storeLog <- openStoreLog ini
   pk <- readCreateKey
-  B.putStrLn $ "transport key hash: " <> publicKeyHash (C.publicKey pk)
+  B.putStrLn $ "transport key hash: " <> serverKeyHash pk
   putStrLn $ "listening on port " <> tcpPort cfg
   runSMPServer cfg {serverPrivateKey = pk, storeLog}
 
@@ -126,8 +127,8 @@ confirm msg = do
   ok <- getLine
   when (map toLower ok /= "y") exitFailure
 
-publicKeyHash :: C.PublicKey -> B.ByteString
-publicKeyHash = C.serializeKeyHash . C.getKeyHash . C.encodePubKey
+serverKeyHash :: C.FullPrivateKey -> B.ByteString
+serverKeyHash = encode . C.unKeyHash . C.publicKeyHash . C.publicKey
 
 openStoreLog :: IniOpts -> IO (Maybe (StoreLog 'ReadMode))
 openStoreLog IniOpts {enableStoreLog, storeLogFile = f}
diff --git a/src/Simplex/Messaging/Agent/Transmission.hs b/src/Simplex/Messaging/Agent/Transmission.hs
index fbaff38b6..eb504dd1a 100644
--- a/src/Simplex/Messaging/Agent/Transmission.hs
+++ b/src/Simplex/Messaging/Agent/Transmission.hs
@@ -181,7 +181,7 @@ smpServerP = SMPServer <$> server <*> optional port <*> optional kHash
   where
     server = B.unpack <$> A.takeTill (A.inClass ":# ")
     port = A.char ':' *> (B.unpack <$> A.takeWhile1 A.isDigit)
-    kHash = A.char '#' *> C.keyHashP
+    kHash = C.KeyHash <$> (A.char '#' *> base64P)
 
 parseAgentMessage :: ByteString -> Either AgentErrorType AMessage
 parseAgentMessage = parse agentMessageP $ AGENT A_MESSAGE
@@ -198,7 +198,7 @@ serializeSmpQueueInfo (SMPQueueInfo srv qId ek) =
 
 serializeServer :: SMPServer -> ByteString
 serializeServer SMPServer {host, port, keyHash} =
-  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . C.serializeKeyHash) keyHash
+  B.pack $ host <> maybe "" (':' :) port <> maybe "" (('#' :) . B.unpack . encode . C.unKeyHash) keyHash
 
 data SMPServer = SMPServer
   { host :: HostName,
diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs
index 6deff72d6..efab6ce67 100644
--- a/src/Simplex/Messaging/Crypto.hs
+++ b/src/Simplex/Messaging/Crypto.hs
@@ -35,13 +35,11 @@ module Simplex.Messaging.Crypto
     serializePrivKey,
     serializePubKey,
     encodePubKey,
-    serializeKeyHash,
-    getKeyHash,
+    publicKeyHash,
     sha256Hash,
     privKeyP,
     pubKeyP,
     binaryPubKeyP,
-    keyHashP,
     authTagSize,
     authTagToBS,
     bsToAuthTag,
@@ -58,7 +56,7 @@ import Control.Monad.Trans.Except
 import Crypto.Cipher.AES (AES256)
 import qualified Crypto.Cipher.Types as AES
 import qualified Crypto.Error as CE
-import Crypto.Hash (Digest, SHA256 (..), digestFromByteString, hash)
+import Crypto.Hash (Digest, SHA256 (..), hash)
 import Crypto.Number.Generate (generateMax)
 import Crypto.Number.Prime (findPrimeFrom)
 import qualified Crypto.PubKey.RSA as R
@@ -208,32 +206,17 @@ newtype Key = Key {unKey :: ByteString}
 
 newtype IV = IV {unIV :: ByteString}
 
-newtype KeyHash = KeyHash {unKeyHash :: Digest SHA256} deriving (Eq, Ord, Show)
+newtype KeyHash = KeyHash {unKeyHash :: ByteString} deriving (Eq, Ord, Show)
 
 instance IsString KeyHash where
-  fromString = parseString $ parseAll keyHashP
+  fromString = parseString . parseAll $ KeyHash <$> base64P
 
-instance ToField KeyHash where toField = toField . serializeKeyHash
+instance ToField KeyHash where toField = toField . unKeyHash
 
-instance FromField KeyHash where
-  fromField f@(Field (SQLBlob b) _) =
-    case parseAll keyHashP b of
-      Right k -> Ok k
-      Left e -> returnError ConversionFailed f ("couldn't parse KeyHash field: " ++ e)
-  fromField f = returnError ConversionFailed f "expecting SQLBlob column type"
+instance FromField KeyHash where fromField f = KeyHash <$> fromField f
 
-serializeKeyHash :: KeyHash -> ByteString
-serializeKeyHash = encode . BA.convert . unKeyHash
-
-keyHashP :: Parser KeyHash
-keyHashP = do
-  bs <- base64P
-  case digestFromByteString bs of
-    Just d -> pure $ KeyHash d
-    _ -> fail "invalid digest"
-
-getKeyHash :: ByteString -> KeyHash
-getKeyHash = KeyHash . hash
+publicKeyHash :: PublicKey -> KeyHash
+publicKeyHash = KeyHash . sha256Hash . encodePubKey
 
 sha256Hash :: ByteString -> ByteString
 sha256Hash = BA.convert . (hash :: ByteString -> Digest SHA256)
diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs
index 923ac5b09..a99bbd2c4 100644
--- a/src/Simplex/Messaging/Transport.hs
+++ b/src/Simplex/Messaging/Transport.hs
@@ -287,8 +287,8 @@ clientHandshake h keyHash = do
     parseKey :: ByteString -> Either TransportError C.PublicKey
     parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryPubKeyP
     validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO ()
-    validateKeyHash_2 k kHash
-      | C.getKeyHash k == kHash = pure ()
+    validateKeyHash_2 k (C.KeyHash kHash)
+      | C.sha256Hash k == kHash = pure ()
       | otherwise = throwE $ TEHandshake BAD_HASH
     generateKeys_3 :: Int -> IO ClientHandshake
     generateKeys_3 blkSize = ClientHandshake blkSize <$> generateKey <*> generateKey