Merge branch 'security'

CHANGELOG.md

@@ -4,6 +4,12 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [Unreleased]
+
+### Changed
+
+- Implement `BLAKE3` for PIN hashing.
+
 ## [1.2.2] - 2023-01-25
 
 ### Fixed

src/ZGoBackend.hs

@@ -6,6 +6,7 @@
 
 module ZGoBackend where
 
+import qualified BLAKE3 as BLK
 import Config
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (try)
@@ -14,6 +15,7 @@ import Control.Monad.IO.Class
 import Data.Aeson
 import Data.Array
 import qualified Data.Bson as B
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C
@@ -426,12 +428,17 @@ addUser nodeUser nodePwd p db node (Just tx) = do
   when isNew $ do
     let newPin = unsafePerformIO (generatePin (fromIntegral $ blocktime tx))
     _ <- sendPin nodeUser nodePwd node (address tx) newPin
+    let pinHash =
+          BLK.hash
+            [ BA.pack . BS.unpack . C.pack . T.unpack $ newPin <> session tx :: BA.Bytes
+            ]
     insert_
       "users"
       [ "address" =: address tx
       , "session" =: session tx
       , "blocktime" =: blocktime tx
-      , "pin" =: newPin
+      , "pin" =:
+        (T.pack . show $ (pinHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
       , "validated" =: False
       ]
 
@@ -790,6 +797,10 @@ routes pipe config = do
   post "/api/validateuser" $ do
     providedPin <- param "pin"
     sess <- param "session"
+    let pinHash =
+          BLK.hash
+            [ BA.pack . BS.unpack . C.pack . T.unpack $ providedPin <> sess :: BA.Bytes
+            ]
     user <- liftAndCatchIO $ run (findUser sess)
     case user of
       Nothing -> status noContent204 --`debug` "No user match"
@@ -798,7 +809,10 @@ routes pipe config = do
         case parsedUser of
           Nothing -> status noContent204 --`debug` "Couldn't parse user"
           Just pUser -> do
-            let ans = upin pUser == T.pack providedPin
+            let ans =
+                  upin pUser ==
+                  (T.pack . show $
+                   (pinHash :: BLK.Digest BLK.DEFAULT_DIGEST_LEN))
             if ans
               then do
                 liftAndCatchIO $ run (validateUser sess)

test/Spec.hs

@@ -176,7 +176,7 @@ main = do
             req <-
               testGet
                 "/api/user"
-                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")]
+                [("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca")]
             res <- httpJSON req
             getResponseStatus (res :: Response A.Value) `shouldBe` ok200
           it "returns 204 when no user" $ do
@@ -190,8 +190,8 @@ main = do
             req <-
               testPost
                 "/api/validateuser"
-                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdcd")
-                , ("pin", Just "1234567")
+                [ ("session", Just "35bfb9c2-9ad2-4fe5-adda-99d63b8dcdca")
+                , ("pin", Just "8227514")
                 ]
             res <- httpLBS req
             getResponseStatus res `shouldBe` accepted202

zgotest.cfg

@@ -10,7 +10,7 @@ port = 3000
 tls = false
 certificate = "/path/to/cert.pem"
 key = "/path/to/key.pem"
-mailHost = "127.0.0.1"
-mailPort = 1025
-mailUser = "contact@zgo.cash"
-mailPwd = "uib3K8BkCPexl_wr5bYfrg"
+smtpHost = "127.0.0.1"
+smtpPort = 1025
+smtpUser = "contact@zgo.cash"
+smtpPwd = "uib3K8BkCPexl_wr5bYfrg"