{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

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
import qualified Data.Text as T
import Database.MongoDB
import GHC.Generics
import System.IO.Unsafe
import System.Random
import ZGoTx

-- | Type to represent a ZGo User, i.e.: a specific device
data User =
  User
    { u_id :: Maybe ObjectId
    , uaddress :: T.Text
    , usession :: T.Text
    , ublocktime :: Integer
    , upin :: T.Text
    , uvalidated :: Bool
    }
  deriving (Eq, Show, Generic)

instance ToJSON User where
  toJSON (User i a s bt p v) =
    case i of
      Just oid ->
        object
          [ "_id" .= show oid
          , "address" .= a
          , "session" .= s
          , "blocktime" .= bt
          , "validated" .= v
          ]
      Nothing ->
        object
          [ "_id" .= ("" :: String)
          , "address" .= a
          , "session" .= s
          , "blocktime" .= bt
          , "validated" .= v
          ]

instance FromJSON User where
  parseJSON =
    withObject "User" $ \obj -> do
      i <- obj .: "_id"
      a <- obj .: "address"
      s <- obj .: "session"
      bt <- obj .: "blocktime"
      v <- obj .: "validated"
      pure $
        User
          (if not (null i)
             then Just (read i)
             else Nothing)
          a
          s
          bt
          ""
          v

instance Val User where
  cast' (Doc d) = do
    i <- B.lookup "_id" d
    a <- B.lookup "address" d
    s <- B.lookup "session" d
    b <- B.lookup "blocktime" d
    p <- B.lookup "pin" d
    v <- B.lookup "validated" d
    Just $ User i a s b p v
  cast' _ = Nothing
  val (User i a s b p v) =
    case i of
      Just oid ->
        Doc
          [ "_id" =: oid
          , "address" =: a
          , "session" =: s
          , "blocktime" =: b
          , "pin" =: p
          , "validated" =: v
          ]
      Nothing ->
        Doc
          [ "address" =: a
          , "session" =: s
          , "blocktime" =: b
          , "pin" =: p
          , "validated" =: v
          ]

parseUserBson :: B.Document -> Maybe User
parseUserBson d = do
  i <- B.lookup "_id" d
  a <- B.lookup "address" d
  s <- B.lookup "session" d
  b <- B.lookup "blocktime" d
  p <- B.lookup "pin" d
  v <- B.lookup "validated" d
  pure $ User i a s b p v

-- Database Actions
-- | Function to query DB for unexpired user by session ID
findUser :: T.Text -> Action IO (Maybe Document)
findUser s = findOne (select ["session" =: s] "users")

findUserById :: String -> Action IO (Maybe Document)
findUserById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "users")

-- | Function to delete user by ID
deleteUser :: String -> Action IO ()
deleteUser i = deleteOne (select ["_id" =: (read i :: B.ObjectId)] "users")

-- | Function to verify if the given ZGoTx represents an already existing User
isUserNew :: Pipe -> T.Text -> ZGoTx -> IO Bool
isUserNew p db tx =
  isNothing <$>
  access p master db (findOne (select ["session" =: session tx] "users"))

-- | Function to verify if the given session has a valid user
isUserValid :: Pipe -> T.Text -> T.Text -> IO Bool
isUserValid p db s =
  isJust <$>
  access
    p
    master
    db
    (findOne (select ["session" =: s, "validated" =: True] "users"))

-- | Function to mark user as validated
validateUser :: T.Text -> Action IO ()
validateUser session =
  modify
    (select ["session" =: session] "users")
    ["$set" =: ["validated" =: True]]

generatePin :: IO String
generatePin = do
  rngState <- newCryptoRNGState
  runCryptoRNGT rngState $
    randomString 7 ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9']