Stabilize currency rounding and API RBAC tests; add swagger test and CI scaffolding#4
Merged
dominicusin merged 34 commits intomainfrom Apr 11, 2026
Merged
Stabilize currency rounding and API RBAC tests; add swagger test and CI scaffolding#4dominicusin merged 34 commits intomainfrom
dominicusin merged 34 commits intomainfrom
Conversation
…uplicate routes, stabilize Hasql pool
…ton (Hasql-based)
…alance; add NonNeg type alias in Accounting.Types; annotate trialBalance; ensure non-negative stock balance
…ns runMutationReturningIds
…searchGoods wired
…PI modules - Fix name shadowing in Document, Invoice, Warehouse, Order, Price, RetBill, SmartReceipt - Remove duplicate exports in Payroll Types, Invoice exports - Add missing constructors to Permission type in RBAC - Add pattern matches for new Permission constructors - Fix unused imports across multiple API modules - Fix isNotFoundMessage to use proper Text type - Fix unused pattern variable in WebSocket - Remove orphan Arbitrary instances, move to type modules - Add FunctionalDependencies pragma for HasRepository class
…e unused class The generic Repository class with type families was causing complex import cycles and was not actually being used by most repositories. Simplifying to just the HasRepository class which is what most code actually needs.
- Remove unused runXRepository functions from repository modules - Remove unused imports (runExceptT, Data.Time, getBills, etc.) - Add missing DAL.Repository.Person and DAL.Repository.Goods modules - Update DAL.hs exports to exclude removed modules - Add Arbitrary instances for AccTurn and Accrual in Core.Accounting.Types - Fix RBACSpec unused imports and variable warnings - Remove duplicate Repository class, simplify to HasRepository pattern
- Add AdminAccess and UsersWrite permissions to adminRole - Fix verifyDoubleEntry to use atDbtAmt/atCrdAmt fields instead of atAmount - Add explicit pattern matching for AccOpResult in property - Fix RBACSpec to use correct imports (Surypus.RBAC not Surypus.RBAC.Store)
- Replace undefined in PayrollService.computeNetSalary with error message - Replace undefined values in CrystalToJasper with proper empty lists - Clean up code by removing unnecessary undefined placeholders
- Re-export core subsystems: Core, RBAC, JWT, Types, Error, Validation, Cache - Re-export API modules: Server, Authorization, Health - Re-export infrastructure: Reports, Config, Event, I18n, Logging - Enables 'import Surypus' to get comprehensive ERP functionality
LiquidHaskell: - Core.Invoice: add NonNeg, Percent types and calcInvoiceBalance annotation - Core.Payment: add NonNeg type, annotate isCompleted, canRefund, calcPaymentAmount - Core.Inventory.Types.Location: add LocationId type - Core.Currency: add NonNeg, Precision, Rate types, annotate convertAmount, roundToCurrency - Core.Auth.Operations: add NonNeg type, annotate checkSessionValid, calcSessionRemainingTime API Extension: - Add VAT API endpoint (/v1/vat/calculate, /v1/vat/rates) - Add VATCalcRequest and VATCalcResponse types - Implement vatCalculate handler with proper VAT calculation - Fix ambiguous field name (vatRate -> vatAppliedRate) - Add taxType and taxInclusive to TaxRequest/TaxResponse
- Add SalaryDetails type to Core.Payroll.Types with LiquidHaskell annotations - Implement computeNetSalary using calcNetSalaryFromGross - Remove placeholder error, add actual salary calculation logic
- Delete old APIServer.hs using Scotty - Update Main.hs to use Servant server - Remove scotty dependency from Surypus.cabal - Add missing dependencies for executable
- Add APIWithDoc type with swagger.json endpoint - Add apiSwagger placeholder value - Update Server to serve Swagger JSON - Add OverloadedStrings extension for Value
- TaxRepository: TaxRate type, CRUD operations - PaymentRepository: NonNegAmount type, CRUD operations - CurrencyRepository: CurrencyCode, ExchangeRate types - GoodsRepository: GoodsPrice, GoodsQty types All repositories now have refinement type annotations for invariants
- Add Integration.ValidationSpec module - Add Arbitrary instances for all input types - Add validation property tests for INN, KPP, phone - Add validation tests for all entity inputs Add to test-suite: Integration.ValidationSpec
WalkthroughThis PR performs extensive architectural refactoring, removing the monolithic Changes
Estimated code review effort🎯 4 (Complex) | ⏱️ ~60 minutes Possibly related PRs
Poem
✨ Finishing Touches🧪 Generate unit tests (beta)
|
Review Summary by QodoStabilize core with LiquidHaskell refinements, refactor API handlers, and expand test coverage
WalkthroughsDescription• **Refactor API handlers to use actual database queries** instead of mock data, with Servant integration and Swagger documentation support • **Add LiquidHaskell refinement types** across core modules (Currency, Payment, Accounting, Invoice, Auth) to enforce invariants and improve type safety • **Simplify repository layer** by removing generic Repository typeclass pattern and replacing with direct query functions; update HasRepository to use getPool method • **Fix variable shadowing issues** in multiple core modules (Invoice, Document, Accounting, Warehouse, Order, Price, RetBill, SmartReceipt, Core) to improve code clarity • **Expand RBAC permissions** with 27 new permission types for tax, sync, audit, JDBC, cache, metrics, health, and WebSocket operations • **Add comprehensive property-based tests** with QuickCheck for validation layer, accounting operations, warehouse, payroll, and bill domains • **Ensure non-negative stock balance calculation** and fix accounting operations to use correct field names (atDbtAmt, atCrdAmt) • **Add new API modules** for Location, Payment, Order, Currency, and Stock endpoints with CRUD operations • **Clean up imports and unused code** across multiple modules; remove unused pragmas and parameters • **Simplify service layer** (Accounting, Payroll, Inventory) to phase 1 skeleton implementations • **Migrate to Servant API server** with JWT and RBAC configuration in Main.hs • **Add Arbitrary instances** for test data generation in Lot, Accounting, and Invoice types • **Simplify database row decoders** using function composition throughout DAL modules Diagramflowchart LR
A["API Handlers<br/>Mock Data"] -->|"Refactor to DB Queries"| B["Servant API Server<br/>with Swagger"]
C["Generic Repository<br/>Pattern"] -->|"Simplify & Inline"| D["Direct Query<br/>Functions"]
E["Core Modules<br/>Untyped"] -->|"Add LiquidHaskell<br/>Refinements"| F["Type-Safe<br/>Operations"]
G["Limited RBAC<br/>Permissions"] -->|"Expand to 27<br/>Permission Types"| H["Comprehensive<br/>Access Control"]
I["Basic Tests"] -->|"Add Property-Based<br/>Tests & Arbitrary"| J["Comprehensive<br/>Test Coverage"]
B --> K["Production Ready<br/>API Layer"]
D --> K
F --> K
H --> K
J --> K
File Changes1. src/Surypus/API/Server.hs
|
Code Review by Qodo
|
CI Feedback 🧐A test triggered by this PR failed. Here is an AI-generated analysis of the failure:
|
Comment on lines
+8
to
+11
| import Data.Int (Int64) | ||
| import Data.Text (Text) | ||
| import qualified Data.Text as Text | ||
| import Data.Time (Day, fromGregorian) |
There was a problem hiding this comment.
1. data.text imported as text 📘 Rule violation ⚙ Maintainability
Core.Invoice imports Data.Text as Text and uses Text.pack, which violates the documented convention requiring qualified Data.Text as T when used qualified. This reduces consistency and can confuse readers across the codebase.
Agent Prompt
## Issue description
`src/Core/Invoice.hs` qualifies `Data.Text` as `Text` and calls `Text.pack`, but the repo convention requires `qualified Data.Text as T` when using qualified `Text` functions.
## Issue Context
Consistency in import qualification is required by compliance (PR Compliance ID 2).
## Fix Focus Areas
- src/Core/Invoice.hs[8-11]
- src/Core/Invoice.hs[45-45]
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
Comment on lines
+9
to
+14
| import DAL.Types | ||
| import Data.Coerce (coerce) | ||
| import Data.Int (Int16) | ||
| import Data.Text (Text) | ||
| import qualified Data.Text as T | ||
| import Data.Time (Day, fromGregorian) |
There was a problem hiding this comment.
2. Unused imports in validationspec 📘 Rule violation ≡ Correctness
test/Integration/ValidationSpec.hs introduces unused imports (coerce, Int16, Text, Day), which will trigger unused-import warnings. With -Wall (and now -Werror) this can break CI builds.
Agent Prompt
## Issue description
`test/Integration/ValidationSpec.hs` imports several identifiers that are not used in the module, which will produce unused-import warnings (and fail builds under `-Werror`).
## Issue Context
The PR updates cabal GHC options to include `-Werror`, so unused imports are now build-breaking.
## Fix Focus Areas
- test/Integration/ValidationSpec.hs[9-14]
- Surypus.cabal[209-209]
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
| import qualified DAL.Repository.AuditLog as AuditLogRepo | ||
| import qualified DAL.Repository.RefreshToken as RefreshTokenRepo | ||
| import DAL.Types (AuditLog) | ||
| import DAL.Types (AuditLog, Bill (..), BillInput (..), Currency (..), Goods (..), GoodsInput (..), Location (..), LocationInput (..), Order (..), Payment (..), PaymentInput (..), Person (..), PersonInput (..), QueryResult (..)) |
There was a problem hiding this comment.
3. Lines exceed 100 characters 📘 Rule violation ⚙ Maintainability
Multiple newly added/modified lines exceed the 100-character limit (e.g., a very long DAL.Types import line in Surypus.API.Server). This violates the repository formatting standard and reduces readability.
Agent Prompt
## Issue description
Several lines added in this PR exceed the 100-character limit (imports and long expressions), violating the repo formatting standard.
## Issue Context
This is a style compliance requirement; wrapping improves readability and keeps diffs consistent.
## Fix Focus Areas
- src/Surypus/API/Server.hs[18-18]
- test/Integration/PropertySpec.hs[51-53]
- test/Integration/ValidationSpec.hs[46-49]
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
Comment on lines
+46
to
+49
| putStrLn "Starting Servant API server..." | ||
| jwtCfg <- defaultJWTConfig | ||
| rbacStore <- mkRBACStore pool | ||
| startServantServer 3000 pool jwtCfg rbacStore |
There was a problem hiding this comment.
4. Missing defaultjwtconfig 🐞 Bug ≡ Correctness
src/Main.hs imports and calls Surypus.JWT.defaultJWTConfig, but Surypus.JWT does not define/export it, so the executable will not compile.
Agent Prompt
### Issue description
`Main` calls `defaultJWTConfig`, but `Surypus.JWT` doesn’t export (or define) it, which breaks the build.
### Issue Context
`Surypus.JWT` already has `jwtConfigFromSecret` and related helpers; `Main` likely needs a default config built from an env var or a constant.
### Fix Focus Areas
- src/Main.hs[26-62]
- src/Surypus/JWT.hs[21-35]
### Suggested fix
- Option A: Add `defaultJWTConfig :: IO JWTConfig` to `Surypus.JWT` (and export it) that reads a secret from env (or falls back to a safe default) and returns `jwtConfigFromSecret secret`.
- Option B: Stop importing `defaultJWTConfig` and instead call `jwtConfigFromSecret` directly in `Main` (again sourcing secret from env/config).
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
Comment on lines
74
to
+77
| apiServer :: Pool -> JWTConfig -> RBACStore -> Application | ||
| apiServer pool jwtConfig rbacStore = | ||
| let env = Env pool jwtConfig rbacStore | ||
| in serve (Proxy @API) (server env) | ||
| in serve (Proxy @APIWithDoc) (serverWithDoc env) |
There was a problem hiding this comment.
5. Api lacks auth enforcement 🐞 Bug ⛨ Security
The Servant server exposes ProtectedAPI routes without any authentication/authorization enforcement: the API type has no auth combinator and apiServer/startServantServer do not wrap the application with JWT/RBAC middleware.
Agent Prompt
### Issue description
Protected endpoints are currently served without any authentication/authorization guard.
### Issue Context
- `ProtectedAPI` in `Surypus.API.Root` contains most business endpoints.
- `apiServer` uses `serve` directly and does not apply any WAI middleware.
- There are existing auth helpers/middlewares in the repo (`Surypus.API.AuthMiddleware`, `Surypus.API.JWT`).
### Fix Focus Areas
- src/Surypus/API/Root.hs[26-31]
- src/Surypus/API/Server.hs[74-136]
- src/Main.hs[43-62]
### Suggested fix
Pick one coherent approach:
1) **WAI middleware approach**: wrap the `Application` returned by `serve` with an authz middleware (e.g. `withAuthzResolverAdvanced`) using `requiredPermissionForPathMethod` and RBAC store lookups.
2) **Servant auth combinator approach**: add an `AuthProtect` (or equivalent) combinator to `ProtectedAPI`, provide an auth handler/context, and enforce permissions per-route.
Ensure the chosen approach is actually applied in `startServantServer` path.
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
Comment on lines
+376
to
+423
| adminRole :: RolePermission | ||
| adminRole = | ||
| RolePermission | ||
| RoleAdmin | ||
| [ AdminAccess, | ||
| PersonRead, | ||
| PersonWrite, | ||
| PersonDelete, | ||
| GoodsRead, | ||
| GoodsWrite, | ||
| GoodsDelete, | ||
| BillRead, | ||
| BillWrite, | ||
| BillDelete, | ||
| BillPost, | ||
| LocationRead, | ||
| LocationWrite, | ||
| LocationDelete, | ||
| UsersRead, | ||
| UsersWrite, | ||
| TaxRead, | ||
| TaxWrite, | ||
| TaxDelete, | ||
| SyncRead, | ||
| SyncWrite, | ||
| SyncDelete, | ||
| AuditRead, | ||
| AuditWrite, | ||
| AuditDelete, | ||
| RBACRead, | ||
| RBACWrite, | ||
| RBACDelete, | ||
| JDBCRead, | ||
| JDBCWrite, | ||
| JDBCDelete, | ||
| CacheRead, | ||
| CacheWrite, | ||
| CacheDelete, | ||
| MetricsRead, | ||
| MetricsWrite, | ||
| MetricsDelete, | ||
| HealthRead, | ||
| HealthWrite, | ||
| HealthDelete, | ||
| WSRead, | ||
| WSWrite, | ||
| WSDelete | ||
| ] |
There was a problem hiding this comment.
6. Admin permissions reduced 🐞 Bug ≡ Correctness
default adminRole no longer includes key permissions (e.g., PaymentRead/Write, StockRead, AccountingRead/Write), so users with role "admin" will be forbidden from core endpoints that require those permissions.
Agent Prompt
### Issue description
`adminRole` is missing permissions needed for endpoints guarded by `requiredPermissionForPathMethod`, breaking admin access.
### Issue Context
The routing layer requires e.g. `PaymentRead` for `/api/v1/payments`, `StockRead` for `/api/v1/stock`, etc. Admin should typically have superset access.
### Fix Focus Areas
- src/Surypus/RBAC.hs[376-423]
- src/Surypus/API/Authorization.hs[15-31]
### Suggested fix
- Add back the missing permissions to `adminRole` (Payment*, Stock*, Accounting*, Payroll*, Reports*, Orders*, TaxesWrite, CurrenciesWrite, SalariesWrite, etc.), OR
- Implement a deliberate override where `AdminAccess` implies all permissions (and adjust `checkPermission` accordingly), if that is the intended model.
Also add/adjust tests to ensure `RoleAdmin` can access every route in `requiredPermissionForPathMethod`.
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
Comment on lines
+102
to
+128
| | TaxRead | ||
| | TaxWrite | ||
| | TaxDelete | ||
| | SyncRead | ||
| | SyncWrite | ||
| | SyncDelete | ||
| | AuditRead | ||
| | AuditWrite | ||
| | AuditDelete | ||
| | RBACRead | ||
| | RBACWrite | ||
| | RBACDelete | ||
| | JDBCRead | ||
| | JDBCWrite | ||
| | JDBCDelete | ||
| | CacheRead | ||
| | CacheWrite | ||
| | CacheDelete | ||
| | MetricsRead | ||
| | MetricsWrite | ||
| | MetricsDelete | ||
| | HealthRead | ||
| | HealthWrite | ||
| | HealthDelete | ||
| | WSRead | ||
| | WSWrite | ||
| | WSDelete |
There was a problem hiding this comment.
7. Permissions parser out-of-sync 🐞 Bug ≡ Correctness
New Permission constructors/texts (e.g., tax:read, sync:read, audit:read, rbac:read) were added, but parsePermissionText is not updated to recognize them, so RBAC role/grant APIs will reject these permission strings as unknown.
Agent Prompt
### Issue description
`parsePermissionText` doesn’t recognize newly added permission strings, so RBAC management endpoints can’t create roles/grants using them.
### Issue Context
`permissionToText` includes new values like `tax:read`, `sync:read`, etc., but `parsePermissionText` only lists the older set.
### Fix Focus Areas
- src/Surypus/API/Server.hs[932-970]
- src/Surypus/RBAC.hs[99-128]
### Suggested fix
- Add all new permission text mappings to `parsePermissionText`.
- Consider deriving this mapping from a single source of truth (e.g., a bijection table in `Surypus.RBAC`) to avoid future drift.
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
Comment on lines
+195
to
+212
| personsCreate :: Env -> PersonRequest -> Handler PersonResponse | ||
| personsCreate env (PersonRequest n inn kpp pt st) = do | ||
| let pool = envPool env | ||
| pType = fromMaybe 1 pt | ||
| pStatus = fromMaybe 1 st | ||
| input = | ||
| PersonInput | ||
| { piCode = Nothing, | ||
| piName = n, | ||
| piINN = inn, | ||
| piKPP = kpp, | ||
| piPersonType = fromIntegral pType, | ||
| piStatus = fromIntegral pStatus | ||
| } | ||
| result <- liftIO $ Surypus.API.Persons.createPerson pool input | ||
| case result of | ||
| QuerySuccess _ -> pure $ PersonResponse 100 n inn kpp pType pStatus | ||
| QueryError err -> throwError $ err500 {errBody = LBS.fromStrict $ encodeUtf8 $ T.pack ("Database error: " ++ show err)} |
There was a problem hiding this comment.
8. Create returns fake ids 🐞 Bug ≡ Correctness
Several create handlers ignore DAL mutation results and return hard-coded IDs (e.g., personsCreate returns id=100 on success), so clients will reference non-existent resources.
Agent Prompt
### Issue description
Create endpoints return hard-coded IDs instead of the actual created entity ID.
### Issue Context
DAL mutations return `MutationResult { mrId :: Maybe Int64 }`. The API should return the real created ID (or fetch the created entity by that ID).
### Fix Focus Areas
- src/Surypus/API/Server.hs[187-548]
- src/DAL/Types.hs[473-478]
### Suggested fix
For each create handler:
- Pattern match `QuerySuccess (MutationResult _ (Just newId) _)` and use `newId` in the response.
- If `mrId` is `Nothing`, return `err500` (or a typed error) because the mutation contract was violated.
- Prefer returning the fully fetched entity (`getX newId`) to ensure response reflects DB state.
ⓘ Copy this prompt and use it to remediate the issue with your preferred AI generation tools
There was a problem hiding this comment.
Actionable comments posted: 16
Note
Due to the large number of review comments, Critical, Major severity comments were prioritized as inline comments.
Caution
Some comments are outside the diff and can’t be posted inline due to platform limitations.
⚠️ Outside diff range comments (11)
src/Surypus/API/RateLimit.hs (5)
79-82:⚠️ Potential issue | 🔴 CriticalMiddleware never enforces rate limits.
Line 82 still forwards all traffic, so throttling logic is never applied even after enabling config. This should call
checkRateLimitand return429when exceeded.Proposed fix
-rateLimitMiddleware :: RateLimitConfig -> Middleware -rateLimitMiddleware cfg app req respond +rateLimitMiddleware :: RateLimitConfig -> RateLimitStore -> Middleware +rateLimitMiddleware cfg store app req respond | not (rlcEnabled cfg) = app req respond - | otherwise = app req respond + | otherwise = do + allowed <- checkRateLimit cfg store (getClientIP req) + if allowed + then app req respond + else respond $ + rateLimitResponse + (RateLimitExceeded (rlcWindowSeconds cfg) "Rate limit exceeded")🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/RateLimit.hs` around lines 79 - 82, The middleware currently forwards all requests even when enabled; update rateLimitMiddleware so that when rlcEnabled cfg is True it calls checkRateLimit (passing cfg and the incoming Request), and if the result indicates the client exceeded the limit respond immediately with a 429 response (appropriate headers/body) instead of calling app; otherwise continue to call app req respond. Ensure you reference rateLimitMiddleware, RateLimitConfig, rlcEnabled and checkRateLimit in the change so the throttling path is executed when enabled.
41-65: 🛠️ Refactor suggestion | 🟠 MajorAdd Haddock docs for newly exported public API.
createRateLimitStore,getClientIP,checkRateLimit, andrateLimitResponseare exported but undocumented. Please add-- |docs for each public symbol.As per coding guidelines,
Document public API functions with -- | format.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/RateLimit.hs` around lines 41 - 65, Add Haddock-style comments using the `-- |` format immediately above each exported public symbol: `createRateLimitStore`, `getClientIP`, `checkRateLimit`, and `rateLimitResponse` (also document the `RateLimitExceeded` data type). For each comment briefly state the purpose, parameters (e.g. what `RateLimitConfig`, `RateLimitStore`, and `Text` client IP mean for `checkRateLimit`), the return value (e.g. IO types or `Response`), and any important behavior (e.g. when `checkRateLimit` returns False or the meaning of `rleRetryAfter`), keeping entries short and idiomatic Haddock.
39-56:⚠️ Potential issue | 🔴 CriticalRate limiting is completely non-functional:
checkRateLimitalways returnsTrueand is never invoked.The
checkRateLimitfunction at line 55–56 ignores its parameters and unconditionally returnsTrue. Additionally, therateLimitMiddlewareat lines 79–82 never callscheckRateLimit—both conditional branches invokeapp req responddirectly, bypassing rate limit checks entirely. TheRateLimitStoreat line 39 uses a single tuple(Text, RateLimitState)that cannot track multiple clients, andcreateRateLimitStoreinitializes only one entry.Three additional issues:
- Line 47–52:
getClientIPcallsTE.decodeUtf8on untrusted HTTP headers without handling decoding errors. Malformed UTF-8 or proxy chains (e.g., comma-separated IPs inX-Forwarded-For) will cause decoding exceptions.- Line 69:
rateLimitResponseconstructs JSON via string concatenation, embeddingrleMessage exceededdirectly without escaping. User-supplied messages containing quotes or backslashes will corrupt the JSON response.- Line 68–69: These lines exceed the 100-character line length limit defined in the coding guidelines.
Missing Haddock documentation: The module exports
RateLimitStore,createRateLimitStore,getClientIP,checkRateLimit, andrateLimitResponseat lines 8–12, but none have required-- |documentation comments as specified in the coding guidelines.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/RateLimit.hs` around lines 39 - 56, The module currently has non-functional rate limiting and several safety/style issues: implement real per-client state by changing RateLimitStore to hold a Map/Text RateLimitState inside the MVar and update createRateLimitStore to initialize an empty Map; implement checkRateLimit :: RateLimitConfig -> RateLimitStore -> Text -> IO Bool to atomically lookup/update the client's RateLimitState (resetting windows based on timestamps, decrementing allowance, returning False when exceeded) using the RateLimitState type and MVar operations; update rateLimitMiddleware to call checkRateLimit and branch on its Bool result so requests are blocked when checkRateLimit returns False; make getClientIP robust by safely UTF-8 decoding headers (use decodeUtf8' or fall back to a lossy decode), parse X-Forwarded-For by splitting on commas and taking the first non-empty token, and avoid decode exceptions; replace manual JSON string concatenation in rateLimitResponse with a proper JSON encoder (e.g., use aeson to build an object or construct a Response with setHeader and encode to ByteString) to ensure escaping and break long lines to respect the 100-char limit; and add required Haddock comments (“-- |”) for exported symbols RateLimitStore, createRateLimitStore, getClientIP, checkRateLimit, and rateLimitResponse.
47-52:⚠️ Potential issue | 🟠 MajorHarden client IP extraction for proxy chains and malformed headers.
Lines 49 and 51 use
decodeUtf8, which throwsUnicodeExceptionon invalid UTF-8 bytes with no exception handling present. Additionally, line 49 returns the entireX-Forwarded-Forvalue instead of extracting the first client IP per RFC 7239, which breaks rate limiting accuracy.Proposed fix
+import Data.Text.Encoding.Error (lenientDecode) getClientIP :: Request -> Text getClientIP req = case lookup "X-Forwarded-For" (requestHeaders req) of - Just ip -> TE.decodeUtf8 ip + Just ip -> T.strip . fst . T.breakOn "," $ TE.decodeUtf8With lenientDecode ip Nothing -> case lookup "X-Real-IP" (requestHeaders req) of - Just ip -> TE.decodeUtf8 ip + Just ip -> TE.decodeUtf8With lenientDecode ip Nothing -> T.pack (show (Wai.remoteHost req))🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/RateLimit.hs` around lines 47 - 52, The getClientIP function currently decodes headers with TE.decodeUtf8 (which can throw) and returns the whole X-Forwarded-For value; fix getClientIP to (1) extract the first non-empty, trimmed token from the comma-separated X-Forwarded-For header per RFC 7239, (2) fall back to X-Real-IP if X-Forwarded-For is missing or yields nothing, and finally to show remoteHost; and (3) decode header ByteString safely using Text.Encoding.decodeUtf8' or TE.decodeUtf8With TE.lenientDecode to avoid UnicodeException, converting the resulting Either or lenient Text into the returned Text. Reference: function name getClientIP, requestHeaders lookup of "X-Forwarded-For"/"X-Real-IP", and fallback Wai.remoteHost.
64-69:⚠️ Potential issue | 🟠 MajorUse Aeson to properly encode JSON response instead of manual string concatenation.
Line 69 directly interpolates
rleMessageinto JSON without escaping. If the message contains quotes or backslashes, the response becomes invalid JSON. Use Aeson'sencodeandobjectto handle escaping automatically, matching the pattern already established elsewhere in the codebase (e.g.,Server.hs).Proposed fix
-import Data.ByteString.Lazy (fromStrict) +import Data.Aeson (encode, object, (.=)) import Network.HTTP.Types (Status (Status)) import qualified Data.Text as T import qualified Data.Text.Encoding as TE rateLimitResponse :: RateLimitExceeded -> Response rateLimitResponse exceeded = responseLBS (Status 429 "Too Many Requests") [("Content-Type", "application/json"), ("Retry-After", TE.encodeUtf8 (T.pack (show (rleRetryAfter exceeded))))] - (fromStrict $ TE.encodeUtf8 ("{\"error\":\"Rate limit exceeded\",\"message\":\"" <> rleMessage exceeded <> "\"}")) + (encode $ object ["error" .= ("Rate limit exceeded" :: Text), "message" .= rleMessage exceeded])🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/RateLimit.hs` around lines 64 - 69, The JSON body in rateLimitResponse is built by string concatenation and can produce invalid JSON when rleMessage contains quotes or escapes; change rateLimitResponse to build the response body with Aeson (use Data.Aeson.object and (.=) to create {"error":"Rate limit exceeded","message": rleMessage}) and use Aeson.encode to produce the LBS payload, keep the existing headers (Content-Type and Retry-After built from rleRetryAfter) and return that LBS from responseLBS so escaping is handled correctly.src/Surypus/WebSocket.hs (1)
155-164:⚠️ Potential issue | 🟠 MajorVerify
canReceiveauthorization logic—unauthenticated clients receive all messages.The
canReceivepredicate allows unauthenticated clients (Nothingpayload) to receive all messages (line 162), while authenticated users needadminormanagerroles (line 164). This appears inverted—typically unauthenticated clients should have the most restricted access.Additionally, line 163
canReceive "admin" (Just _) = Trueallows any authenticated user to receive messages on the"admin"path regardless of their role.🔒 Suggested fix if unauthenticated should be denied
where - canReceive _ Nothing = True - canReceive "admin" (Just _) = True - canReceive _ (Just payload) = getJwtRole payload `elem` ["admin", "manager"] + canReceive _ Nothing = False -- Deny unauthenticated + canReceive "admin" (Just payload) = getJwtRole payload == "admin" + canReceive _ (Just payload) = getJwtRole payload `elem` ["admin", "manager"]🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/WebSocket.hs` around lines 155 - 164, The canReceive predicate in handleMessage is inverted and too permissive: change it so unauthenticated clients (Nothing) are denied by default, require a Just payload and appropriate role to receive messages, and tighten the "admin" path to require the "admin" role specifically. Update canReceive to return False for Nothing, match canReceive "admin" (Just payload) = getJwtRole payload == "admin", and for other paths use getJwtRole payload `elem` ["admin","manager"]; keep handleMessage and calls to getJwtRole unchanged.src/Core/Currency.hs (1)
68-75:⚠️ Potential issue | 🟡 MinorPotential crash on empty
curSymboland LiquidHaskell annotation mismatch.
T.head (curSymbol cur)will throw a runtime exception ifcurSymbolis empty.- The LiquidHaskell annotation specifies
NonEmpty Textas the return type, but the actual Haskell signature isText. This mismatch could cause confusion.🛡️ Proposed fix to handle empty symbol
formatAmount :: Currency -> Double -> Text formatAmount cur amount = let rounded = roundToCurrency cur amount - in T.cons (T.head (curSymbol cur)) (T.pack (show rounded)) + symbol = curSymbol cur + in if T.null symbol + then T.pack (show rounded) + else T.cons (T.head symbol) (T.pack (show rounded))🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Core/Currency.hs` around lines 68 - 75, The function formatAmount currently calls T.head on curSymbol which can crash if curSymbol is empty and its type/signature disagrees with the LiquidHaskell annotation; update formatAmount to safely handle an empty symbol and reconcile the types: ensure formatAmount (used with roundToCurrency) returns a non-empty Text by using a safe fallback symbol (e.g., default to a single space or numeric-only prefix) when curSymbol cur is empty, avoid T.head by pattern-matching or using T.uncons on curSymbol cur, and either change the external LiquidHaskell annotation to match the actual Text return type or change the Haskell signature to reflect NonEmpty Text so both declaration and spec agree (reference symbols: formatAmount, curSymbol, roundToCurrency).src/Surypus/API/AuthMiddleware.hs (1)
173-182:⚠️ Potential issue | 🔴 Critical
validateJWTimplementation lacks signature verification, creating a security vulnerability.The function treats the bearer token as plain JSON using Aeson's
decode, without signature verification. This means anyone can forge tokens with arbitrary user IDs and roles. Additionally,jwtCfgis ignored entirely—the secret key is never used.Real JWT tokens follow the header.payload.signature format with HMAC verification (as shown in the proper
Core.Auth.JWTmodule). Replace this with either:
Core.Auth.JWT.verifyToken(available in the codebase with full HMAC-SHA256 validation)- The
joselibrary for industry-standard JWT handling🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/AuthMiddleware.hs` around lines 173 - 182, The current validateJWT function ignores JWTConfig and simply decodes the bearer string as JSON; replace the body to perform proper signature verification using the existing verification helper (e.g. Core.Auth.JWT.verifyToken) or an approved library, passing the JWTConfig/secret into the verifier, extract and return the JWTPayload only on successful verification, and return descriptive Left errors for missing header, malformed bearer, verification failure, or decode failure; update references to validateJWT, JWTConfig, Request and ensure you no longer call Aeson.decode on the raw token or ignore jwtCfg.src/Surypus/API/Goods.hs (1)
60-65:⚠️ Potential issue | 🟠 MajorCall the DAL's filtered search instead of the unfiltered query.
The API wrapper calls
Q.getGoods pool(which returns all goods) instead ofQ.searchGoods pool query, which implements actual search filtering. The DAL already has the correct implementation using SQL ILIKE on name, code, and barcode fields.Fix
searchGoods :: Pool -> Text -> IO (QueryResult [Goods]) -searchGoods pool _query = do - result <- Q.getGoods pool +searchGoods pool query = do + result <- Q.searchGoods pool query case result of QuerySuccess goods -> pure (QuerySuccess goods) QueryError err -> pure (QueryError err)🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Goods.hs` around lines 60 - 65, In searchGoods, you're calling the unfiltered Q.getGoods and also named the parameter _query which hides intent; change the function to use the actual query parameter (rename _query to query) and call Q.searchGoods pool query, then return the QueryResult as before (pattern-match QuerySuccess/QueryError or simply propagate the result) so the DAL's ILIKE filtering on name/code/barcode is used.src/Surypus/API/Server.hs (1)
138-148:⚠️ Potential issue | 🟠 MajorHardcoded passwords in authentication logic.
The authentication check uses hardcoded passwords
"admin123"and"demo". This is a security concern, even if intended for development/demo purposes.Consider:
- Using environment variables or configuration for demo credentials
- Adding a comment explaining this is demo-only code
- Ensuring this doesn't ship to production
🔧 Suggested improvement
authLogin env req = do let user = username req pwd = password req - if pwd == "admin123" || pwd == "demo" + -- TODO: Replace with proper authentication (DEMO ONLY) + -- WARNING: Do not use hardcoded credentials in production + if pwd == "admin123" || pwd == "demo"🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Server.hs` around lines 138 - 148, The authLogin function currently checks passwords against hardcoded values ("admin123"/"demo"); replace this with a configuration-driven check by reading demo credentials from Env (add fields to Env or use envJWTConfig) or from environment variables, and only allow this fallback when a clearly named demo flag is enabled; update authLogin and related uses of generateTokenPair and persistRefreshTokenBestEffort to consult that config, add a comment in authLogin noting this is demo-only, and ensure the code path is disabled unless the demo flag is set to prevent shipping to production.src/DAL/Repository/Tax.hs (1)
72-82:⚠️ Potential issue | 🟠 Major
deleteTaxRepostill errors on missing rows.Line 72 says the delete should succeed silently when the tax is absent, but Line 81 still throws
NotFound. That keeps the operation non-idempotent for callers.Suggested fix
deleteTaxRepo :: TaxRepository -> Int64 -> ExceptT RepositoryError IO () deleteTaxRepo repo tid = do mutation <- liftIO $ deleteTax (trPool repo) tid case mutation of QuerySuccess _ -> pure () QueryError err - | isNotFoundMessage err -> throwE (NotFound "Tax not found") + | isNotFoundMessage err -> pure () | otherwise -> throwE (DatabaseError err)🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/Tax.hs` around lines 72 - 82, The deleteTaxRepo function currently treats isNotFoundMessage as a NotFound error; update deleteTaxRepo so that both QuerySuccess _ and QueryError err where isNotFoundMessage err are treated as a successful no-op (pure ()), and only non-"not found" QueryError cases throwE (DatabaseError err); refer to deleteTaxRepo, deleteTax, QuerySuccess, QueryError and isNotFoundMessage to locate and change the logic accordingly.
🟡 Minor comments (9)
src/Core/Currency.hs-63-66 (1)
63-66:⚠️ Potential issue | 🟡 MinorNo runtime guard for negative
curPrecision.The LiquidHaskell annotation
Precisionconstrains the value to0 <= v <= 6, but at runtime ifcurPrecision curis negative,10 ^ curPrecision curwill raise an exception since Haskell's(^)operator requires a non-negative exponent.Consider adding a runtime guard or using
max 0to ensure safety.🛡️ Proposed defensive fix
roundToCurrency :: Currency -> Double -> Double roundToCurrency cur amount = - let factor = 10 ^ curPrecision cur + let factor = 10 ^ max 0 (min 6 (curPrecision cur)) in fromInteger (round (amount * factor)) / factor🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Core/Currency.hs` around lines 63 - 66, roundToCurrency can crash if curPrecision cur is negative because (^) requires a non‑negative exponent; update the computation of factor in roundToCurrency to clamp the precision (e.g. use max 0 (curPrecision cur) or otherwise ensure a non‑negative Int) before raising 10 to that power so the function cannot throw on negative precisions while keeping the same return behavior for valid precisions.test/Test.hs-405-405 (1)
405-405:⚠️ Potential issue | 🟡 MinorTrivial property test provides no coverage.
Replacing
prop_materialConsumptionNonNegwithproperty Trueresults in a test that always passes without verifying any behavior. This defeats the purpose of property-based testing for production material consumption.Consider either:
- Removing this property entry entirely if the functionality is deprecated.
- Implementing a proper property test if the functionality exists elsewhere.
- Adding a TODO comment and tracking issue if this is temporary.
Would you like me to help implement a proper property test or open an issue to track this?
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@test/Test.hs` at line 405, The test entry for "Production material consumption" was replaced with a trivial always-true property; restore meaningful coverage by either reinstating the original property test (prop_materialConsumptionNonNeg) or replacing the placeholder with a real QuickCheck property that exercises the production-material-consumption logic; specifically, locate the line with prop "Production material consumption" $ property True and replace it with a call to prop_materialConsumptionNonNeg (or implement a new property that asserts non-negative consumption for generated production scenarios), or if the feature is deprecated add a TODO/comment and remove the entry so the test suite doesn't contain a no-op.src/Core/Warehouse.hs-68-71 (1)
68-71:⚠️ Potential issue | 🟡 MinorProperty test is a tautology and provides no verification.
The pattern
balance >= 0 ==> Truediscards all test cases where balance < 0 and returnsTruefor the rest. This doesn't actually verify thatcalcStockBalanceproduces correct results — it only confirms the function returns non-negative values (which is now guaranteed by the clamping).A meaningful property would verify the stock invariant:
Rest = Initial + Receipt - Issue.🧪 Proposed fix: Test the invariant properly
prop_stockBalanceNonNeg :: Double -> [StockMovement] -> Property prop_stockBalanceNonNeg initial movements = - let balance = calcStockBalance initial movements - in balance >= 0 ==> True + initial >= 0 ==> + let balance = calcStockBalance initial movements + expected = initial + sum (fmap smQtty movements) + in balance >= 0 && (expected >= 0 ==> balance == expected)🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Core/Warehouse.hs` around lines 68 - 71, The current property prop_stockBalanceNonNeg is a tautology; replace it with a property that computes the aggregated receipts and issues from the [StockMovement] and asserts the stock invariant holds: finalBalance == initial + totalReceipts - totalIssues (and optionally that finalBalance is clamped to >= 0 if calcStockBalance enforces clamping). In other words, in prop_stockBalanceNonNeg use calcStockBalance initial movements to get finalBalance, compute totalReceipts and totalIssues by folding over the movements (matching on the StockMovement constructors used in your code), then assert finalBalance === initial + totalReceipts - totalIssues (or === max 0 (initial + totalReceipts - totalIssues) if calcStockBalance clamps); reference calcStockBalance and prop_stockBalanceNonNeg when making the change.src/Surypus/API/Payment.hs-22-35 (1)
22-35:⚠️ Potential issue | 🟡 MinorAdd Haddock docs for the exported handlers.
This module introduces public API surface area, but none of the exported functions has a
-- |doc block.As per coding guidelines, "Document public API functions with
-- |format".🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Payment.hs` around lines 22 - 35, Add Haddock-style `-- |` documentation comments above each exported handler (listPayments, createPayment, getPayment, updatePayment, deletePayment) describing its purpose, the parameters (Pool and where applicable Int64/PaymentInput), and the return type (IO (QueryResult ...)). For example, provide a one-line summary for each function, then a short description of the arguments and a brief note about the QueryResult/MutationResult semantics; ensure each doc block directly precedes the corresponding top-level definition so the comments are attached to the exported symbols.src/Surypus/API/Location.hs-22-35 (1)
22-35:⚠️ Potential issue | 🟡 MinorAdd Haddock docs for the exported handlers.
These functions are part of the public API layer, but none of them has a
-- |doc block.As per coding guidelines, "Document public API functions with
-- |format".🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Location.hs` around lines 22 - 35, Add Haddock `-- |` documentation comments for each exported handler function (listLocations, createLocation, getLocation, updateLocation, deleteLocation) at the top of their definitions in Location.hs; briefly describe what each function does, its parameters (e.g., Pool, LocationInput, Int64), and the return type (QueryResult ...) and include any important behavior or failure conditions so the public API is properly documented per guidelines.test/Integration/PropertySpec.hs-76-77 (1)
76-77:⚠️ Potential issue | 🟡 MinorLarge tolerance for VAT roundtrip may mask precision issues.
The
approxEqtolerance of2.0is quite large for currency calculations. This could allow significant rounding errors (up to $2 per transaction) to pass undetected. Consider whether a tighter tolerance (e.g.,0.01for cent-level precision) would be more appropriate, especially given the PR's focus on "deterministic currency rounding."🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@test/Integration/PropertySpec.hs` around lines 76 - 77, The test uses approxEq with a tolerance of 2.0 which is too large for currency roundtrip checks; change the tolerance in approxEq to a cent-level value (e.g., 0.01) so currency/deterministic rounding regressions are caught (update the approxEq definition in PropertySpec.hs from 2.0 to 0.01 or an appropriately small epsilon).src/Surypus/API/Server.hs-580-593 (1)
580-593:⚠️ Potential issue | 🟡 MinorAll tax handlers are stub implementations.
taxesList,taxesCreate,taxesGet,taxesUpdate, andtaxesDeletereturn hardcoded responses. Consider implementing actual database operations or adding TODO comments to track this technical debt.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Server.hs` around lines 580 - 593, The tax handlers (taxesList, taxesCreate, taxesGet, taxesUpdate, taxesDelete) are currently returning hardcoded responses; replace these stubs with real DB operations using the Env's DB/conn (e.g., call repository functions like fetchTaxes/createTax/getTax/updateTax/deleteTax or run queries via the existing DB helper in Env), lift IO into Handler, map DB results into TaxesResponse/TaxResponse and handle errors (not found/validation) appropriately; if you cannot implement DB logic now, at minimum add clear TODO comments in each function documenting the needed DB calls and error handling so the technical debt is tracked.src/Surypus/API/Server.hs-554-569 (1)
554-569:⚠️ Potential issue | 🟡 MinorOrder handlers are stub implementations returning hardcoded data.
ordersCreate,ordersStatus, andordersDeletereturn hardcoded responses without actual database operations. This is inconsistent with other handlers that perform real CRUD operations.Do you want me to help implement these handlers following the same pattern as the other CRUD operations?
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Server.hs` around lines 554 - 569, Replace the stubbed handlers with real DB operations using envPool and Surypus.API.Order functions: in ordersCreate use liftIO to call the createOrder function with the pool and OrderRequest, pattern-match on QuerySuccess to return toOrderResponse and on QueryError throw err500 with a meaningful body; in ordersStatus accept the Maybe Int status, convert/validate it as needed, call an updateOrderStatus (or equivalent) via liftIO with pool, oid and new status, return the updated order via toOrderResponse on QuerySuccess and throw err500 on QueryError; in ordersDelete call the deleteOrder function with pool and oid via liftIO, return () (or appropriate success) on QuerySuccess and throw err500 on QueryError. Use the same error handling pattern as ordersGet and reference envPool, Surypus.API.Order.getOrder/toOrderResponse to match style.src/Surypus/API/Server.hs-621-636 (1)
621-636:⚠️ Potential issue | 🟡 MinorCurrency create/update/delete handlers are stubs.
While
currenciesListandcurrenciesGetcall the actual repository,currenciesCreate,currenciesUpdate, andcurrenciesDeletereturn hardcoded responses.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Server.hs` around lines 621 - 636, currenciesCreate/currenciesUpdate/currenciesDelete are returning hardcoded stubs; replace them to call the repository using the connection pool from env (envPool) and handle QuerySuccess/QueryError like currenciesGet does: in currenciesCreate call Surypus.API.Currency.createCurrency pool (CurrencyRequest) and on QuerySuccess convert the returned entity with toCurrencyResponse, on QueryError throwError with err500 and a descriptive body; in currenciesUpdate call Surypus.API.Currency.updateCurrency pool cid (CurrencyRequest) and similarly handle QuerySuccess/QueryError and return toCurrencyResponse; in currenciesDelete call Surypus.API.Currency.deleteCurrency pool cid and on QuerySuccess return () (or appropriate success status) and on QueryError throwError err500 with a message.
🧹 Nitpick comments (19)
src/Core/Inventory/Types/Location.hs (1)
7-10: Wire the newLocationIdrefinement into theLocationrecord.
LocationIdis defined, butlocId/locParentIdstill use rawInt64. UsingLocationId(andMaybe LocationId) would actually enforce the positive-ID invariant at the type level.As per coding guidelines, "Use LiquidHaskell refinement type predicates for formal verification (e.g.,
{-@ type NonNeg@-})" and "UseInt64for database IDs in Haskell".Also applies to: 13-17
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Core/Inventory/Types/Location.hs` around lines 7 - 10, The Location record currently uses raw Int64 for locId and locParentId; replace those field types with the refinement alias LocationId and Maybe LocationId respectively so the positive-ID invariant is enforced at the type level; update the Location data declaration (fields locId and locParentId) to use LocationId / Maybe LocationId and adjust any constructors, pattern matches, or function signatures that reference locId/locParentId (e.g., in functions that build or read Location) to accept/return LocationId instead of Int64 while keeping Int64 as the underlying representation per project guidelines.src/DAL/Mutations.hs (1)
59-60: Drop the unusedsuccessMessageparameter from the function signature.Keeping
_successMessageinrunMutationReturningIdspreserves dead API surface and invites confusing call sites.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Mutations.hs` around lines 59 - 60, Remove the unused `_successMessage` parameter from the runMutationReturningIds function signature and all call sites; update the type signature from five parameters to four (Pool -> Text -> E.Params params -> [params] -> IO (QueryResult [Int64])) and the corresponding function definition `runMutationReturningIds` to accept only those four arguments, then search for and remove the extra argument in any callers so the API surface no longer includes the dead `_successMessage` parameter.src/DAL/Repository/User.hs (1)
4-7: Avoid exposing bothUserRepository(..)andgetUserPool.This duplicates access paths to the same field and makes encapsulation policy unclear. Prefer either abstract type + accessor, or full record export (not both).
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/User.hs` around lines 4 - 7, The module currently exports both the record constructor UserRepository(..) and the accessor getUserPool which duplicates access and breaks encapsulation; pick one pattern and adjust exports and callers accordingly: either export an abstract UserRepository (remove the "(..)" in the export list) and keep getUserPool as the sanctioned accessor, or keep the full record export UserRepository(..) and remove getUserPool from the export list, then update any call sites to use the retained access pattern (referencing UserRepository(..), getUserPool, and mkUserRepository to locate code to change).src/Surypus/API/Bills.hs (1)
30-30: Drop the commented-out import line.Line 30 leaves dead/commented import code in the module; better to remove it fully.
As per coding guidelines: "Remove unused imports to avoid compilation warnings".
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Bills.hs` at line 30, Remove the dead commented import in the Bills module: delete the line "-- import Data.Text (Text) -- unused, removed to satisfy -Werror" from src/Surypus/API/Bills.hs so the module no longer contains a commented-out unused import and the file complies with the unused-import guideline.src/Core/Price/Operations.hs (1)
195-196: Good rename, but the identityfmapis redundant.Renaming
linestopriceLinesappropriately avoids shadowing the Prelude function. However,fmap (\(p, q, d) -> (p, q, d))is an identity transformation and can be removed.♻️ Proposed simplification
forAll (listOf tripletGen `suchThat` (not . null)) $ \priceLines -> - calcBillTotal (fmap (\(p, q, d) -> (p, q, d)) priceLines) >= 0 + calcBillTotal priceLines >= 0🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Core/Price/Operations.hs` around lines 195 - 196, The test applies an unnecessary identity fmap around priceLines before calling calcBillTotal; remove the redundant fmap (\(p,q,d)->(p,q,d)) so the property directly passes priceLines (produced by listOf tripletGen `suchThat` (not . null)) to calcBillTotal, keeping the renamed variable priceLines and leaving tripletGen and calcBillTotal unchanged.src/Service/AccountingService.hs (1)
12-12: Unused qualified import.
qualified Data.Text as Tis imported but theTprefix is never used in the module. This may cause a compilation warning depending on GHC flags.♻️ Proposed fix
import Data.Text (Text) -import qualified Data.Text as T🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Service/AccountingService.hs` at line 12, The module currently imports "qualified Data.Text as T" but never uses the T prefix; remove the unused qualified import (the "qualified Data.Text as T" import statement in AccountingService.hs) to eliminate the compilation warning, or if Text functions are needed later, replace it with a non-qualified import (e.g., import Data.Text) and update usages accordingly.test/Test.hs (1)
37-37: Remove empty import.
Data.Int ()imports nothing and can be safely removed. This appears to be a leftover from a refactoring.🧹 Proposed fix
-import Data.Int ()🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@test/Test.hs` at line 37, Remove the empty import statement "import Data.Int ()" from the module; locate the top-level import list in Test.hs and delete that line (no other changes needed), ensuring there are no references requiring Data.Int types elsewhere before committing.src/Core/Production.hs (1)
64-67: Remove commented-out code.Commented-out code should be removed rather than left in the codebase. Version control preserves history if this code needs to be recovered later.
If the production material consumption functionality is planned for future implementation, consider adding a TODO comment with a tracking issue instead.
🧹 Proposed fix
-- ============================================================================ -- QUICKCHECK PROPERTIES -- ============================================================================ - --- prop_materialConsumptionNonNeg :: [(Int64, Double)] -> Property --- prop_materialConsumptionNonNeg materials = --- let valid = all (>= 0) (map snd materials) --- in valid ==> forAll arbitrary $ \tech -> calcMaterialConsumption tech materials >= 0 + +-- TODO: Implement prop_materialConsumptionNonNeg when calcMaterialConsumption is restored +-- See: [tracking issue URL]Or simply remove the entire QuickCheck section if no properties remain:
--- ============================================================================ --- QUICKCHECK PROPERTIES --- ============================================================================ - --- prop_materialConsumptionNonNeg :: [(Int64, Double)] -> Property --- prop_materialConsumptionNonNeg materials = --- let valid = all (>= 0) (map snd materials) --- in valid ==> forAll arbitrary $ \tech -> calcMaterialConsumption tech materials >= 0🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Core/Production.hs` around lines 64 - 67, Remove the commented-out QuickCheck property block for prop_materialConsumptionNonNeg in Production.hs: delete the three commented lines (the prop_materialConsumptionNonNeg definition and its body that references calcMaterialConsumption) rather than keeping them inline; if the behavior is planned later, replace the removed comments with a single TODO referencing an issue or ticket instead of keeping commented code.test/Integration/ValidationSpec.hs (1)
10-11: Remove unused imports.
Data.Coerce (coerce)andData.Int (Int16)are imported but never used in this module.♻️ Proposed fix
import DAL.Types -import Data.Coerce (coerce) -import Data.Int (Int16) import Data.Text (Text)🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@test/Integration/ValidationSpec.hs` around lines 10 - 11, Remove the unused imports `Data.Coerce (coerce)` and `Data.Int (Int16)` from the module; locate the import list in ValidationSpec (the lines importing Data.Coerce and Data.Int) and delete those specific import entries so there are no unused import warnings and the module compiles cleanly.test/Integration/PropertySpec.hs (2)
90-92: Remove duplicate property test.This property is explicitly labeled "(duplicate)" and performs the exact same check as lines 86-88. Duplicate tests add maintenance burden without additional coverage.
♻️ Proposed fix
- prop "calcStockBalance returns non-negative result (duplicate)" $ - forAll (listOf1 (arbitrary :: Gen StockMovement)) $ \movements -> - calcStockBalance 0 movements >= 0 -🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@test/Integration/PropertySpec.hs` around lines 90 - 92, Remove the duplicate property test that repeats the same assertion as the earlier test: delete the prop block named "calcStockBalance returns non-negative result (duplicate)" which uses forAll (listOf1 (arbitrary :: Gen StockMovement)) $ \movements -> calcStockBalance 0 movements >= 0; leaving the original property (the first occurrence) intact to avoid redundant coverage.
132-140: Tautological properties provide no test value.Both
prop "Bill total is non-negative"andprop "Bill discount is bounded 0-100"generate values satisfying the constraint, then assert that same constraint. These tests always pass trivially and don't exercise any business logic.Consider testing actual bill calculation functions (e.g.,
calcBillTotal) with generated inputs instead.♻️ Suggested approach
spec_billProperties :: Spec spec_billProperties = describe "Bill Properties" $ do - prop "Bill total is non-negative" $ - forAll (suchThat (arbitrary :: Gen Double) (>= 0)) $ \total -> - total >= 0 - - prop "Bill discount is bounded 0-100" $ - forAll (suchThat (arbitrary :: Gen Double) (\d -> d >= 0 && d <= 100)) $ \discount -> - discount >= 0 && discount <= 100 + -- TODO: Add meaningful bill calculation properties + -- e.g., calcBillTotal with discount never exceeds original total + it "placeholder: bill calculations" $ do + True `shouldBe` True🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@test/Integration/PropertySpec.hs` around lines 132 - 140, The two properties in spec_billProperties are tautological (they generate values already satisfying the predicate) — replace them to exercise real business logic by generating realistic bill inputs and asserting behavior of the bill-calculation code (e.g., use forAll to generate item lists, quantities, prices and discounts and call calcBillTotal or the relevant function like calcBillTotal :: Bill -> Double), then assert results such as returned total >= 0 and that applied discount is within 0–100 and that total equals sum(items) * (1 - discount/100) (or whatever the domain rule is); update the prop names to reflect they test calcBillTotal and reference calcBillTotal and spec_billProperties so reviewers can locate the changes.src/DAL/Repository/Bill.hs (1)
4-14: Missing module header documentation.Per coding guidelines, modules should include header documentation with
-- |format.📝 Suggested addition
+-- | Bill Repository with explicit CRUD operations. +-- Provides functions for managing bill entities in the database. module DAL.Repository.Bill ( BillRepository (..),🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/Bill.hs` around lines 4 - 14, Add a module header doc comment at the top of the DAL.Repository.Bill module using the "-- |" Haddock format describing the purpose and responsibilities of this module (e.g., BillRepository interface and helper constructors like mkBillRepository and exported functions listBillsPage, getBillLinesRepo, createBillRepo, updateBillStatusRepo, deleteBillRepo); place the comment immediately above the "module DAL.Repository.Bill" declaration and keep it concise, describing what the module provides and any important usage notes.src/Surypus/API/Server.hs (2)
6-10: Missing module header documentation.Per coding guidelines, modules should include header documentation with
-- |format describing the server's purpose and exported functions.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Server.hs` around lines 6 - 10, Add a Haddock module header comment in module Surypus.API.Server using the "-- |" format that briefly describes the server responsibilities and what the exported functions do; mention that apiServer constructs the Servant API server handlers and startServantServer starts/runs the HTTP server so readers know the purpose of the module and its exports.
738-739: UsingsumonMaybe Int64is unconventional.While
sum mOffsetworks becauseMaybeisFoldable, it's unusual and may confuse readers.fromMaybe 0 mOffsetis clearer and more idiomatic.🔧 Suggested fix for clarity
auditLogList env mEntityType mLimit mOffset = do - auditEntries <- liftIO $ fetchAuditLogsBestEffort env mEntityType (fromMaybe 100 mLimit) (sum mOffset) + auditEntries <- liftIO $ fetchAuditLogsBestEffort env mEntityType (fromMaybe 100 mLimit) (fromMaybe 0 mOffset) pure $ AuditLogListResponse auditEntries🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/Surypus/API/Server.hs` around lines 738 - 739, The use of sum on the Maybe mOffset is unconventional; update the call that builds the offset argument to fetchAuditLogsBestEffort to use fromMaybe 0 mOffset instead of sum mOffset so the intent is clear and idiomatic (update the expression passed to fetchAuditLogsBestEffort where mOffset is used).src/DAL/Repository/Person.hs (1)
4-15: Missing module header documentation.Per coding guidelines, modules should include header documentation with
-- |format.📝 Suggested addition
+-- | Person Repository with explicit CRUD operations. +-- Provides functions for managing person entities in the database. module DAL.Repository.Person ( PersonRepository (..),🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/Person.hs` around lines 4 - 15, Add a Haddock module header comment using the "-- |" format at the top of the DAL.Repository.Person module that briefly describes the module’s purpose and the responsibilities of its exported API (PersonRepository, HasPersonRepository, mkPersonRepository, runPersonRepository, listPersonsPage, searchPersonsRepo, createPersonRepo, updatePersonRepo, deletePersonRepo); place the comment immediately above the "module DAL.Repository.Person ..." line and keep it concise, documenting what the repository does and any important usage notes.src/DAL/Repository/Order.hs (1)
4-13: Missing module header documentation.Per coding guidelines, modules should include header documentation with
-- |format.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/Order.hs` around lines 4 - 13, Add a Haddock module header comment using the "-- |" format at the top of the DAL.Repository.Order module describing its purpose (e.g., repository interface and implementations for Order operations) and briefly summarizing the key exported symbols such as OrderRepository, HasOrderRepository, mkOrderRepository, listOrdersPage, createOrderRepo, updateOrderStatusRepo, and deleteOrderRepo so users of the module can understand its responsibility from the header.Surypus.cabal (1)
209-209: Minor formatting:ghc-optionsindentation is inconsistent.The
ghc-optionsfield appears to have inconsistent indentation compared to other fields in the library stanza. This may cause cabal parsing issues.🔧 Suggested fix
default-language: Haskell2010 - ghc-options: -Wall -Werror + ghc-options: -Wall -Werror🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@Surypus.cabal` at line 209, Adjust the indentation of the ghc-options field so it matches the other fields in the same library stanza (use the same number of leading spaces, no tabs) to ensure consistent formatting and valid cabal parsing; locate the ghc-options line and align its indentation with neighboring stanza fields, then re-run cabal check/build to verify.src/DAL/Repository/Location.hs (1)
4-13: Missing module header documentation.Per coding guidelines, modules should include header documentation with
-- |format. Consider adding a module description.📝 Suggested addition
+-- | Location Repository with explicit CRUD operations. +-- Provides functions for managing location entities in the database. module DAL.Repository.Location ( LocationRepository (..),🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/Location.hs` around lines 4 - 13, Add a module header comment in the conventional Haddock "-- |" format immediately above the "module DAL.Repository.Location" line describing the purpose of this module and what the exported symbols (LocationRepository, HasLocationRepository, mkLocationRepository, listLocationsRepo, createLocationRepo, updateLocationRepo, deleteLocationRepo) provide; keep it concise (one or two sentences) and mention any notable behavior or invariants expected by these repository functions.src/DAL/Repository/Currency.hs (1)
28-34: LiquidHaskell refinement types lack proper measures and are unused in function specifications.The
CurrencyCodeandExchangeRaterefinement types are defined at lines 30 and 34, but:
- Function specifications (lines 42, 52, 65, 78, 90, 101) do not reference or apply these refinements—they only repeat base type signatures without leveraging the constraints.
T.lengthis a runtime function and not a LiquidHaskell measure. Expressing Text length constraints requires a custom measure (e.g.,{-@ measure tlen :: Text -> Int@-}), which is not defined here.To enable LiquidHaskell verification, either define a measure for Text length and use it consistently, or apply the refinement types directly to the
CurrencyInputand related domain types that validate currency codes and exchange rates.🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed. In `@src/DAL/Repository/Currency.hs` around lines 28 - 34, The LiquidHaskell refinements CurrencyCode and ExchangeRate are ineffective because Text length isn't defined as a measure and the functions (use sites around CurrencyInput and other DAL functions) don't reference these refined types; fix by adding a Text-length measure (e.g., define a measure like tlen :: Text -> Int) and then replace raw type annotations with the refinements (use CurrencyCode and ExchangeRate) on the domain types (e.g., CurrencyInput) and on the function specs that consume/produce currency codes and rates so LiquidHaskell can verify the constraints; ensure all function signatures that currently use plain Text or Double are updated to use CurrencyCode/ExchangeRate and that any constructors or validators enforce/construct values respecting those refinements.
ℹ️ Review info
⚙️ Run configuration
Configuration used: Organization UI
Review profile: CHILL
Plan: Pro
Run ID: 3d709f75-2144-4e9a-a44b-cc8c97dcb212
📒 Files selected for processing (88)
Surypus.cabalsrc/APIServer.hssrc/Core/Accounting/Operations.hssrc/Core/Accounting/Types.hssrc/Core/Agent.hssrc/Core/Auth/Operations.hssrc/Core/CreditNote.hssrc/Core/Currency.hssrc/Core/Discount.hssrc/Core/Document/Operations.hssrc/Core/GoodsTaxEx.hssrc/Core/Inventory/Types/Location.hssrc/Core/Inventory/Types/Lot.hssrc/Core/Invoice.hssrc/Core/Invoice/Operations.hssrc/Core/JobSystem.hssrc/Core/Loyalty/Bonus.hssrc/Core/Order.hssrc/Core/Payment.hssrc/Core/Payroll/Calculation.hssrc/Core/Payroll/Types.hssrc/Core/Price/Operations.hssrc/Core/Production.hssrc/Core/RetBill.hssrc/Core/SmartReceipt.hssrc/Core/Warehouse.hssrc/DAL.hssrc/DAL/Mutations.hssrc/DAL/Repository.hssrc/DAL/Repository/AccPlan.hssrc/DAL/Repository/AccTurn.hssrc/DAL/Repository/AuditLog.hssrc/DAL/Repository/Bill.hssrc/DAL/Repository/Container.hssrc/DAL/Repository/Currency.hssrc/DAL/Repository/Goods.hssrc/DAL/Repository/Location.hssrc/DAL/Repository/Order.hssrc/DAL/Repository/Payment.hssrc/DAL/Repository/Person.hssrc/DAL/Repository/Price.hssrc/DAL/Repository/Tax.hssrc/DAL/Repository/User.hssrc/DB/Accounting.hssrc/DB/BillLine.hssrc/DB/Connection.hssrc/DB/Document/Counter.hssrc/DB/Document/RegisterRow.hssrc/DB/Document/RegisterType.hssrc/DB/Goods.hssrc/DB/PersonSummary.hssrc/DB/TechCard.hssrc/Main.hssrc/Service/AccountingService.hssrc/Service/InventoryService.hssrc/Service/PayrollService.hssrc/Surypus.hssrc/Surypus/API/AuthMiddleware.hssrc/Surypus/API/Bills.hssrc/Surypus/API/Currency.hssrc/Surypus/API/Goods.hssrc/Surypus/API/Health.hssrc/Surypus/API/JWT.hssrc/Surypus/API/JWTMiddleware.hssrc/Surypus/API/Location.hssrc/Surypus/API/Order.hssrc/Surypus/API/Payment.hssrc/Surypus/API/Persons.hssrc/Surypus/API/RateLimit.hssrc/Surypus/API/Root.hssrc/Surypus/API/Server.hssrc/Surypus/API/Stock.hssrc/Surypus/API/Sync.hssrc/Surypus/API/WebSocket.hssrc/Surypus/Audit.hssrc/Surypus/Core.hssrc/Surypus/DB/Schema.hssrc/Surypus/Database/Pool.hssrc/Surypus/JWT.hssrc/Surypus/Metrics/Prometheus.hssrc/Surypus/RBAC.hssrc/Surypus/RBAC/Store.hssrc/Surypus/Reports/Conversion/CrystalToJasper.hssrc/Surypus/WebSocket.hstest/Integration/PropertySpec.hstest/Integration/ValidationSpec.hstest/RBACSpec.hstest/Test.hs
💤 Files with no reviewable changes (9)
- src/Surypus/API/Health.hs
- src/Surypus/API/Sync.hs
- src/Surypus/Database/Pool.hs
- src/Surypus/API/WebSocket.hs
- src/Surypus/RBAC/Store.hs
- src/Surypus/JWT.hs
- src/DAL.hs
- src/DB/Connection.hs
- src/APIServer.hs
Comment on lines
+122
to
+128
| prop_doubleEntryBalance entries = | ||
| let balanced = all (\t -> atDbtAmt t == atCrdAmt t && atDbtAmt t > 0) entries | ||
| in if balanced | ||
| then case verifyDoubleEntry entries of | ||
| AccOpSuccess -> True | ||
| _ -> False | ||
| else True |
There was a problem hiding this comment.
Property test has flawed logic — unbalanced entries always pass.
The else True branch means any unbalanced transaction set automatically passes the test. This defeats the purpose of verifying the double-entry invariant.
Additionally, the per-entry check atDbtAmt t == atCrdAmt t tests something different from what verifyDoubleEntry validates (aggregate balance across all entries).
Based on learnings: "Ensure double-entry accounting invariant: Sum of Debit entries equals Sum of Credit entries"
🧪 Proposed fix: Test the actual invariant
prop_doubleEntryBalance :: [AccTurn] -> Bool
-prop_doubleEntryBalance entries =
- let balanced = all (\t -> atDbtAmt t == atCrdAmt t && atDbtAmt t > 0) entries
- in if balanced
- then case verifyDoubleEntry entries of
- AccOpSuccess -> True
- _ -> False
- else True
+prop_doubleEntryBalance entries =
+ let totalDebit = sum (fmap atDbtAmt entries)
+ totalCredit = sum (fmap atCrdAmt entries)
+ isBalanced = totalDebit == totalCredit
+ in case verifyDoubleEntry entries of
+ AccOpSuccess -> isBalanced
+ AccOpDoubleEntryError -> not isBalanced
+ _ -> False📝 Committable suggestion
‼️ IMPORTANT
Carefully review the code before committing. Ensure that it accurately replaces the highlighted code, contains no missing lines, and has no issues with indentation. Thoroughly test & benchmark the code to ensure it meets the requirements.
Suggested change
| prop_doubleEntryBalance entries = | |
| let balanced = all (\t -> atDbtAmt t == atCrdAmt t && atDbtAmt t > 0) entries | |
| in if balanced | |
| then case verifyDoubleEntry entries of | |
| AccOpSuccess -> True | |
| _ -> False | |
| else True | |
| prop_doubleEntryBalance :: [AccTurn] -> Bool | |
| prop_doubleEntryBalance entries = | |
| let totalDebit = sum (fmap atDbtAmt entries) | |
| totalCredit = sum (fmap atCrdAmt entries) | |
| isBalanced = totalDebit == totalCredit | |
| in case verifyDoubleEntry entries of | |
| AccOpSuccess -> isBalanced | |
| AccOpDoubleEntryError -> not isBalanced | |
| _ -> False |
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Core/Accounting/Operations.hs` around lines 122 - 128, The property
prop_doubleEntryBalance is wrong: it returns True for unbalanced entries and
checks per-entry equality (atDbtAmt t == atCrdAmt t) instead of the aggregate
invariant. Fix prop_doubleEntryBalance to compute totalDebit = sum (map atDbtAmt
entries) and totalCredit = sum (map atCrdAmt entries) (or use appropriate
numeric folds), then assert that when totalDebit == totalCredit the result of
verifyDoubleEntry entries is AccOpSuccess, and when they differ
verifyDoubleEntry returns a non-success (or specific failure); remove the
per-entry equality check and the unconditional else True branch so the property
directly tests the aggregate double-entry invariant using verifyDoubleEntry.
Comment on lines
+178
to
+202
| instance Arbitrary AccTurn where | ||
| arbitrary = | ||
| AccTurn | ||
| <$> arbitrary | ||
| <*> arbitrary | ||
| <*> arbitrary | ||
| <*> (fromGregorian <$> arbitrary <*> arbitrary <*> arbitrary) | ||
| <*> suchThat arbitrary (>= 0) | ||
| <*> arbitrary | ||
| <*> suchThat arbitrary (>= 0) | ||
| <*> arbitrary | ||
| <*> arbitrary | ||
| <*> arbitrary | ||
| <*> suchThat arbitrary (>= 0) | ||
| <*> suchThat arbitrary (>= 0) | ||
|
|
||
| instance Arbitrary Accrual where | ||
| arbitrary = | ||
| Accrual | ||
| <$> arbitrary | ||
| <*> arbitrary | ||
| <*> arbitrary | ||
| <*> suchThat arbitrary (>= 0) | ||
| <*> (fromGregorian <$> arbitrary <*> arbitrary <*> arbitrary) | ||
| <*> arbitrary |
There was a problem hiding this comment.
Arbitrary AccTurn currently generates invalid accounting turns.
The generator can produce both atDbtAmt > 0 and atCrdAmt > 0 (or both zero), which conflicts with your own validateAccTurn rule and weakens accounting property tests.
Suggested generator shape
instance Arbitrary AccTurn where
- arbitrary =
- AccTurn
- <$> arbitrary
- <*> arbitrary
- <*> arbitrary
- <*> (fromGregorian <$> arbitrary <*> arbitrary <*> arbitrary)
- <*> suchThat arbitrary (>= 0)
- <*> arbitrary
- <*> suchThat arbitrary (>= 0)
- <*> arbitrary
- <*> arbitrary
- <*> arbitrary
- <*> suchThat arbitrary (>= 0)
- <*> suchThat arbitrary (>= 0)
+ arbitrary = do
+ y <- choose (2000, 2100)
+ m <- choose (1, 12)
+ d <- choose (1, 28)
+ amt <- suchThat arbitrary (> 0)
+ isDebit <- arbitrary
+ let dbt = if isDebit then amt else 0
+ crd = if isDebit then 0 else amt
+ AccTurn
+ <$> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> pure (fromGregorian y m d)
+ <*> pure amt
+ <*> arbitrary
+ <*> suchThat arbitrary (> 0)
+ <*> arbitrary
+ <*> arbitrary
+ <*> arbitrary
+ <*> pure dbt
+ <*> pure crdBased on learnings: Applies to **/*.hs : Ensure double-entry accounting invariant: Sum of Debit entries equals Sum of Credit entries.
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Core/Accounting/Types.hs` around lines 178 - 202, The AccTurn Arbitrary
generator currently allows atDbtAmt and atCrdAmt to both be positive or both
zero which violates validateAccTurn; change the AccTurn generator so it picks a
single non-negative amount (use suchThat arbitrary (>=0) or choosePositive) and
a boolean/enum indicating debit vs credit, then set atDbtAmt = amount and
atCrdAmt = 0 when debit, or atDbtAmt = 0 and atCrdAmt = amount when credit;
ensure any other amount-like fields in the AccTurn construction follow the same
double-entry pattern so the generated AccTurn always satisfies validateAccTurn
(refer to the AccTurn constructor, atDbtAmt, atCrdAmt, and validateAccTurn).
Comment on lines
+37
to
39
| {-@ calcInvoiceBalance :: Invoice -> NonNeg @-} | ||
| calcInvoiceBalance :: Invoice -> Double | ||
| calcInvoiceBalance i = invTotal i - invPaid i |
There was a problem hiding this comment.
calcInvoiceBalance can violate its declared NonNeg contract.
Line 39 can return a negative value when invPaid > invTotal. The annotation says non-negative, but runtime logic does not enforce it.
Proposed fix
calcInvoiceBalance :: Invoice -> Double
-calcInvoiceBalance i = invTotal i - invPaid i
+calcInvoiceBalance i = max 0 (invTotal i - invPaid i)📝 Committable suggestion
‼️ IMPORTANT
Carefully review the code before committing. Ensure that it accurately replaces the highlighted code, contains no missing lines, and has no issues with indentation. Thoroughly test & benchmark the code to ensure it meets the requirements.
Suggested change
| {-@ calcInvoiceBalance :: Invoice -> NonNeg @-} | |
| calcInvoiceBalance :: Invoice -> Double | |
| calcInvoiceBalance i = invTotal i - invPaid i | |
| {-@ calcInvoiceBalance :: Invoice -> NonNeg `@-`} | |
| calcInvoiceBalance :: Invoice -> Double | |
| calcInvoiceBalance i = max 0 (invTotal i - invPaid i) |
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Core/Invoice.hs` around lines 37 - 39, calcInvoiceBalance currently
computes invTotal i - invPaid i which can be negative and thus violate the
NonNeg contract; update calcInvoiceBalance to ensure a non-negative result by
returning the maximum of 0 and the computed difference (i.e., clamp negative
results to 0) so the function always satisfies the NonNeg annotation,
referencing the Invoice fields invTotal and invPaid used in calcInvoiceBalance.
Comment on lines
+63
to
+84
| {-@ isCompleted :: Payment -> Bool @-} | ||
| isCompleted :: Payment -> Bool | ||
| isCompleted p = payStatus p == PSCompleted | ||
|
|
||
| -- | Check if payment can be refunded | ||
| -- = Invariant: can only refund completed positive payments | ||
|
|
||
| {-@ canRefund :: Payment -> Bool @-} | ||
| canRefund :: Payment -> Bool | ||
| canRefund p = payStatus p == PSCompleted && payAmount p > 0 | ||
|
|
||
| -- | Calculate payment amount (ensure non-negative) | ||
| -- = Invariant: result >= 0 | ||
|
|
||
| {-@ calcPaymentAmount :: Double -> NonNeg @-} | ||
| calcPaymentAmount :: Double -> Double | ||
| calcPaymentAmount = max 0 | ||
|
|
||
| -- | Validate payment | ||
| -- = Invariant: amount must be positive | ||
|
|
||
| {-@ validatePayment :: Payment -> Bool @-} |
There was a problem hiding this comment.
🧩 Analysis chain
🌐 Web query:
In LiquidHaskell, does an annotation like {-@ canRefund :: Payment -> Bool @-}enforce any predicate beyond the plain Haskell type? What is the correct way to express that the returnedBoolis equivalent topayStatus p == PSCompleted && payAmount p > 0?
💡 Result:
No, the annotation {-@ canRefund :: Payment -> Bool @-} does not enforce any predicate beyond the plain Haskell type Payment -> Bool. It merely specifies the Haskell type without any refinement on the input or output. The correct way to express that the returned Bool is equivalent to payStatus p == PSCompleted && payAmount p > 0 is to use a refined return type with the Prop predicate: {-@ canRefund :: p:Payment -> {v:Bool | Prop v <=> (payStatus p == PSCompleted && payAmount p > 0)} @-} This postcondition ensures LiquidHaskell verifies that whenever canRefund p is called, the returned boolean value v satisfies v == (payStatus p == PSCompleted && payAmount p > 0). To use payStatus and payAmount in refinements, they must be made available in the refinement logic, typically via reflect or inline annotations, e.g.: {-@ reflect payStatus @-} {-@ reflect payAmount @-} LiquidHaskell will then check that the implementation of canRefund satisfies this equivalence.
Citations:
- 1: https://ucsd-progsys.github.io/liquidhaskell/specifications/
- 2: http://goto.ucsd.edu/~gridaphobe/liquid/haskell/blog/blog/2013/01/01/refinement-types-101.lhs
- 3: https://liquid.kosmikus.org/01-intro.html
- 4: https://ucsd-progsys.github.io/liquidhaskell-tutorial/Tutorial_06_Measure_Bool.html
- 5: https://stackoverflow.com/questions/38938431/using-liquid-haskell-to-check-for-valid-tokens
- 6: https://ucsd-progsys.github.io/liquidhaskell/blogposts/2016-09-18-refinement-reflection.lhs/
These LiquidHaskell signatures do not express refinement predicates.
Annotations like {-@ canRefund :: Payment -> Bool @-} restate the plain Haskell type without any refinement. To enforce the invariants described in the comments, use postconditions with Prop and logical equivalence:
{-@ canRefund :: p:Payment -> {v:Bool | Prop v <=> (payStatus p == PSCompleted && payAmount p > 0)} `@-`}
Additionally, expose payStatus and payAmount in the refinement logic:
{-@ reflect payStatus `@-`}
{-@ reflect payAmount `@-`}
Apply the same approach to isCompleted and validatePayment. This ensures LiquidHaskell actually verifies the stated invariants rather than just replicating the type signature.
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Core/Payment.hs` around lines 63 - 84, Replace the plain LiquidHaskell
type annotations with proper refinement postconditions and reflectors: add {-@
reflect payStatus `@-`} and {-@ reflect payAmount `@-`} so payStatus/payAmount are
usable in specs, change isCompleted to a postcondition tying its Bool result to
(payStatus p == PSCompleted), change canRefund to a Prop-equivalence spec like
{v:Bool | Prop v <=> (payStatus p == PSCompleted && payAmount p > 0)}, give
calcPaymentAmount a refined return type ensuring non-negativity (e.g. {v:Double
| v >= 0} or NonNeg), and annotate validatePayment similarly with a
Prop-equivalence relating its Bool result to the intended predicate (e.g.
payAmount p > 0); update the annotations for the functions isCompleted,
canRefund, calcPaymentAmount, and validatePayment accordingly.
Comment on lines
+42
to
+43
| let s = initial + sum (fmap smQtty movements) | ||
| in if s < 0 then 0 else s |
There was a problem hiding this comment.
Silently clamping negative stock balance may hide data integrity issues.
While clamping ensures the LiquidHaskell NonNeg refinement is satisfied, it masks cases where stock tracking has gone wrong (e.g., issuing more than available without proper checks). Consider returning an Either to signal an error condition or logging a warning when clamping occurs.
Based on learnings: "Ensure stock invariant: Rest = Initial + Receipt - Issue" — this clamping breaks the mathematical invariant.
🔧 Alternative: Return Either for error handling
-calcStockBalance :: Double -> [StockMovement] -> Double
-calcStockBalance initial movements =
- let s = initial + sum (fmap smQtty movements)
- in if s < 0 then 0 else s
+calcStockBalance :: Double -> [StockMovement] -> Either Text Double
+calcStockBalance initial movements =
+ let s = initial + sum (fmap smQtty movements)
+ in if s < 0
+ then Left "Stock balance went negative - data integrity issue"
+ else Right s🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Core/Warehouse.hs` around lines 42 - 43, The current clamp (let s =
initial + sum (fmap smQtty movements) in if s < 0 then 0 else s) hides negative
balances; change the function to surface errors instead of silently returning 0
by returning an Either (e.g., Either StockError NonNeg) or at minimum logging
when s < 0; compute s using the same symbols (initial, movements, smQtty), and
if s < 0 return Left with a descriptive error (or emit a warning and Left)
otherwise wrap the non-negative value in Right (or convert to the NonNeg
refinement), and update callers to handle the Either result to preserve the
invariant and avoid masking data integrity problems.
| import Network.Wai (Middleware, Request, rawPathInfo, requestHeaders, responseLBS) | ||
| import qualified Network.Wai as Wai | ||
| import Surypus.JWT (JWTConfig (..), JWTPayload (..), validateAccessToken) | ||
| import Surypus.JWT (JWTConfig (..), JWTPayload (..)) |
There was a problem hiding this comment.
Authorization can be forged in middleware.
Line 19 aligns with removing validation helper usage, while validateJWT still only decodes token content. This permits privilege escalation by crafting payload JSON. Verify token integrity/claims before header injection.
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Surypus/API/JWTMiddleware.hs` at line 19, validateJWT currently only
decodes token content and the middleware injects headers based on that decoded
payload, allowing forged payloads to escalate privileges; update validateJWT
(and any JWTMiddleware handler that calls it) to perform full signature
verification and claim checks before header injection: use the key/secret from
JWTConfig, verify the token signature integrity (not just decode), validate
standard claims (exp, nbf, iss, aud as applicable) and only return/allow
JWTPayload when verification passes, then move any header injection in the
middleware to occur after validateJWT returns a verified payload.
Comment on lines
+30
to
+34
| -- | Full API with Swagger documentation | ||
| type APIWithDoc = APIv1 :<|> "swagger.json" :> Get '[JSON] Value | ||
|
|
||
| apiSwagger :: Value | ||
| apiSwagger = String "Swagger documentation endpoint" |
There was a problem hiding this comment.
🧩 Analysis chain
🏁 Script executed:
#!/bin/bash
# Check if servant-swagger is being used elsewhere or if ToSchema instances exist
rg -n 'ToSchema|toSwagger' --type hsRepository: dominicusin/Surypus
Length of output: 45
🏁 Script executed:
#!/bin/bash
# First, let's read the actual file content around lines 30-34
echo "=== File content around lines 30-34 ==="
sed -n '25,40p' src/Surypus/API/Root.hs
# Check file size to understand scope
echo -e "\n=== File stats ==="
wc -l src/Surypus/API/Root.hs
# Look for dependency files
echo -e "\n=== Dependency files ==="
find . -maxdepth 2 -name "*.cabal" -o -name "stack.yaml" -o -name "package.json" -o -name "*.lock" | head -20Repository: dominicusin/Surypus
Length of output: 1051
🏁 Script executed:
#!/bin/bash
# Check if servant-swagger is a dependency
echo "=== Checking for servant-swagger dependency ==="
find . -maxdepth 2 \( -name "*.cabal" -o -name "stack.yaml" \) -exec grep -l "servant-swagger" {} \;
# Also check for Swagger imports in the file
echo -e "\n=== Current imports in Root.hs ==="
head -30 src/Surypus/API/Root.hs | grep -E "^import|^{-#"Repository: dominicusin/Surypus
Length of output: 661
🏁 Script executed:
#!/bin/bash
# Look for APIv1 definition to understand the API structure
echo "=== Looking for APIv1 definition ==="
rg -n "type APIv1" --type hs
# Check what Value is and where it comes from
echo -e "\n=== Checking Value type ==="
head -50 src/Surypus/API/Root.hs | grep -E "Value|import.*Aeson|from aeson"Repository: dominicusin/Surypus
Length of output: 376
🏁 Script executed:
#!/bin/bash
# Check if servant-swagger is actually listed in dependencies
echo "=== Checking Surypus.cabal for servant-swagger ==="
grep -n "servant-swagger" Surypus.cabal
echo -e "\n=== Checking stack.yaml for servant-swagger ==="
grep -n "servant-swagger" stack.yaml
# Check if there are any Swagger-related modules/implementations elsewhere
echo -e "\n=== Searching for Swagger-related code ==="
rg -n "Swagger|swagger" --type hs | head -20Repository: dominicusin/Surypus
Length of output: 1396
🏁 Script executed:
#!/bin/bash
# Look at more context in Root.hs to understand the full picture
echo "=== Full context of Swagger endpoint area ==="
sed -n '26,40p' src/Surypus/API/Root.hs
# Check if there are any other JSON response endpoints to see patterns
echo -e "\n=== Checking other API endpoint patterns ==="
grep -n "Get '\[JSON\]" src/Surypus/API/Root.hs | head -5Repository: dominicusin/Surypus
Length of output: 1390
Swagger endpoint returns a placeholder string instead of the actual API specification.
The apiSwagger function returns String "Swagger documentation endpoint" instead of generating a real OpenAPI/Swagger specification. While servant-swagger is already a project dependency, it's not being used to generate the spec at runtime. Implement the endpoint using servant-swagger to serve the actual API documentation.
Suggested implementation
+import Data.Swagger (Swagger)
+import Servant.Swagger (toSwagger)
+
-- | Full API with Swagger documentation
type APIWithDoc = APIv1 :<|> "swagger.json" :> Get '[JSON] Value
-apiSwagger :: Value
-apiSwagger = String "Swagger documentation endpoint"
+apiSwagger :: Swagger
+apiSwagger = toSwagger (Proxy :: Proxy APIv1)This requires that all request/response types used in APIv1 derive ToSchema from the swagger library.
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Surypus/API/Root.hs` around lines 30 - 34, Replace the placeholder
apiSwagger implementation with a real Swagger/OpenAPI generation using
servant-swagger: import Servant.Swagger (toSwagger), Data.Aeson (toJSON) and
return toJSON (toSwagger (Proxy :: Proxy APIv1)) in apiSwagger; ensure
APIWithDoc remains as APIv1 :<|> "swagger.json" :> Get '[JSON] Value and that
all request/response types referenced by APIv1 derive ToSchema so toSwagger can
generate the spec.
Comment on lines
+11
to
+27
| import DAL.Types | ||
| ( QueryResult (..), | ||
| ) | ||
| import Data.Int (Int64) | ||
| import Hasql.Pool (Pool) | ||
|
|
||
| listStock :: Pool -> IO (QueryResult [(Int64, Text, Int, Double, Double)]) | ||
| listStock = Q.getStockSummary | ||
|
|
||
| getStockSummary :: Pool -> IO (QueryResult [(Int64, Text, Int, Double, Double)]) | ||
| getStockSummary = Q.getStockSummary | ||
|
|
||
| getStockByLocation :: Pool -> Int64 -> IO (QueryResult [Stock]) | ||
| getStockByLocation = Q.getStockByLocation | ||
|
|
||
| getStockByGoods :: Pool -> Int64 -> IO (QueryResult [Stock]) | ||
| getStockByGoods = Q.getStockByGoods |
There was a problem hiding this comment.
Bring Text and Stock into scope.
The exported signatures on Lines 17-27 reference Text and Stock, but this module never imports either name, so it will fail to compile.
Suggested fix
import qualified DAL.Queries as Q
import DAL.Types
( QueryResult (..),
+ Stock,
)
import Data.Int (Int64)
+import Data.Text (Text)
import Hasql.Pool (Pool)🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Surypus/API/Stock.hs` around lines 11 - 27, The module declares functions
listStock, getStockSummary, getStockByLocation, and getStockByGoods whose type
signatures reference Text and Stock but those names are not imported; fix by
adding imports that bring Text (e.g., from Data.Text) and the Stock type (from
the appropriate DAL or Types module where Stock is defined) into scope so the
signatures compile—update the import list at the top of src/Surypus/API/Stock.hs
to include Text and Stock.
Comment on lines
+376
to
+423
| adminRole :: RolePermission | ||
| adminRole = | ||
| RolePermission | ||
| RoleAdmin | ||
| [ AdminAccess, | ||
| PersonRead, | ||
| PersonWrite, | ||
| PersonDelete, | ||
| GoodsRead, | ||
| GoodsWrite, | ||
| GoodsDelete, | ||
| BillRead, | ||
| BillWrite, | ||
| BillDelete, | ||
| BillPost, | ||
| LocationRead, | ||
| LocationWrite, | ||
| LocationDelete, | ||
| UsersRead, | ||
| UsersWrite, | ||
| TaxRead, | ||
| TaxWrite, | ||
| TaxDelete, | ||
| SyncRead, | ||
| SyncWrite, | ||
| SyncDelete, | ||
| AuditRead, | ||
| AuditWrite, | ||
| AuditDelete, | ||
| RBACRead, | ||
| RBACWrite, | ||
| RBACDelete, | ||
| JDBCRead, | ||
| JDBCWrite, | ||
| JDBCDelete, | ||
| CacheRead, | ||
| CacheWrite, | ||
| CacheDelete, | ||
| MetricsRead, | ||
| MetricsWrite, | ||
| MetricsDelete, | ||
| HealthRead, | ||
| HealthWrite, | ||
| HealthDelete, | ||
| WSRead, | ||
| WSWrite, | ||
| WSDelete | ||
| ] |
There was a problem hiding this comment.
🧩 Analysis chain
🏁 Script executed:
#!/bin/bash
# Description: Extract and compare admin vs manager permissions
echo "=== Admin permissions ==="
rg -A 50 '^adminRole ::' src/Surypus/RBAC.hs | rg '^\s+[A-Z][a-zA-Z]+,' | head -50
echo ""
echo "=== Manager permissions ==="
rg -A 30 '^managerRole ::' src/Surypus/RBAC.hs | rg '^\s+[A-Z][a-zA-Z]+,' | head -30Repository: dominicusin/Surypus
Length of output: 1180
🏁 Script executed:
#!/bin/bash
# Get file line count to understand size
wc -l src/Surypus/RBAC.hs
# Extract adminRole definition completely
echo "=== Full adminRole definition ==="
sed -n '376,423p' src/Surypus/RBAC.hs
echo ""
echo "=== Full managerRole definition ==="
# Find managerRole and extract it
rg -n '^managerRole ::' src/Surypus/RBAC.hsRepository: dominicusin/Surypus
Length of output: 1033
🏁 Script executed:
#!/bin/bash
# Get all Permission data constructors to understand the complete set
echo "=== All Permission constructors ==="
rg -A 150 '^data Permission' src/Surypus/RBAC.hs | head -200Repository: dominicusin/Surypus
Length of output: 5752
🏁 Script executed:
#!/bin/bash
# Extract managerRole definition (starts at line 328)
sed -n '328,370p' src/Surypus/RBAC.hsRepository: dominicusin/Surypus
Length of output: 795
adminRole is missing permissions that managerRole has, creating an inverted permission hierarchy.
The admin role lacks the following permissions that manager has:
PaymentRead,PaymentWriteStockReadAccountingReadPayrollReadReportsReadBillsWrite,OrdersWrite,TaxesWrite,CurrenciesWrite
This means a manager would have access to payment, stock, accounting, and payroll features that an admin cannot access, which is likely unintended.
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@src/Surypus/RBAC.hs` around lines 376 - 423, The adminRole RolePermission is
missing several permissions that managerRole has; update the adminRole
permission list in the adminRole definition to include PaymentRead,
PaymentWrite, StockRead, AccountingRead, PayrollRead, ReportsRead, BillsWrite,
OrdersWrite, TaxesWrite and CurrenciesWrite so admin has at least the same
capabilities as manager; locate the adminRole value (RolePermission RoleAdmin
[...]) and append these missing permission constructors to the permissions list
to restore the intended hierarchy.
Comment on lines
+44
to
+158
| instance Arbitrary PersonInput where | ||
| arbitrary = do | ||
| code <- oneof [pure Nothing, Just . T.pack <$> suchThat (arbitrary :: Gen String) (\s -> length s > 0)] | ||
| name <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0 && T.length n <= 255) | ||
| inn <- oneof [pure Nothing, Just . T.pack <$> suchThat (arbitrary :: Gen String) (\s -> length s == 10 || length s == 12)] | ||
| kpp <- oneof [pure Nothing, Just . T.pack <$> suchThat (arbitrary :: Gen String) (\s -> length s == 9)] | ||
| ptype <- suchThat arbitrary (>= 0) | ||
| status <- suchThat arbitrary (>= 0) | ||
| pure $ PersonInput code name inn kpp (toEnum ptype) (toEnum status) | ||
|
|
||
| -- | GoodsInput generator - matches DAL.Types | ||
| instance Arbitrary GoodsInput where | ||
| arbitrary = do | ||
| code <- oneof [pure Nothing, Just . T.pack <$> suchThat arbitrary (\s -> length s > 0)] | ||
| name <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0 && T.length n <= 255) | ||
| barcode <- oneof [pure Nothing, Just . T.pack <$> suchThat arbitrary (\s -> length s > 0)] | ||
| unitId <- suchThat arbitrary (> 0) | ||
| parentId <- oneof [pure Nothing, Just <$> suchThat arbitrary (> 0)] | ||
| pure $ GoodsInput code name barcode unitId parentId | ||
|
|
||
| -- | BillInput generator - matches DAL.Types | ||
| instance Arbitrary BillInput where | ||
| arbitrary = do | ||
| code <- oneof [pure Nothing, Just . T.pack <$> suchThat arbitrary (\s -> length s > 0)] | ||
| billType <- suchThat arbitrary (>= 0) | ||
| status <- suchThat arbitrary (>= 0) | ||
| date <- fromGregorian <$> choose (2020, 2025) <*> choose (1, 12) <*> choose (1, 28) | ||
| personId <- oneof [pure Nothing, Just <$> suchThat arbitrary (> 0)] | ||
| locationId <- oneof [pure Nothing, Just <$> suchThat arbitrary (> 0)] | ||
| total <- arbitrary | ||
| discount <- arbitrary | ||
| tax <- arbitrary | ||
| pure $ BillInput code billType status date personId locationId total discount tax | ||
|
|
||
| -- | LocationInput generator - matches DAL.Types | ||
| instance Arbitrary LocationInput where | ||
| arbitrary = do | ||
| code <- oneof [pure Nothing, Just . T.pack <$> suchThat arbitrary (\s -> length s > 0)] | ||
| name <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0 && T.length n <= 255) | ||
| locType <- suchThat arbitrary (>= 0) | ||
| pure $ LocationInput code name locType | ||
|
|
||
| -- | OrderInput generator - matches DAL.Types | ||
| instance Arbitrary OrderInput where | ||
| arbitrary = do | ||
| code <- oneof [pure Nothing, Just . T.pack <$> suchThat arbitrary (\s -> length s > 0)] | ||
| name <- oneof [pure Nothing, Just . T.pack <$> suchThat arbitrary (\s -> length s > 0)] | ||
| date <- fromGregorian <$> choose (2020, 2025) <*> choose (1, 12) <*> choose (1, 28) | ||
| personId <- oneof [pure Nothing, Just <$> suchThat arbitrary (> 0)] | ||
| locationId <- oneof [pure Nothing, Just <$> suchThat arbitrary (> 0)] | ||
| status <- suchThat arbitrary (>= 0) | ||
| total <- arbitrary | ||
| discount <- arbitrary | ||
| tax <- arbitrary | ||
| pure $ OrderInput code name date personId locationId status total discount tax | ||
|
|
||
| -- | PaymentInput generator - matches DAL.Types | ||
| instance Arbitrary PaymentInput where | ||
| arbitrary = do | ||
| billId <- suchThat arbitrary (> 0) | ||
| payDate <- fromGregorian <$> choose (2020, 2025) <*> choose (1, 12) <*> choose (1, 28) | ||
| amount <- arbitrary `suchThat` (> 0) | ||
| payMethod <- suchThat arbitrary (>= 0) | ||
| payStatus <- suchThat arbitrary (>= 0) | ||
| pure $ PaymentInput billId payDate amount payMethod payStatus | ||
|
|
||
| -- | PriceInput generator - matches DAL.Types | ||
| instance Arbitrary PriceInput where | ||
| arbitrary = do | ||
| goodsId <- suchThat arbitrary (> 0) | ||
| priceType <- suchThat arbitrary (>= 0) | ||
| price <- arbitrary | ||
| currencyId <- suchThat arbitrary (> 0) | ||
| fromDate <- fromGregorian <$> choose (2020, 2025) <*> choose (1, 12) <*> choose (1, 28) | ||
| toDate <- oneof [pure Nothing, Just <$> (fromGregorian <$> choose (2025, 2030) <*> choose (1, 12) <*> choose (1, 28))] | ||
| pure $ PriceInput goodsId priceType price currencyId fromDate toDate | ||
|
|
||
| -- | TaxInput generator | ||
| instance Arbitrary TaxInput where | ||
| arbitrary = do | ||
| name <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0) | ||
| rate <- suchThat arbitrary (\r -> r >= 0 && r <= 100) | ||
| taxType <- suchThat arbitrary (>= 0) | ||
| included <- arbitrary | ||
| pure $ TaxInput name rate taxType included | ||
|
|
||
| -- | CurrencyInput generator | ||
| instance Arbitrary CurrencyInput where | ||
| arbitrary = do | ||
| code <- suchThat (T.pack <$> arbitrary) (\c -> T.length c == 3) | ||
| name <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0) | ||
| symbol <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0) | ||
| rate <- arbitrary `suchThat` (> 0) | ||
| pure $ CurrencyInput code name symbol rate | ||
|
|
||
| -- | AccPlanInput generator | ||
| instance Arbitrary AccPlanInput where | ||
| arbitrary = do | ||
| code <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0) | ||
| name <- suchThat (T.pack <$> arbitrary) (\n -> T.length n > 0) | ||
| accType <- suchThat arbitrary (\t -> t >= 0 && t <= 4) | ||
| parentCode <- oneof [pure Nothing, Just . T.pack <$> suchThat (arbitrary :: Gen String) (\s -> length s > 0)] | ||
| kind <- suchThat arbitrary (>= 0) | ||
| isAnalytical <- arbitrary | ||
| pure $ AccPlanInput code name accType parentCode kind isAnalytical | ||
|
|
||
| -- | AccTurnInput generator | ||
| instance Arbitrary AccTurnInput where | ||
| arbitrary = do | ||
| dbtAccId <- suchThat arbitrary (> 0) | ||
| crdAccId <- suchThat arbitrary (> 0) | ||
| amount <- arbitrary `suchThat` (> 0) | ||
| date <- fromGregorian <$> choose (2020, 2025) <*> choose (1, 12) <*> choose (1, 28) | ||
| billId <- oneof [pure Nothing, Just <$> suchThat arbitrary (> 0)] | ||
| pure $ AccTurnInput dbtAccId crdAccId amount date billId |
There was a problem hiding this comment.
🧩 Analysis chain
🏁 Script executed:
#!/bin/bash
# Check record field order in DAL.Types for key input types
rg -A 10 "^data PersonInput|^data GoodsInput|^data BillInput|^data AccTurnInput" --type=hs src/DAL/Types.hsRepository: dominicusin/Surypus
Length of output: 1015
🏁 Script executed:
rg -A 8 "^data LocationInput|^data OrderInput|^data PaymentInput|^data PriceInput|^data TaxInput|^data CurrencyInput|^data AccPlanInput" --type=hs src/DAL/Types.hsRepository: dominicusin/Surypus
Length of output: 1459
Use record syntax for all Arbitrary instances instead of positional construction.
Field order verification passed—all instances correctly match their definitions in DAL.Types. However, the coding guideline requires record syntax for data types with multiple fields. Rewrite all 11 Arbitrary instances (PersonInput through AccTurnInput) using record syntax with explicit field names (e.g., PersonInput { piCode = code, piName = name, ... } instead of PersonInput code name ... ).
🤖 Prompt for AI Agents
Verify each finding against the current code and only fix it if needed.
In `@test/Integration/ValidationSpec.hs` around lines 44 - 158, Replace positional
constructors with record syntax in each Arbitrary instance: use PersonInput {
piCode = code, piName = name, piInn = inn, piKpp = kpp, piPersonType = toEnum
ptype, piStatus = toEnum status }; GoodsInput { giCode = code, giName = name,
giBarcode = barcode, giUnitId = unitId, giParentId = parentId }; BillInput {
biCode = code, biBillType = billType, biStatus = status, biDate = date,
biPersonId = personId, biLocationId = locationId, biTotal = total, biDiscount =
discount, biTax = tax }; LocationInput { liCode = code, liName = name, liLocType
= locType }; OrderInput { oiCode = code, oiName = name, oiDate = date,
oiPersonId = personId, oiLocationId = locationId, oiStatus = status, oiTotal =
total, oiDiscount = discount, oiTax = tax }; PaymentInput { payBillId = billId,
payDate = payDate, payAmount = amount, payMethod = payMethod, payStatus =
payStatus }; PriceInput { prGoodsId = goodsId, prPriceType = priceType, prPrice
= price, prCurrencyId = currencyId, prFromDate = fromDate, prToDate = toDate };
TaxInput { txName = name, txRate = rate, txType = taxType, txIncluded = included
}; CurrencyInput { curCode = code, curName = name, curSymbol = symbol, curRate =
rate }; AccPlanInput { apCode = code, apName = name, apType = accType,
apParentCode = parentCode, apKind = kind, apIsAnalytical = isAnalytical };
AccTurnInput { atDbtAccId = dbtAccId, atCrdAccId = crdAccId, atAmount = amount,
atDate = date, atBillId = billId } — update each instance's final `pure $ ...`
to use the corresponding record form above.
7 tasks
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
1 participant
Add this suggestion to a batch that can be applied as a single commit.This suggestion is invalid because no changes were made to the code.Suggestions cannot be applied while the pull request is closed.Suggestions cannot be applied while viewing a subset of changes.Only one suggestion per line can be applied in a batch.Add this suggestion to a batch that can be applied as a single commit.Applying suggestions on deleted lines is not supported.You must change the existing code in this line in order to create a valid suggestion.Outdated suggestions cannot be applied.This suggestion has been applied or marked resolved.Suggestions cannot be applied from pending reviews.Suggestions cannot be applied on multi-line comments.Suggestions cannot be applied while the pull request is queued to merge.Suggestion cannot be applied right now. Please check back later.
Summary
Why
Changes
Testing
How to test
Summary by CodeRabbit
New Features
Refactoring
Removed Features