From 683f49d06964a4d9a0d11c8956918d644c2e0629 Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Wed, 1 Feb 2023 12:49:33 -0600
Subject: [PATCH] Fix #5

---
 CHANGELOG.md      |  6 ++++++
 package.yaml      |  3 ++-
 src/User.hs       | 12 ++++++++++--
 src/ZGoBackend.hs |  7 ++++---
 stack.yaml        |  1 +
 stack.yaml.lock   |  7 +++++++
 zgo-backend.cabal |  3 ++-
 7 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 8fb3b7d..06f7a55 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).
 
+## [1.2.5] - 2023-02-01
+
+### Fixed
+
+- Replaced the PIN generation with the cryptographically-secure `crypto-rng`.
+
 ## [1.2.4] - 2023-01-30
 
 ### Changed
diff --git a/package.yaml b/package.yaml
index 210a5b0..e1d9519 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                zgo-backend
-version:             1.2.4
+version:             1.2.5
 git:                 "https://git.vergara.tech/Vergara_Tech/zgo-backend"
 license:             BOSL
 author:              "Rene Vergara"
@@ -59,6 +59,7 @@ library:
   - memory
   - ghc-prim
   - network
+  - crypto-rng
 
 executables:
   zgo-backend-exe:
diff --git a/src/User.hs b/src/User.hs
index 7e933d6..8d2817a 100644
--- a/src/User.hs
+++ b/src/User.hs
@@ -6,6 +6,8 @@ module User where
 
 import Control.Monad
 import Control.Monad.IO.Class
+import Crypto.RNG
+import Crypto.RNG.Utils
 import Data.Aeson
 import qualified Data.Bson as B
 import Data.Maybe
@@ -99,12 +101,18 @@ validateUser session =
     (select ["session" =: session] "users")
     ["$set" =: ["validated" =: True]]
 
-generatePin :: Int -> IO T.Text
-generatePin s = do
+generatePin' :: Int -> IO T.Text
+generatePin' s = do
   let g = mkStdGen s
   pure $
     T.pack (padLeft (show . head $ randomRs (1 :: Integer, 10000000) g) '0' 7)
 
+generatePin :: IO String
+generatePin = do
+  rngState <- newCryptoRNGState
+  runCryptoRNGT rngState $
+    randomString 7 ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']
+
 -- | Helper function to pad a string to a given length
 padLeft :: String -> Char -> Int -> String
 padLeft s c m =
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 6242898..10db309 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -426,11 +426,12 @@ addUser _ _ _ _ _ Nothing = return () --`debug` "addUser got Nothing"
 addUser nodeUser nodePwd p db node (Just tx) = do
   isNew <- liftIO $ isUserNew p db tx
   when isNew $ do
-    let newPin = unsafePerformIO (generatePin (fromIntegral $ blocktime tx))
-    _ <- sendPin nodeUser nodePwd node (address tx) newPin
+    newPin <- liftIO generatePin
+    _ <- sendPin nodeUser nodePwd node (address tx) (T.pack newPin)
     let pinHash =
           BLK.hash
-            [ BA.pack . BS.unpack . C.pack . T.unpack $ newPin <> session tx :: BA.Bytes
+            [ BA.pack . BS.unpack . C.pack . T.unpack $
+              T.pack newPin <> session tx :: BA.Bytes
             ]
     insert_
       "users"
diff --git a/stack.yaml b/stack.yaml
index 1b263b1..48755d1 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -45,6 +45,7 @@ extra-deps:
   - git: https://github.com/reach-sh/haskell-hexstring.git
     commit: 085c16fb21b9f856a435a3faab980e7e0b319341
   - blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
+  - crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 # Override default flag values for local packages and extra-deps
 # flags: {}
 
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 7ed2b05..f3f90bb 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -22,6 +22,13 @@ packages:
       size: 1433
   original:
     hackage: blake3-0.2@sha256:d1146b9a51ccfbb0532780778b6d016a614e3d44c05d8c1923dde9a8be869045,2448
+- completed:
+    hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
+    pantry-tree:
+      sha256: 1caccafe35d1ae3063f057c31188742a8e794f4f4e4530bab4019c0a514ee54f
+      size: 455
+  original:
+    hackage: crypto-rng-0.3.0.1@sha256:04f4ae75943ecad8b794950985054130f272d65a588b6b6528f56df0bfedc4dc,1565
 snapshots:
 - completed:
     sha256: bfafe5735ccb74527d754b1f9999ded72d7c3a6c3a88529449661431ccfbd6cc
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index c8efe1f..6178642 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zgo-backend
-version:        1.2.3
+version:        1.2.5
 synopsis:       Haskell Back-end for the ZGo point-of-sale application
 description:    Please see the README at <https://git.vergara.tech/Vergara_Tech//zgo-backend#readme>
 category:       Web
@@ -51,6 +51,7 @@ library
     , bytestring
     , configurator
     , containers
+    , crypto-rng
     , ghc-prim
     , hexstring
     , http-conduit