diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,3 +3,19 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## [0.2.0.0] - 2025-04-12 + +### Changed + +- Refactored the ERPNext.Client.Filters module. + +### Fixed + +- Fix percent-encoding. +- Fix encoding of double quotes in filters and query string. + +## [0.1.0.1] +## [0.1.0.0] + +Initial release. diff --git a/erpnext-api-client.cabal b/erpnext-api-client.cabal --- a/erpnext-api-client.cabal +++ b/erpnext-api-client.cabal @@ -1,13 +1,13 @@ cabal-version: 3.6 name: erpnext-api-client -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Generic API client library for ERPNext description: This is a Haskell API client for ERPNext. It aims to be a light-weight library based on http-client and user-provided record types. homepage: https://github.com/schoettl/erpnext-api-client license: MIT license-file: LICENSE -author: Jakob Schöttl +author: Jakob Schöttl, Omar Elbeltagui maintainer: jakob.schoettl@intensovet.de copyright: 2025 Intensovet GmbH category: API @@ -29,6 +29,39 @@ , time , network-uri , bytestring + default-language: GHC2021 + ghc-options: -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wmissing-export-lists + -Wmissing-home-modules + -Wpartial-fields + -Wredundant-constraints + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: ERPNext.Client + , ERPNext.Client.Helper + , ERPNext.Client.Filters + , ERPNext.Client.QueryStringParams + hs-source-dirs: test + , src + build-depends: base + , erpnext-api-client + , http-client + , http-types + , text + , aeson + , time + , network-uri + , bytestring + , doctest >= 0.22.2 && < 1 + , hedgehog >= 1.4 && < 1.6 + , hspec >= 2.11.7 && < 2.12 + , hspec-hedgehog >= 0.1.0 default-language: GHC2021 ghc-options: -Wall -Wcompat diff --git a/src/ERPNext/Client/Filters.hs b/src/ERPNext/Client/Filters.hs --- a/src/ERPNext/Client/Filters.hs +++ b/src/ERPNext/Client/Filters.hs @@ -2,90 +2,91 @@ module ERPNext.Client.Filters ( Filter (..) - , FilterOperator (..) + , Fieldname , FilterValue (..) , renderFilters ) where -import Data.Text (Text, intercalate) +import Data.Text (Text, intercalate, pack) -- pack is used in doctests! import Data.Time.Calendar (Day) -import ERPNext.Client.Helper (urlEncode, quote, tshow) +import ERPNext.Client.Helper --- TODO: refactor this? rename to filter and parameterize each term with fieldname and value? -data FilterOperator - = Eq - | NotEq - | Greater - | GreaterOrEq - | Less - | LessOrEq - | Like - | NotLike - | In - | NotIn - | Between - | Is +data Filter + = Eq Fieldname FilterValue + | NotEq Fieldname FilterValue + | Greater Fieldname FilterValue + | GreaterOrEq Fieldname FilterValue + | Less Fieldname FilterValue + | LessOrEq Fieldname FilterValue + | Like Fieldname FilterValue + | NotLike Fieldname FilterValue + | In Fieldname [FilterValue] + | NotIn Fieldname [FilterValue] + | Between Fieldname FilterValue FilterValue + | IsNull Fieldname + | IsNotNull Fieldname deriving (Show, Eq) data FilterValue = FilterText Text | FilterNumber Double | FilterBool Bool - | FilterList [FilterValue] | FilterDay Day - | FilterNull -- Used only with Is - | FilterNotNull -- Used only with Is deriving (Show, Eq) -data Filter = Filter - { filterField :: Text - , filterOperator :: FilterOperator - , filterValue :: FilterValue - } - deriving (Show, Eq) +renderFilter :: Filter -> Text +renderFilter f = + case f of + Eq field val -> renderWithValue field "=" val + NotEq field val -> renderWithValue field "!=" val + Greater field val -> renderWithValue field ">" val + GreaterOrEq field val-> renderWithValue field ">=" val + Less field val -> renderWithValue field "<" val + LessOrEq field val -> renderWithValue field "<=" val + Like field val -> renderWithValue field "like" val + NotLike field val -> renderWithValue field "not like" val + In field vals -> renderWithArray field "in" vals + NotIn field vals -> renderWithArray field "not in" vals + Between field val1 val2 -> renderWithArray field "between" [val1, val2] + IsNull field -> renderWithText field "is" "not set" + IsNotNull field -> renderWithText field "is" "set" -renderFilterOperator :: FilterOperator -> Text -renderFilterOperator op = - case op of - Eq -> "=" - NotEq -> "!=" - Greater -> ">" - GreaterOrEq -> ">=" - Less -> "<" - LessOrEq -> "<=" - Like -> "like" - NotLike -> "not like" - In -> "in" - NotIn -> "not in" - Between -> "between" - Is -> "is" +renderWithValue :: Fieldname -> Text -> FilterValue -> Text +renderWithValue field op val = + renderTextArray [quote field, quote op, renderFilterValue val] +renderWithText :: Fieldname -> Text -> Text -> Text +renderWithText field op txt = + renderTextArray [quote field, quote op, quote txt] + +renderWithArray :: Fieldname -> Text -> [FilterValue] -> Text +renderWithArray field op vals = + renderTextArray [quote field, quote op, renderTextArray (map renderFilterValue vals)] + +renderTextArray :: [Text] -> Text +renderTextArray xs = + "[" <> intercalate "," xs <> "]" + renderFilterValue :: FilterValue -> Text renderFilterValue fv = case fv of FilterText t -> quote t FilterNumber n -> tshow n FilterBool b -> if b then "1" else "0" - FilterList vs -> "[" <> intercalate ", " (map renderFilterValue vs) <> "]" FilterDay d -> quote (tshow d) - FilterNull -> quote "not set" - FilterNotNull -> quote "set" -renderFilter :: Filter -> Text -renderFilter f = - "[" - <> quote (filterField f) - <> "," - <> quote (renderFilterOperator (filterOperator f)) - <> "," - <> renderFilterValue (filterValue f) - <> "]" - -- | Render the filter terms for the URL query string. -renderFilters :: Text -> [Filter] -> Text -renderFilters prefix filters = +-- +-- >>> urlDecode $ renderFilters [Eq (pack "idx") (FilterNumber 99)] +-- "[[\"idx\",\"=\",99.0]]" +-- +-- >>> urlDecode $ renderFilters [IsNull (pack "status"), In (pack "name") [FilterText (pack "a"), FilterText (pack "b")]] +-- "[[\"status\",\"is\",\"not set\"],[\"name\",\"in\",[\"a\",\"b\"]]]" +-- +renderFilters :: [Filter] -> Text +renderFilters filters = let encoded = map renderFilter filters - str = "[" <> intercalate ", " encoded <> "]" + str = "[" <> intercalate "," encoded <> "]" in - prefix <> "=" <> urlEncode str + urlEncode str diff --git a/src/ERPNext/Client/Helper.hs b/src/ERPNext/Client/Helper.hs --- a/src/ERPNext/Client/Helper.hs +++ b/src/ERPNext/Client/Helper.hs @@ -2,23 +2,30 @@ module ERPNext.Client.Helper ( urlEncode + , urlDecode , quote , tshow + , Fieldname ) where import Data.Text -import Data.Text qualified as T -import Network.URI (escapeURIString, isUnreserved) +import Network.URI (escapeURIString, isUnreserved, unEscapeString) +-- | Type for field names of DocTypes. +type Fieldname = Text + -- | Percent-encode string for use in a URL. urlEncode :: Text -> Text urlEncode = pack . escapeURIString isUnreserved . unpack +-- | Opposite of 'urlEncode'. +urlDecode :: Text -> Text +urlDecode = pack . unEscapeString . unpack + sanitizeQuotes :: Text -> Text -sanitizeQuotes = T.filter (/= '"') +sanitizeQuotes = replace "\"" "\\\"" --- TODO: is it a good idea to just drop "? --- | Double-quote string after dropping existing double quotes. +-- | Double-quote string after backslash-escaping existing double quotes. quote :: Text -> Text quote t = "\"" <> sanitizeQuotes t <> "\"" diff --git a/src/ERPNext/Client/QueryStringParams.hs b/src/ERPNext/Client/QueryStringParams.hs --- a/src/ERPNext/Client/QueryStringParams.hs +++ b/src/ERPNext/Client/QueryStringParams.hs @@ -6,21 +6,19 @@ ) where import ERPNext.Client.Filters -import ERPNext.Client.Helper (urlEncode, quote, tshow) +import ERPNext.Client.Helper import Data.Text hiding (map) -- https://docs.frappe.io/framework/user/en/api/rest --- TODO: Maybe change type or make opaque type to prevent invalid combinations? --- TODO: add variants for limit, offset, etc.? data QueryStringParam = Debug Bool -- ^ If 'True', makes API returning query analysis info instead of data | AsDict Bool -- ^ If 'False', makes API returning the data records as mixed-type arrays which cannot be parsed by this library (default: 'True') | LimitStart Int -- ^ Page offset (starts at 0) | LimitPageLength Int -- ^ Page size - | Asc Text -- ^ Ascending order by given field - | Desc Text -- ^ Descending order by given field - | Fields [Text] -- ^ Select fields + | Asc Fieldname -- ^ Ascending order by given field + | Desc Fieldname -- ^ Descending order by given field + | Fields [Fieldname] -- ^ Select fields | AndFilter [Filter] -- ^ Filter terms combined with logical AND | OrFilter [Filter] -- ^ Filter terms combined with logical OR @@ -30,31 +28,41 @@ Debug b -> "debug=" <> tshow b AsDict b -> "as_dict=" <> tshow b LimitStart offset -> "limit_start=" <> tshow (max 0 offset) - LimitPageLength n -> "limit=" <> tshow n -- it was limit_page_length up to v13 + LimitPageLength n -> "limit=" <> tshow (max 0 n) -- it was named limit_page_length up to v13 Asc field -> - renderOrderBy field "asc" + "order_by=" <> renderOrderBy field "asc" Desc field -> - renderOrderBy field "desc" + "order_by=" <> renderOrderBy field "desc" Fields fields -> - renderFields fields + "fields=" <> renderFields fields AndFilter filters -> - renderFilters "filters" filters + "filters=" <> renderFilters filters OrFilter filters -> - renderFilters "or_filters" filters + "or_filters=" <> renderFilters filters -renderFields :: [Text] -> Text +renderFields :: [Fieldname] -> Text renderFields fields = - "fields=" <> urlEncode ("[" <> intercalate "," (map quote fields) <> "]") + urlEncode ("[" <> intercalate "," (map quote fields) <> "]") -renderOrderBy :: Text -> Text -> Text +renderOrderBy :: Fieldname -> Text -> Text renderOrderBy field order = - "order_by=" <> urlEncode (field <> " " <> order) + urlEncode (field <> " " <> order) -- | Render the query string for the URL. +-- +-- >>> renderQueryStringParams [] +-- "" +-- +-- >>> renderQueryStringParams [LimitStart 20, LimitPageLength 10] +-- "limit_start=20&limit=10" +-- +-- >>> urlDecode $ renderQueryStringParams [Fields [pack "id", pack "name"], Asc (pack "idx")] +-- "fields=[\"id\",\"name\"]&order_by=idx asc" +-- renderQueryStringParams :: [QueryStringParam] -> Text renderQueryStringParams params = intercalate "&" (map renderQueryStringParam params) diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main (main) where + +import ERPNext.Client.Helper +import ERPNext.Client.QueryStringParams +import Test.DocTest +import Data.Text +import Data.Text qualified as T +import Hedgehog.Gen qualified as Gen +import Hedgehog.Range qualified as Range +import Test.Hspec (describe, hspec, it, shouldBe) +import Test.Hspec.Hedgehog (forAll, hedgehog, (===)) + +main :: IO () +main = do + doctest ["src/"] + hspec $ do + describe "ERPNext.Client.QueryStringParams" $ do + describe "renderQueryStringParams" $ do + it "escapes quote and comma" $ do + renderQueryStringParams [Asc "\","] `shouldBe` "order_by=%22%2C%20asc" + it "escapes even brackets" $ do + renderQueryStringParams [Fields []] `shouldBe` "fields=%5B%5D" + describe "ERPNext.Client.Helper" $ do + describe "quote" $ do + it "is always surrounded by double quotes" $ hedgehog $ do + t <- forAll $ Gen.text (Range.linear 0 100) Gen.unicode + let quoted = quote t + ("\"" `isPrefixOf` quoted) === True + ("\"" `isSuffixOf` quoted) === True + it "never returns something with double quotes inside" $ do + quote "\"end" `shouldBe` "\"\\\"end\"" + quote "Mutter 2,5\"" `shouldBe` "\"Mutter 2,5\\\"\"" + describe "Internal helper functions" $ do + describe "removeFirstLastChar" $ do + it "seems to work" $ do + removeFirstLastChar "abcd" `shouldBe` "bc" + removeFirstLastChar "abc" `shouldBe` "b" + removeFirstLastChar "ab" `shouldBe` "" + removeFirstLastChar "a" `shouldBe` "" + removeFirstLastChar "" `shouldBe` "" + it "strips two characters" $ hedgehog $ do + t <- forAll $ Gen.text (Range.linear 2 100) Gen.unicode + let result = removeFirstLastChar t + T.length result === T.length t - 2 + +removeFirstLastChar :: Text -> Text +removeFirstLastChar = T.reverse . T.drop 1 . T.reverse . T.drop 1