This commit is contained in:
Rene Vergara 2023-02-01 12:49:33 -06:00
parent 42957547a9
commit 683f49d069
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
7 changed files with 32 additions and 7 deletions

View File

@ -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

View File

@ -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:

View File

@ -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 =

View File

@ -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"

View File

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

View File

@ -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

View File

@ -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