<commit_before>module Bead.View.Snap.DataBridge where

import Control.Monad (join)
import Data.Time (UTCTime(..))

import Bead.Domain.Types (readMaybe)
import Bead.Domain.Entities
import Bead.Domain.Relationships
import Bead.Domain.Shared.Evaluation
import Bead.View.Snap.TemplateAndComponentNames
import Bead.View.Snap.Fay.Hooks
import Bead.View.Snap.Fay.HookIds
import Bead.View.Snap.Validators
import Bead.View.Snap.RouteOf

{-
Parameters are the data bridge between the Server side and the Client side.
Values are encoded and decoded in the request parameters
-}

-- | Represents an encoding/decoding method for the request parameters
data Parameter a = Parameter {
    -- Produces a String representation of the given value
    encode :: a -> String
    -- Produces 'Just a' if the given string is represents a value
    -- otherwise 'Nothing'
  , decode :: String -> Maybe a
    -- The field name in the request
  , name  :: String
    -- The error message when decoding fails
  , decodeError :: String -> String
    -- The error message when the parameter is not present
  , notFound    :: String
  }

parameterFold
  :: ((a -> String) -> (String -> Maybe a) -> String -> (String -> String) -> String -> b)
  -> Parameter a
  -> b
parameterFold f (Parameter encode decode name decodeError notFound) =
  f encode decode name decodeError notFound

-- Creates a request parameter value encoding the given value with the
-- given parameter
requestParameter :: Parameter a -> a -> ReqParam
requestParameter p x = parameterFold createValue p
  where
    createValue encode _ name _ _ = ReqParam (name, encode x)

stringParameter :: String -> String -> Parameter String
stringParameter fieldName paramName = Parameter {
    encode = id
  , decode = Just . id
  , name = fieldName
  , decodeError = \m -> join [paramName, " is not decoded: ", m]
  , notFound    = join [paramName, " is not found."]
  }

evaluationValuePrm :: Parameter String
evaluationValuePrm = stringParameter (fieldName evaluationValueField) "Evaluation Value"

customGroupKeyPrm :: String -> Parameter GroupKey
customGroupKeyPrm field = Parameter {
    encode = groupKeyMap id
  , decode = Just . GroupKey
  , name   = field
  , decodeError = ("Invalid Group Key is given: "++)
  , notFound    = "Group Key is not found"
  }

-- Represents the GroupKey parameter
groupKeyPrm :: Parameter GroupKey
groupKeyPrm = customGroupKeyPrm (fieldName groupKeyName)

customCourseKeyPrm :: String -> Parameter CourseKey
customCourseKeyPrm field = Parameter {
    encode = courseKeyMap id
  , decode = Just . CourseKey
  , name   = field
  , decodeError = ("Invalid Course Key is given: "++)
  , notFound    = "Course Key is not found"
  }

-- Represents the CourseKey parameter
courseKeyPrm :: Parameter CourseKey
courseKeyPrm = customCourseKeyPrm (fieldName courseKeyInfo)

-- Represents the AssignmentKey parameter
assignmentKeyPrm :: Parameter AssignmentKey
assignmentKeyPrm = Parameter {
    encode = assignmentKeyMap id
  , decode = Just . AssignmentKey
  , name   = fieldName assignmentKeyField
  , decodeError = ("Invalid Assignment Key is given: "++)
  , notFound    = "Assignment Key is not found"
  }

-- Represents the SubmissionKey parameter
submissionKeyPrm :: Parameter SubmissionKey
submissionKeyPrm = Parameter {
    encode = submissionKeyMap id
  , decode = Just . SubmissionKey
  , name   = fieldName submissionKeyField
  , decodeError = ("Invalid Submission Key is given: "++)
  , notFound    = "Submission Key is not found"
  }

-- Represents the SubmissionKey parameter
evaluationKeyPrm :: Parameter EvaluationKey
evaluationKeyPrm = Parameter {
    encode = evaluationKeyMap id
  , decode = Just . EvaluationKey
  , name   = fieldName evaluationKeyField
  , decodeError = ("Invalid Evaluation Key is given: "++)
  , notFound    = "Evaluation Key is not found"
  }

evalConfigPrm :: EvaluationHook -> Parameter EvaluationConfig
evalConfigPrm hook = Parameter {
    encode = show
  , decode = readEvalConfig
  , name   = evHiddenValueId hook
  , decodeError = ("Invalid evaluation config is given: "++)
  , notFound = "Evaluation config is not found"
  }
  where
    readEvalConfig :: String -> Maybe (EvaluationData () PctConfig)
    readEvalConfig = fmap convert . readMaybe
      where
        convert :: EvaluationData () Double -> EvaluationData () PctConfig
        convert = evaluationDataMap (BinEval . id) (PctEval . PctConfig)

rolePrm :: Parameter Role
rolePrm = Parameter {
    encode = show
  , decode = parseRole
  , name   = fieldName userRoleField
  , decodeError = ("Invalid role is given: "++)
  , notFound    = "Role is not found"
  }

customUsernamePrm :: String -> Parameter Username
customUsernamePrm field = Parameter {
    encode = usernameCata id
  , decode = decodeUsr
  , name = field
  , decodeError = ((message isUsername ++ ": ") ++)
  , notFound    = "Username is not found"
  } where
    decodeUsr xs =
      if (validator isUsername xs)
         then (Just $ Username xs)
         else Nothing

usernamePrm :: Parameter Username
usernamePrm = customUsernamePrm (fieldName usernameField)

loginUsernamePrm :: Parameter Username
loginUsernamePrm = customUsernamePrm (fieldName loginUsername)

emailPrm :: String -> Parameter Email
emailPrm field = validateBy isEmailAddress $ Parameter {
    encode = emailFold id
  , decode = parseEmail
  , name = field
  , decodeError = ("Invalid email is given: "++)
  , notFound = "Email is not found"
  }

userEmailPrm :: Parameter Email
userEmailPrm = emailPrm (fieldName userEmailField)

regEmailPrm :: Parameter Email
regEmailPrm = emailPrm (fieldName regEmailAddress)

regPasswordPrm :: Parameter String
regPasswordPrm = validateBy isPassword $ stringParameter (fieldName loginPassword) "Password"

regPasswordAgainPrm :: Parameter String
regPasswordAgainPrm = validateBy isPassword $ stringParameter (fieldName regPasswordAgain) "Password Again"

loginPasswordPrm :: Parameter String
loginPasswordPrm = validateBy isPassword $ stringParameter (fieldName loginPassword) "Login password"

oldPasswordPrm :: Parameter String
oldPasswordPrm = validateBy isPassword $ stringParameter (fieldName oldPasswordField) "Old password"

newPasswordPrm :: Parameter String
newPasswordPrm = validateBy isPassword $ stringParameter (fieldName newPasswordField) "New password"

newPasswordAgainPrm :: Parameter String
newPasswordAgainPrm = validateBy isPassword $ stringParameter (fieldName newPasswordAgainField) "New password again"

studentNewPwdPrm :: Parameter String
studentNewPwdPrm = validateBy isPassword $ stringParameter (fieldName studentNewPwdField) "Student's new password"

studentNewPwdAgainPrm :: Parameter String
studentNewPwdAgainPrm = validateBy isPassword $ stringParameter (fieldName studentNewPwdAgainField) "Student's new password "

regUsernamePrm :: Parameter Username
regUsernamePrm = validateBy isUsername $ customUsernamePrm (fieldName loginUsername)

regFullNamePrm :: Parameter String
regFullNamePrm = stringParameter (fieldName regFullName) "<NAME>"<commit_msg>Password parameters does not show the wrong values<commit_after>module Bead.View.Snap.DataBridge where

import Control.Monad (join)
import Data.Time (UTCTime(..))

import Bead.Domain.Types (readMaybe)
import Bead.Domain.Entities
import Bead.Domain.Relationships
import Bead.Domain.Shared.Evaluation
import Bead.View.Snap.TemplateAndComponentNames
import Bead.View.Snap.Fay.Hooks
import Bead.View.Snap.Fay.HookIds
import Bead.View.Snap.Validators
import Bead.View.Snap.RouteOf

{-
Parameters are the data bridge between the Server side and the Client side.
Values are encoded and decoded in the request parameters
-}

-- | Represents an encoding/decoding method for the request parameters
data Parameter a = Parameter {
    -- Produces a String representation of the given value
    encode :: a -> String
    -- Produces 'Just a' if the given string is represents a value
    -- otherwise 'Nothing'
  , decode :: String -> Maybe a
    -- The field name in the request
  , name  :: String
    -- The error message when decoding fails
  , decodeError :: String -> String
    -- The error message when the parameter is not present
  , notFound    :: String
  }

parameterFold
  :: ((a -> String) -> (String -> Maybe a) -> String -> (String -> String) -> String -> b)
  -> Parameter a
  -> b
parameterFold f (Parameter encode decode name decodeError notFound) =
  f encode decode name decodeError notFound

-- Creates a request parameter value encoding the given value with the
-- given parameter
requestParameter :: Parameter a -> a -> ReqParam
requestParameter p x = parameterFold createValue p
  where
    createValue encode _ name _ _ = ReqParam (name, encode x)

stringParameter :: String -> String -> Parameter String
stringParameter fieldName paramName = Parameter {
    encode = id
  , decode = Just . id
  , name = fieldName
  , decodeError = \m -> join [paramName, " is not decoded: ", m]
  , notFound    = join [paramName, " is not found."]
  }

evaluationValuePrm :: Parameter String
evaluationValuePrm = stringParameter (fieldName evaluationValueField) "Evaluation Value"

customGroupKeyPrm :: String -> Parameter GroupKey
customGroupKeyPrm field = Parameter {
    encode = groupKeyMap id
  , decode = Just . GroupKey
  , name   = field
  , decodeError = ("Invalid Group Key is given: "++)
  , notFound    = "Group Key is not found"
  }

-- Represents the GroupKey parameter
groupKeyPrm :: Parameter GroupKey
groupKeyPrm = customGroupKeyPrm (fieldName groupKeyName)

customCourseKeyPrm :: String -> Parameter CourseKey
customCourseKeyPrm field = Parameter {
    encode = courseKeyMap id
  , decode = Just . CourseKey
  , name   = field
  , decodeError = ("Invalid Course Key is given: "++)
  , notFound    = "Course Key is not found"
  }

-- Represents the CourseKey parameter
courseKeyPrm :: Parameter CourseKey
courseKeyPrm = customCourseKeyPrm (fieldName courseKeyInfo)

-- Represents the AssignmentKey parameter
assignmentKeyPrm :: Parameter AssignmentKey
assignmentKeyPrm = Parameter {
    encode = assignmentKeyMap id
  , decode = Just . AssignmentKey
  , name   = fieldName assignmentKeyField
  , decodeError = ("Invalid Assignment Key is given: "++)
  , notFound    = "Assignment Key is not found"
  }

-- Represents the SubmissionKey parameter
submissionKeyPrm :: Parameter SubmissionKey
submissionKeyPrm = Parameter {
    encode = submissionKeyMap id
  , decode = Just . SubmissionKey
  , name   = fieldName submissionKeyField
  , decodeError = ("Invalid Submission Key is given: "++)
  , notFound    = "Submission Key is not found"
  }

-- Represents the SubmissionKey parameter
evaluationKeyPrm :: Parameter EvaluationKey
evaluationKeyPrm = Parameter {
    encode = evaluationKeyMap id
  , decode = Just . EvaluationKey
  , name   = fieldName evaluationKeyField
  , decodeError = ("Invalid Evaluation Key is given: "++)
  , notFound    = "Evaluation Key is not found"
  }

evalConfigPrm :: EvaluationHook -> Parameter EvaluationConfig
evalConfigPrm hook = Parameter {
    encode = show
  , decode = readEvalConfig
  , name   = evHiddenValueId hook
  , decodeError = ("Invalid evaluation config is given: "++)
  , notFound = "Evaluation config is not found"
  }
  where
    readEvalConfig :: String -> Maybe (EvaluationData () PctConfig)
    readEvalConfig = fmap convert . readMaybe
      where
        convert :: EvaluationData () Double -> EvaluationData () PctConfig
        convert = evaluationDataMap (BinEval . id) (PctEval . PctConfig)

rolePrm :: Parameter Role
rolePrm = Parameter {
    encode = show
  , decode = parseRole
  , name   = fieldName userRoleField
  , decodeError = ("Invalid role is given: "++)
  , notFound    = "Role is not found"
  }

customUsernamePrm :: String -> Parameter Username
customUsernamePrm field = Parameter {
    encode = usernameCata id
  , decode = decodeUsr
  , name = field
  , decodeError = ((message isUsername ++ ": ") ++)
  , notFound    = "Username is not found"
  } where
    decodeUsr xs =
      if (validator isUsername xs)
         then (Just $ Username xs)
         else Nothing

usernamePrm :: Parameter Username
usernamePrm = customUsernamePrm (fieldName usernameField)

loginUsernamePrm :: Parameter Username
loginUsernamePrm = customUsernamePrm (fieldName loginUsername)

emailPrm :: String -> Parameter Email
emailPrm field = validateBy isEmailAddress $ Parameter {
    encode = emailFold id
  , decode = parseEmail
  , name = field
  , decodeError = ("Invalid email is given: "++)
  , notFound = "Email is not found"
  }

userEmailPrm :: Parameter Email
userEmailPrm = emailPrm (fieldName userEmailField)

regEmailPrm :: Parameter Email
regEmailPrm = emailPrm (fieldName regEmailAddress)

passwordPrm :: String -> String -> Parameter String
passwordPrm fieldName paramName = Parameter {
    encode = id
  , decode = Just . id
  , name = fieldName
  , decodeError = const "Invalid password"
  , notFound    = join [paramName, " is not found."]
  }

regPasswordPrm :: Parameter String
regPasswordPrm = validateBy isPassword $ passwordPrm (fieldName loginPassword) "Password"

regPasswordAgainPrm :: Parameter String
regPasswordAgainPrm = validateBy isPassword $ passwordPrm (fieldName regPasswordAgain) "Password Again"

loginPasswordPrm :: Parameter String
loginPasswordPrm = validateBy isPassword $ passwordPrm (fieldName loginPassword) "Login password"

oldPasswordPrm :: Parameter String
oldPasswordPrm = validateBy isPassword $ passwordPrm (fieldName oldPasswordField) "Old password"

newPasswordPrm :: Parameter String
newPasswordPrm = validateBy isPassword $ passwordPrm (fieldName newPasswordField) "New password"

newPasswordAgainPrm :: Parameter String
newPasswordAgainPrm = validateBy isPassword $ passwordPrm (fieldName newPasswordAgainField) "New password again"

studentNewPwdPrm :: Parameter String
studentNewPwdPrm = validateBy isPassword $ passwordPrm (fieldName studentNewPwdField) "Student's new password"

studentNewPwdAgainPrm :: Parameter String
studentNewPwdAgainPrm = validateBy isPassword $ passwordPrm (fieldName studentNewPwdAgainField) "Student's new password "

regUsernamePrm :: Parameter Username
regUsernamePrm = validateBy isUsername $ customUsernamePrm (fieldName loginUsername)

regFullNamePrm :: Parameter String
regFullNamePrm = stringParameter (fieldName regFullName) "Full Name"
{'fraction_non_alphanumeric': 0.08008098861970257, 'fraction_numerical': 0.0, 'mean_word_length': 4.178597252349964, 'pattern_counts': {'":': 2, '<': 4, '<?xml version=': 0, '>': 56, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4604476', 'n_tokens_mistral': 3969, 'n_tokens_neox': 3907, 'n_words': 1331}