Fix #5

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

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:

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' :: Int -> IO T.Text
-generatePin s = do
+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 =

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))
+    newPin <- liftIO generatePin
-    _ <- sendPin nodeUser nodePwd node (address tx) newPin
+    _ <- 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"

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: {}
 

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

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