From 6d14ccd48af3e392e78f860659244558594121b4 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Thu, 26 Jan 2023 12:13:17 -0600
Subject: [PATCH 1/3] Implement pin hardening

---
 src/ZGoBackend.hs | 9 ++++++++-
 test/Spec.hs      | 2 +-
 zgotest.cfg       | 8 ++++----
 3 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 78728e4..8485a92 100644
--- a/src/ZGoBackend.hs
+++ b/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
       ]
 
diff --git a/test/Spec.hs b/test/Spec.hs
index 6d1137d..1946b5b 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -521,7 +521,7 @@ main = do
                       ["expiration" =: ["$lt" =: now], "paid" =: True]
                       "owners"))
             res `shouldBe` []
-          xit "login txs are converted to users" $ \p -> do
+          it "login txs are converted to users" $ \p -> do
             let myTx =
                   ZGoTx
                     Nothing
diff --git a/zgotest.cfg b/zgotest.cfg
index 673b5ca..4fc6230 100644
--- a/zgotest.cfg
+++ b/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"

From a17e8d6f2aabf002379a6935bca524aef091a5b1 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 27 Jan 2023 11:01:05 -0600
Subject: [PATCH 2/3] Implement BLAKE3 for PIN hashing

---
 CHANGELOG.md      | 6 ++++++
 src/ZGoBackend.hs | 9 ++++++++-
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index d5c87db..d340e26 100644
--- a/CHANGELOG.md
+++ b/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
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 8485a92..db35406 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -797,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"
@@ -805,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)

From 59ff5a29c7b1d855b9a8f2126abe565e21963e0c Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 27 Jan 2023 11:15:03 -0600
Subject: [PATCH 3/3] Implement test

---
 test/Spec.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/test/Spec.hs b/test/Spec.hs
index 1946b5b..0d50804 100644
--- a/test/Spec.hs
+++ b/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
@@ -521,7 +521,7 @@ main = do
                       ["expiration" =: ["$lt" =: now], "paid" =: True]
                       "owners"))
             res `shouldBe` []
-          it "login txs are converted to users" $ \p -> do
+          xit "login txs are converted to users" $ \p -> do
             let myTx =
                   ZGoTx
                     Nothing