content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  -- TODO: Split into ModuleNameSpec.hs files & Gen.hs file.
  import Control.Monad.Logger (runNoLoggingT)
  import Data.Aeson (Result(Success), FromJSON, fromJSON, ToJSON(..), eitherDecode)
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Lazy as LBS
  import Data.Int (Int64)
  import qualified Data.Map.Strict as M
  import Data.List.NonEmpty (NonEmpty(..))
  import Data.Ratio ((%))
  import qualified Data.Set as S
  import Data.Text (Text, pack)
  import Data.Text.Lazy (isInfixOf)
  import Data.Text.Encoding (decodeUtf8, encodeUtf8)
  import Data.Time
      ( UTCTime(..), LocalTime(..), TimeOfDay(..), Day(..), DiffTime
      , secondsToDiffTime, getCurrentTime, fromGregorian
      )
  import Database.Persist.Postgresql (createPostgresqlPool)
  import Database.Persist.Sql (Entity(..), ToBackendKey, SqlBackend, runSqlPool, toSqlKey)
  import Hedgehog
  import qualified Hedgehog.Gen as Gen
  import qualified Hedgehog.Range as Range
  import Test.Tasty
  import Test.Tasty.Hedgehog
  import Test.Tasty.HUnit hiding (assert)
  import TestContainers.Tasty
      ( MonadDocker, Pipe(Stderr), containerAddress, containerRequest, fromTag, run, setEnv, setExpose
      , setSuffixedName, setWaitingFor, waitForLogLine, withContainers, (&),
      )
  
  import Text.XML.Generator (Xml, Elem, doc, defaultDocInfo, xrender)
  import Web.FormUrlEncoded (FromForm(..), urlDecodeForm, fromEntriesByKey)
  
  import Avalara
  import Models
  import Models.Fields
  import Routes.Admin.ShippingMethods
  import Routes.CommonData
  import Routes.StoneEdge
  import StoneEdge
  
  import qualified StoneEdgeFixtures as SEF
  import qualified AvalaraFixtures as AF
  
  main :: IO ()
  main =
      defaultMain tests
  
  tests :: TestTree
  tests =
      testGroup "Tests"
           [ modelsFields
           , modelsUtils
           , commonData
           , stoneEdge
           , routesStoneEdge
           , avalara
           , routesAdminShipping
           , databaseMigrations
           ]
  
  
  modelsFields :: TestTree
  modelsFields =
      testGroup "Models.Fields Module"
          [ testProperty "LotSize Aeson Instances" $ testJSON genLotSize
          , testProperty "CouponType Aeson Instances" $ testJSON genCouponType
          , testProperty "Country Aeson Instances" $ testJSON genCountry
          , testProperty "SaleType Aeson Instances" $ testJSON genSaleType
          ]
  
  modelsUtils :: TestTree
  modelsUtils =
      testGroup "Models.Utils Module"
          [ truncateHtmlTests
          ]
  
  
  truncateHtmlTests :: TestTree
  truncateHtmlTests = testGroup "truncateHtml"
      [ testProperty "Empty Input Returns Empty Output" emptyInput
      , testCase "Input with Less Words than Count" shortInput
      , testCase "Input Exceeding Count" longInput
      , testCase "Inputs Exceeding Count Have Open Tags Closed" longInputClosesTags
      , testCase "Multiple Open Tags are Properly Closed" closesMultipleOpenTags
      , testCase "Inline Comments are Removed" inlineCommentsRemoved
      , testCase "Comments Don't Count Towards Truncation Status" commentsDontCountTowardsTruncation
      ]
    where
      emptyInput :: Property
      emptyInput = property $ do
          count <- forAll $ Gen.int $ Range.linear (-9999) 9999
          truncateHtml count "" === ("", False)
      shortInput :: Assertion
      shortInput =
          ("<p>a short description</p>", False) @=?
              truncateHtml 10 "<p>a short description</p>"
      longInput :: Assertion
      longInput =
          ("a long description", True) @=?
              truncateHtml 3 "a long description will be truncated"
      longInputClosesTags :: Assertion
      longInputClosesTags =
          ("<p>a long description</p>", True) @=?
              truncateHtml 3 "<p>a long description will have any open tags closed</p>"
      closesMultipleOpenTags :: Assertion
      closesMultipleOpenTags =
          ("<p>a long <b>description</b></p>", True) @=?
              truncateHtml 3 "<p>a long <b>description will have</b> any open tags closed</p>"
      inlineCommentsRemoved :: Assertion
      inlineCommentsRemoved =
          ("<p>an inline comment is removed</p>", True) @=?
              truncateHtml 5 "<p>an inline comment<!-- me! --> is removed from the text</p>"
      commentsDontCountTowardsTruncation :: Assertion
      commentsDontCountTowardsTruncation = do
          ("a short description", False) @=?
              truncateHtml 3 "a short description<!-- Comment is Removed -->"
          ("a short description here", True) @=?
              truncateHtml 4 "a short description<!-- Comment is Removed --> here but not this."
  
  
  
  commonData :: TestTree
  commonData =
      testGroup "CommonData Module"
          [ couponTests
          , priorityFeeTests
          , categorySaleTests
          , productSaleTests
          , cartInventoryNotificationTests
          ]
  
  
  
  -- COUPON
  couponTests :: TestTree
  couponTests = testGroup "Coupon Discount Calculations"
      [ testProperty "Free Shipping" freeShipping
      , testProperty "Free Shipping with no methods" freeShippingNoMethods
      , testProperty "Percentage Discount" percentageDiscount
      , testProperty "Flat Discount" flatDiscount
      ]
    where
      couponWithType :: CouponType -> Gen Coupon
      couponWithType couponType = do
          coupon <- genCoupon
          return $ coupon { couponDiscount = couponType }
      freeShipping :: Property
      freeShipping = property $ do
          coupon <- forAll $ couponWithType FreeShipping
          shippingCharge <- forAll genCartCharge
          calculateCouponDiscount coupon [shippingCharge] 0 === ccAmount shippingCharge
      freeShippingNoMethods :: Property
      freeShippingNoMethods = property $ do
          coupon <- forAll $ couponWithType FreeShipping
          calculateCouponDiscount coupon [] 0 === mkCents 0
      percentageDiscount :: Property
      percentageDiscount = property $ do
          coupon <- forAll genCoupon
          percent <- case couponDiscount coupon of
              PercentageDiscount wholePercent ->
                  return wholePercent
              _ ->
                  forAll genWholePercentage
          let coupon_ = coupon { couponDiscount = PercentageDiscount percent }
          subTotal <- fromCents <$> forAll genCents
          calculateCouponDiscount coupon_ [] subTotal
              === Cents (round (toRational subTotal * (fromIntegral percent % 100)))
      flatDiscount :: Property
      flatDiscount = property $ do
          coupon <- forAll genCoupon
          amount <- case couponDiscount coupon of
              FlatDiscount amt ->
                  return amt
              _ ->
                  (`plusCents` mkCents 1) <$> forAll genCents
          let coupon_ = coupon { couponDiscount = FlatDiscount amount }
          subTotal <- forAll genCents
          let result = calculateCouponDiscount coupon_ [] (fromCents subTotal)
          if amount > subTotal then result === subTotal else result === amount
  
  
  -- PRIORITY S&H
  priorityFeeTests :: TestTree
  priorityFeeTests = testGroup "Priority S&H Calculations"
      [ testCase "No Shipping Methods" noMethods
      , testProperty "Priority S&H Not Available" noPriorityAvailable
      , testProperty "Priority S&H Disabled" priorityDisabled
      , testProperty "Fee Correctly Calculated" calculatedCorrectly
      , testCase "Only Flat Rate Calculation" onlyFlat
      , testCase "Only Percentage Rate Calculation" onlyPercent
      ]
    where
      noMethods :: Assertion
      noMethods =
          calculatePriorityFee [] 9001 @?= Nothing
      noPriorityAvailable :: Property
      noPriorityAvailable = property $ do
          method <- forAll genCartCharge
          (Cents subTotal) <- forAll genCents
          calculatePriorityFee [ShippingCharge method Nothing True] subTotal === Nothing
      priorityDisabled :: Property
      priorityDisabled = property $ do
          (method, pr, Cents subTotal) <- forAll $
              (,,) <$> genCartCharge <*> genPriorityFee <*> genCents
          calculatePriorityFee [ShippingCharge method (Just pr) False] subTotal
              === Nothing
      calculatedCorrectly :: Property
      calculatedCorrectly = property $ do
          method <- forAll genCartCharge
          pr@(PriorityShippingFee (Cents flat) percent) <- forAll genPriorityFee
          (Cents subTotal) <- forAll genCents
          let percentAmount = toRational subTotal * (fromIntegral percent % 100)
          calculatePriorityFee [ShippingCharge method (Just pr) True] subTotal
              === Just (Cents $ round $ percentAmount + toRational flat)
      onlyFlat :: Assertion
      onlyFlat =
          calculatePriorityFee [makeShippingCharge (PriorityShippingFee (mkCents 200) 0)] 1000
              @?= Just (mkCents 200)
      onlyPercent :: Assertion
      onlyPercent =
          calculatePriorityFee [makeShippingCharge (PriorityShippingFee (mkCents 0) 10)] 1000
              @?= Just (mkCents 100)
      makeShippingCharge :: PriorityShippingFee -> ShippingCharge
      makeShippingCharge fee = ShippingCharge (CartCharge "" $ mkCents 900) (Just fee) True
  
  
  -- SALES
  categorySaleTests :: TestTree
  categorySaleTests = testGroup "Category Sale Calculations"
      [ testProperty "Flat Amount Is Subtracted From Price" testFlatLessThanPrice
      , testProperty "Flat Amount >= Price Makes Product Free" testFlatGreaterThanPrice
      , testProperty "Percentage Sale Calculations" testPercentageProperty
      , testCase "Percentage Sale Calculation" testPercentageUnit
      , testProperty "Overrides An Existing Sale Price If Cheaper" testOverridesSalePrice
      , testProperty "Doesn't Override An Existing Sale Price If More Expensive" testNoOverridesSalePrice
      ]
    where
      testFlatLessThanPrice :: Property
      testFlatLessThanPrice = property $ do
          variantEntity <- forAll $ genEntity genProductVariant
          let variantData = makeVariantData variantEntity Nothing
          saleAmount <- forAll $ genCentRange $ Range.linear 1 (fromCents (getVariantPrice variantData) - 1)
          sale <- forAll $ genCategorySale $ FlatSale saleAmount
          categorySalePrice (getVariantPrice variantData) sale
              === getVariantPrice variantData `subtractCents` saleAmount
      testFlatGreaterThanPrice :: Property
      testFlatGreaterThanPrice = property $ do
          variantEntity <- forAll $ genEntity genProductVariant
          let variantData = makeVariantData variantEntity Nothing
              price = fromCents $ getVariantPrice variantData
          saleAmount <- forAll $ genCentRange $ Range.linear price (price * 10)
          sale <- forAll $ genCategorySale $ FlatSale saleAmount
          categorySalePrice (getVariantPrice variantData) sale === mkCents 0
      testPercentageProperty :: Property
      testPercentageProperty = property $ do
          variantEntity <- forAll $ genEntity genProductVariant
          let variantData = makeVariantData variantEntity Nothing
          salePercent <- forAll genWholePercentage
          sale <- forAll $ genCategorySale $ PercentSale salePercent
          let discountPercent = 1 - (fromIntegral salePercent % 100)
          categorySalePrice (getVariantPrice variantData) sale ===
              Cents (round $ toRational (fromCents $ getVariantPrice variantData) * discountPercent)
      testPercentageUnit :: Assertion
      testPercentageUnit = do
          time <- getCurrentTime
          let variantData = makeVariantData (makeVariant $ mkCents 1000) Nothing
              sale = CategorySale "" (PercentSale 13) time time []
          categorySalePrice (getVariantPrice variantData) sale @?= mkCents 870
      testOverridesSalePrice :: Property
      testOverridesSalePrice = property $ do
          (variantEntity, price) <- forAll
              $ makeVariantWithPrice $ Range.linear 2000 5000
          let variantData = makeVariantData variantEntity (Just $ price `subtractCents` mkCents 1500)
          saleAmount <- forAll $ genCentRange $ Range.linear 1501 $ fromCents price
          sale <- forAll $ genCategorySale $ FlatSale saleAmount
          getVariantPrice (applyCategorySale sale variantData) === price `subtractCents` saleAmount
      testNoOverridesSalePrice :: Property
      testNoOverridesSalePrice = property $ do
          (variantEntity, price) <- forAll
              $ makeVariantWithPrice $ Range.linear 2000 5000
          let variantData = makeVariantData variantEntity (Just $ mkCents 200)
          sale <- forAll $ do
              let price_ = fromCents price
              amount <- genCentRange $ Range.linear 0 (price_ - 199)
              genCategorySale $ FlatSale amount
          getVariantPrice (applyCategorySale sale variantData) === mkCents 200
      makeVariant :: Cents -> Entity ProductVariant
      makeVariant price =
          Entity (toSqlKey 1)
              $ ProductVariant (toSqlKey 1) "" price 1 (Just . Mass $ Milligrams 1) True Unlimited
      makeVariantWithPrice :: Range Int64 -> Gen (Entity ProductVariant, Cents)
      makeVariantWithPrice priceRange = do
          entity <- genProductVariant
          key <- genEntityKey
          price <- genCentRange priceRange
          let entityWithPrice = entity { productVariantPrice = price }
          return (Entity key entityWithPrice, price)
  
  productSaleTests :: TestTree
  productSaleTests = testGroup "Product Sale Calculations"
      [ testProperty "Sale Price Set If Less Than Price" testSalePrice
      , testProperty "Sale Price Not Set If Greater Than or Equal to Price" testNoSalePrice
      ]
    where
      testSalePrice :: Property
      testSalePrice = property $ do
          variant <- forAll $ genEntity genProductVariant
          let normalPrice = productVariantPrice $ entityVal variant
          salePrice <- forAll $ genCentRange $ Range.linear 0 (fromCents normalPrice - 1)
          getVariantPrice (makeVariantData variant $ Just salePrice) === salePrice
      testNoSalePrice :: Property
      testNoSalePrice = property $ do
          variant <- forAll $ genEntity genProductVariant
          let normalPrice = fromCents $ productVariantPrice $ entityVal variant
          salePrice <- forAll $ genCentRange $ Range.linear (normalPrice + 1) (normalPrice * 10)
          getVariantPrice (makeVariantData variant $ Just salePrice)
              === Cents normalPrice
  
  cartInventoryNotificationTests :: TestTree
  cartInventoryNotificationTests = testGroup "Cart Inventory Notifications"
      [ testCase "No new notifications" noNewNotifications
      , testCase "Some notifications resolved" someNotificationsResolved
      , testCase "New notifications" newNotifications
      ]
      where
          cartInventoryNotifications = CartInventoryNotifications
              { cinWarnings = M.fromList [(1, S.fromList [LimitedAvailabilityWarning 5, GenericWarning "warning"])]
              , cinErrors = M.fromList [(2, S.fromList [GenericError "error", OutOfStockError 3 10])]
              }
          noNewNotifications :: Assertion
          noNewNotifications =
              getUnseenCartInventoryNotifications cartInventoryNotifications cartInventoryNotifications @?=
                  CartInventoryNotifications M.empty M.empty
          someNotificationsResolved :: Assertion
          someNotificationsResolved = do
              let notifications = CartInventoryNotifications
                      { cinWarnings = M.fromList [(1, S.fromList [LimitedAvailabilityWarning 5])]
                      , cinErrors = M.fromList [(2, S.fromList [GenericError "error"])]
                      }
              getUnseenCartInventoryNotifications cartInventoryNotifications notifications @?=
                  CartInventoryNotifications M.empty M.empty
          newNotifications :: Assertion
          newNotifications = do
              let notifications = CartInventoryNotifications
                      { cinWarnings = M.fromList [(1, S.fromList [LimitedAvailabilityWarning 5, GenericWarning "warning"]), (3, S.fromList [GenericWarning "new warning"])]
                      , cinErrors = M.fromList [(4, S.fromList [OutOfStockError 2 5])]
                      }
              getUnseenCartInventoryNotifications cartInventoryNotifications notifications @?=
                  CartInventoryNotifications (M.fromList [(3, S.fromList [GenericWarning "new warning"])])
                                             (M.fromList [(4, S.fromList [OutOfStockError 2 5])])
  
  
  -- STONE EDGE
  stoneEdge :: TestTree
  stoneEdge = testGroup "StoneEdge Module"
      [ errorTests
      , lastDateParsing
      , sendVersionTests
      , orderCountTests
      , downloadOrdersTests
      , qohReplaceTests
      , getProductsCountTests
      , downloadProdsTests
      , invUpdateTests
      , getCustomersCountTests
      , downloadCustomersTests
      ]
    where
      errorTests :: TestTree
      errorTests = testGroup "SETI Errors"
          [ testCase "Simple Error Rendering" simpleErrorRendering
          , testCase "XML Error Rendering" xmlErrorRendering
          ]
      simpleErrorRendering :: Assertion
      simpleErrorRendering =
          renderSimpleSETIError "test error message"
              @?= "SETIError: test error message"
      xmlErrorRendering :: Assertion
      xmlErrorRendering =
          renderXmlSETIError Orders "test error message"
              @?= SEF.ordersErrorXml
      lastDateParsing :: TestTree
      lastDateParsing = testGroup "LastDate - Form Parsing "
          [ testCase "NoDate" lastDateAllParsing
          , testCase "LastDate Day" lastDateDayParsing
          ]
      lastDateAllParsing :: Assertion
      lastDateAllParsing =
          testFormParsing "lastdate=All" NoDate
      lastDateDayParsing :: Assertion
      lastDateDayParsing =
          testFormParsing "lastdate=2-dec-2019" $ LastDate (fromGregorian 2019 12 2)
      sendVersionTests :: TestTree
      sendVersionTests = testGroup "SendVersion SETI Function"
          [ testCase "Form Parsing" sendVersionParsing
          , testCase "Response Rendering" sendVersionResponse
          ]
      sendVersionParsing :: Assertion
      sendVersionParsing =
          testFormParsing "setifunction=sendversion&omversion=6.000"
              $ SendVersionRequest "6.000"
      sendVersionResponse :: Assertion
      sendVersionResponse =
          renderSendVersionResponse (SendVersionResponse "5.900")
              @?= "SETIResponse: version=5.900"
      orderCountTests :: TestTree
      orderCountTests = testGroup "OrderCount SETI Function"
          [ testCase "Form Parsing" orderCountParsing
          , testCase "Response Rendering" orderCountResponse
          ]
      orderCountParsing :: Assertion
      orderCountParsing =
          testFormParsing "setifunction=ordercount&setiuser=auser&password=pwd&code=mystore&lastorder=1001&lastdate=10-Jun-2003&omversion=5.000"
              $ OrderCountRequest "auser" "pwd" "mystore" (LastOrderNumber 1001)
                  (LastDate $ fromGregorian 2003 6 10)
                  "5.000"
      orderCountResponse :: Assertion
      orderCountResponse =
          renderOrderCountResponse (OrderCountResponse 42)
              @?= "SETIResponse: ordercount=42"
      downloadOrdersTests :: TestTree
      downloadOrdersTests = testGroup "DownloadOrders SETI Function"
          [ testCase "Form Parsing" downloadOrdersParsing
          , testCase "Form Parsing - No Decryption Key" downloadOrdersParsingNoKey
          , testCase "Response Rendering - No Orders" noOrdersResponse
          , testCase "Response Rendering - With Order" downloadOrdersResponse
          , testCase "Response Rendering - Billing XML" orderBillingResponse
          , testCase "Response Rendering - Shipping XML" orderShippingResponse
          , testCase "Response Rendering - CreditCard XML" paymentCreditCardResponse
          , testCase "Response Rendering - StoreCredit XML" paymentStoreCreditResponse
          , testCase "Response Rendering - Totals XML" orderTotalsResponse
          , testCase "Response Rendering - Coupon XML" orderCouponResponse
          , testCase "Response Rendering - OtherData XML" otherDataResponse
          ]
      downloadOrdersParsing :: Assertion
      downloadOrdersParsing =
          testFormParsing "setifunction=downloadorders&setiuser=auser&password=pwd&code=mystore&lastorder=1001&lastdate=10-Jun-2003&startnum=1&batchsize=100&dkey=decryptionkey&omversion=5.000"
              $ DownloadOrdersRequest "auser" "pwd" "mystore" (LastOrderNumber 1001)
                  (LastDate $ fromGregorian 2003 6 10) (Just 1) (Just 100)
                  (Just "decryptionkey") "5.000"
      downloadOrdersParsingNoKey :: Assertion
      downloadOrdersParsingNoKey =
          testFormParsing "setifunction=downloadorders&setiuser=auser&password=pwd&code=mystore&lastorder=1001&lastdate=10-Jun-2003&startnum=1&batchsize=100&omversion=5.000"
              $ DownloadOrdersRequest "auser" "pwd" "mystore" (LastOrderNumber 1001)
                  (LastDate $ fromGregorian 2003 6 10) (Just 1) (Just 100) Nothing
                  "5.000"
      noOrdersResponse :: Assertion
      noOrdersResponse =
          renderDownloadOrdersResponse NoOrdersToDownload @?=
              SEF.noOrdersXml
      downloadOrdersResponse :: Assertion
      downloadOrdersResponse =
          SEF.downloadOrdersXml @=?
              renderDownloadOrdersResponse (DownloadOrdersResponse
                  [ StoneEdgeOrder
                      9001
                      (LocalTime (fromGregorian 2003 6 10) $ TimeOfDay 0 0 0)
                      (Just "Payment Received")
                      orderBilling
                      orderShipping
                      [orderCreditCard, orderStoreCredit]
                      orderTotals
                      [orderCoupon]
                      orderOtherData
                  ]
              )
      orderBillingResponse :: Assertion
      orderBillingResponse =
          testXmlPart SEF.orderBillingXml
              $ renderStoneEdgeOrderBilling orderBilling
      orderBilling :: StoneEdgeOrderBilling
      orderBilling =
          StoneEdgeOrderBilling
              "Kevin Smith"
              (Just "Stone Edge Technologies  Inc.")
              (Just "215-641-1837")
              (Just "kevin@stoneedge.com")
              (StoneEdgeOrderAddress
                  "One Valley Square"
                  (Just "Suite 130")
                  "Blue Bell"
                  "PA"
                  "19422"
                  (Just "US")
              )
      orderShippingResponse :: Assertion
      orderShippingResponse =
          testXmlPart SEF.orderShippingXml
              $ renderStoneEdgeOrderShipping orderShipping
      orderShipping :: StoneEdgeOrderShipping
      orderShipping =
          StoneEdgeOrderShipping
              "Kevin Smith"
              (Just "Stone Edge Technologies  Inc.")
              (Just "215-641-1837")
              (Just "kevin@stoneedge.com")
              (StoneEdgeOrderAddress
                  "One Valley Square"
                  (Just "Suite 130")
                  "Blue Bell"
                  "PA"
                  "19422"
                  (Just "US")
              )
              [ StoneEdgeOrderProduct
                  "SHRT"
                  "MyShirt"
                  1
                  (StoneEdgeCents 500)
                  (Just TangibleProduct)
                  (Just True)
                  (Just 125487)
                  (Just $ StoneEdgeCents 500)
  
              ]
      paymentCreditCardResponse :: Assertion
      paymentCreditCardResponse =
          testXmlPart SEF.paymentCreditCardXml
              $ renderStoneEdgeOrderPayment orderCreditCard
      orderCreditCard :: StoneEdgeOrderPayment
      orderCreditCard =
          StoneEdgeOrderCreditCard $ StoneEdgePaymentCreditCard
              "Visa"
              (Just "9001")
              (Just "4729238728739452876")
              (Just $ StoneEdgeCents 9001)
      paymentStoreCreditResponse :: Assertion
      paymentStoreCreditResponse =
          testXmlPart SEF.paymentStoreCreditXml
              $ renderStoneEdgeOrderPayment orderStoreCredit
      orderStoreCredit :: StoneEdgeOrderPayment
      orderStoreCredit = StoneEdgeOrderStoreCredit
              $ StoneEdgePaymentStoreCredit
                  (StoneEdgeCents 9001)
                  (Just "Store Credit Description!")
      orderTotalsResponse :: Assertion
      orderTotalsResponse =
          testXmlPart SEF.orderTotalsXml
              $ renderStoneEdgeTotals orderTotals
      orderTotals :: StoneEdgeTotals
      orderTotals =
          StoneEdgeTotals
              (StoneEdgeCents 2500)
              [ StoneEdgeDiscount
                  (Just SEFlatDiscount)
                  (Just "5 Dollars Off")
                  Nothing
                  (StoneEdgeCents 500)
                  (Just True)
              ]
              (StoneEdgeCents 2000)
              (Just $ StoneEdgeTax
                  (StoneEdgeCents 268)
                  (Just 0.05)
                  (Just False)
                  Nothing
                  Nothing
              )
              (StoneEdgeCents 6443)
              [ StoneEdgeSurcharge
                  (StoneEdgeCents 400)
                  (Just "Fall Item Surcharge")
              ]
              (Just $ StoneEdgeShippingTotal
                  (StoneEdgeCents 825)
                  (Just "Ground")
              )
      orderCouponResponse :: Assertion
      orderCouponResponse =
          testXmlPart SEF.orderCouponXml
              $ renderStoneEdgeCoupon orderCoupon
      orderCoupon :: StoneEdgeCoupon
      orderCoupon =
          StoneEdgeCoupon
              "ABCCOUPON123"
              (Just "5% Off to HHF Customers")
              (StoneEdgeCents 420)
              (Just True)
      otherDataResponse :: Assertion
      otherDataResponse =
          testXmlPart SEF.orderOtherDataXml
              $ renderStoneEdgeOtherData orderOtherData
      orderOtherData :: StoneEdgeOtherData
      orderOtherData =
          StoneEdgeOtherData
              (Just "Priority Shipping")
              (Just "Long, Multiline\nCustomer Comments")
              (Just 9001)
      -- | Render an XML element & ensure it matches the expected output.
      testXmlPart :: BS.ByteString -> Xml Elem -> Assertion
      testXmlPart expected element =
          "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>\n" <> expected
              @=?  xrender (doc defaultDocInfo element)
  
      qohReplaceTests :: TestTree
      qohReplaceTests = testGroup "Replace QOH"
          -- SETI Documentation mentions there is no trailing '|' character, but in the real requests coming
          -- from the Stone Edge instance it is actually present, so we're supporting both cases.
          [ testCase "Form Parsing" qohReplaceParsing
          , testCase "Form Parsing - No Trailing |" qohReplaceNoTrailingBar
          , testCase "Response Rendering" qohReplaceResponse
          ]
      qohReplaceParsing :: Assertion
      qohReplaceParsing =
          testFormParsing "setifunction=qohreplace&setiuser=auser&password=pwd&code=mystore&count=2&update=sku1~2|sku2~5|&omversion=5.000"
              $ QOHReplaceRequest "auser" "pwd" "mystore" 2
                  (("sku1", 2) :| [("sku2", 5)]) "5.000"
  
      qohReplaceNoTrailingBar :: Assertion
      qohReplaceNoTrailingBar =
          testFormParsing "setifunction=qohreplace&setiuser=auser&password=pwd&code=mystore&count=3&update=sku1~2|sku2~5|sku3~10&omversion=5.000"
              $ QOHReplaceRequest "auser" "pwd" "mystore" 3
                  (("sku1", 2) :| [("sku2", 5), ("sku3", 10)]) "5.000"
  
      qohReplaceResponse :: Assertion
      qohReplaceResponse =
          renderQOHReplaceResponse (QOHReplaceResponse $ ("sku1", Ok) :| [("sku2", NotAvailable), ("sku3", NotFound)])
              @?= "SETIResponse\nsku1=OK\nsku2=NA\nsku3=NF\nSETIEndOfData"
  
      getProductsCountTests :: TestTree
      getProductsCountTests = testGroup "GetProductsCount SETI Function"
          [ testCase "Form Parsing" getProductsCountParsing
          , testCase "Response Rendering" getProductsCountResponse
          ]
      getProductsCountParsing :: Assertion
      getProductsCountParsing =
          testFormParsing "setifunction=getproductscount&setiuser=auser&password=pwd&code=mystore&omversion=5.000"
              $ GetProductsCountRequest "auser" "pwd" "mystore" "5.000"
      getProductsCountResponse :: Assertion
      getProductsCountResponse =
          renderGetProductsCountResponse (GetProductsCountResponse 123)
              @?= "SETIResponse: itemcount=123"
  
      downloadProdsTests :: TestTree
      downloadProdsTests = testGroup "DownloadProds SETI Function"
          [ testCase "Form Parsing" downloadProdsParsing
          , testCase "Response Rendering - With Products" downloadProdsResponse
          ]
      downloadProdsParsing :: Assertion
      downloadProdsParsing =
          testFormParsing "setifunction=downloadprods&setiuser=auser&password=pwd&code=mystore&startnum=1&batchsize=100&omversion=5.000"
              $ DownloadProdsRequest "auser" "pwd" "mystore" (Just 1) (Just 100) "5.000"
      downloadProdsResponse :: Assertion
      downloadProdsResponse =
          let prods =
                  [ StoneEdgeProduct
                      { sepCode = "1"
                      , sepName = "test"
                      , sepPrice = 0
                      , sepDescription = Just "test description"
                      , sepWeight = 10
                      , sepDiscontinued = False
                      , sepQOH = 10
                      , sepCustomFields =
                          [ ("Organic", "False")
                          , ("Heirloom", "False")
                          ]
                      }
                  , StoneEdgeProduct
                      { sepCode = "2"
                      , sepName = "Non-free"
                      , sepPrice = 5
                      , sepDescription = Nothing
                      , sepWeight = 0
                      , sepDiscontinued = False
                      , sepQOH = 20
                      , sepCustomFields =
                          [ ("Organic", "True")
                          , ("Heirloom", "True")
                          ]
                      }
                  , StoneEdgeProduct
                      { sepCode = "2A"
                      , sepName = "Non-free"
                      , sepPrice = 6
                      , sepDescription = Nothing
                      , sepWeight = 0
                      , sepDiscontinued = False
                      , sepQOH = 30
                      , sepCustomFields =
                          [ ("Organic", "True")
                          , ("Heirloom", "True")
                          ]
                      }
                  , StoneEdgeProduct
                      { sepCode = "2B"
                      , sepName = "Non-free"
                      , sepPrice = 7
                      , sepDescription = Nothing
                      , sepWeight = 0
                      , sepDiscontinued = True
                      , sepQOH = 0
                      , sepCustomFields =
                          [ ("Organic", "True")
                          , ("Heirloom", "True")
                          ]
                      }
                  , StoneEdgeProduct
                      { sepCode = "3"
                      , sepName = "Another product"
                      , sepPrice = 10
                      , sepDescription = Nothing
                      , sepWeight = 0
                      , sepDiscontinued = False
                      , sepQOH = 40
                      , sepCustomFields =
                          [ ("Organic", "True")
                          , ("Heirloom", "False")
                          ]
                      }
                  ]
          in SEF.downloadProdsXml @=? renderDownloadProdsResponse (DownloadProdsResponse prods)
  
      invUpdateTests :: TestTree
      invUpdateTests = testGroup "InvUpdate SETI Function"
          [ testCase "Form Parsing" invUpdateParsing
          , testCase "Response Rendering - OK" invUpdateResponseOk
          , testCase "Response Rendering - NotFound" invUpdateResponseNotFound
          , testCase "Response Rendering - NotTracking" invUpdateResponseNotTracking
          ]
  
      invUpdateParsing :: Assertion
      invUpdateParsing =
          testFormParsing "setifunction=invupdate&setiuser=auser&password=pwd&code=mystore&update=sku1~5&omversion=5.000"
              $ InvUpdateRequest "auser" "pwd" "mystore" ("sku1", 5) "5.000"
  
      invUpdateResponseOk :: Assertion
      invUpdateResponseOk =
          renderInvUpdateResponse (InvUpdateResponse True "sku1" (Left 50) Nothing)
              @?= "SETIResponse=OK;SKU=sku1;QOH=50;NOTE="
  
      invUpdateResponseNotFound :: Assertion
      invUpdateResponseNotFound =
          renderInvUpdateResponse (InvUpdateResponse False "sku1" (Right NotFound) (Just "NotFound"))
              @?= "SETIResponse=False;SKU=sku1;QOH=NF;NOTE=NotFound"
  
      invUpdateResponseNotTracking :: Assertion
      invUpdateResponseNotTracking =
          renderInvUpdateResponse (InvUpdateResponse False "sku1" (Right NotAvailable) (Just "NotTracking"))
              @?= "SETIResponse=False;SKU=sku1;QOH=NA;NOTE=NotTracking"
  
      getCustomersCountTests :: TestTree
      getCustomersCountTests = testGroup "GetCustomersCount SETI Function"
          [ testCase "Form Parsing" getCustomersCountParsing
          , testCase "Response Rendering" getCustomersCountResponse
          ]
  
      getCustomersCountParsing :: Assertion
      getCustomersCountParsing =
          testFormParsing "setifunction=getcustomerscount&setiuser=auser&password=pwd&code=mystore&omversion=5.000"
              $ GetCustomersCountRequest "auser" "pwd" "mystore" "5.000"
  
      getCustomersCountResponse :: Assertion
      getCustomersCountResponse =
          renderGetCustomersCountResponse (GetCustomersCountResponse 123)
              @?= "SETIResponse: itemcount=123"
  
      downloadCustomersTests :: TestTree
      downloadCustomersTests = testGroup "DownloadCustomers SETI Function"
          [ testCase "Form Parsing" downloadCustomersParsing
          , testCase "Response Rendering - With Customers" downloadCustomersResponse
          ]
  
      downloadCustomersParsing :: Assertion
      downloadCustomersParsing =
          testFormParsing "setifunction=downloadcustomers&setiuser=auser&password=pwd&code=mystore&startnum=1&batchsize=100&omversion=5.000"
              $ DownloadCustomersRequest "auser" "pwd" "mystore" (Just 1) (Just 100) "5.000"
  
      downloadCustomersResponse :: Assertion
      downloadCustomersResponse =
          let addr = StoneEdgeCustomerAddress
                  { secaAddr1 = "One Valley Square"
                  , secaAddr2 = Just "Suite 130"
                  , secaCity = "Blue Bell"
                  , secaState = "PA"
                  , secaZip = "19422"
                  , secaCountry = "US"
                  }
              customers =
                  [ StoneEdgeCustomer
                      { secWebID = Just 12548
                      , secUserName = Just "kevin"
                      , secuPassword = Just "xyz123"
                      , secAffiliateId = Nothing
                      , secBillAddr = StoneEdgeCustomerBillingAddress
                          { secbaNamePrefix = Just "Mr."
                          , secbaFirstName = "John"
                          , secbaMiddleName = Nothing
                          , secbaLastName = "Doe"
                          , secbaNameSuffix = Nothing
                          , secbaCompany = Just "Stone Edge"
                          , secbaPhone = Just "215-641-1837"
                          , secbaEmail = Just "john@stoneedge.com"
                          , secbaTaxId = Just "123456789"
                          , secbaAddress = addr
                          }
                      , secShipAddr = StoneEdgeCustomerShippingAddress
                          { secsaNamePrefix = Just "Mr."
                          , secsaFirstName = "John"
                          , secsaMiddleName = Nothing
                          , secsaLastName = "Doe"
                          , secsaNameSuffix = Nothing
                          , secsaCompany = Just "Stone Edge"
                          , secsaPhone = Just "215-641-1837"
                          , secsaEmail = Just "jdoe@stoneedge.com"
                          , secsaAddress = addr
                          }
                      , secCustomFields = [("Nickname", "jdoe")]
                      }
                  ]
          in SEF.downloadCustomersXml @=? renderDownloadCustomersResponse (DownloadCustomersResponse customers)
  
  routesStoneEdge :: TestTree
  routesStoneEdge = testGroup "Routes.StoneEdge Module"
      [ testCase "Unsupported setifunction Parameter" unsupportedFunction
      , testCase "Missing setifunction Parameter" noFunction
      , testCase "Incomplete downloadorders Form" parseErrorXml
      , orderTransformTests
      ]
    where
      unsupportedFunction :: Assertion
      unsupportedFunction =
          let expectedForm = fromEntriesByKey @Text @Text
                  [("setifunction", ["nanjidesuka"]), ("setiuser", ["auser"])]
          in  testFormParsing "setifunction=nanjidesuka&setiuser=auser"
                  $ UnexpectedFunction "nanjidesuka" expectedForm
      noFunction :: Assertion
      noFunction =
          let expectedForm = fromEntriesByKey @Text @Text
                  [("setiuser", ["auser"]), ("password", ["pwd"])]
          in  testFormParsing "setiuser=auser&password=pwd"
                  $ InvalidRequest expectedForm
      parseErrorXml :: Assertion
      parseErrorXml =
          (urlDecodeForm "setifunction=downloadorders" >>= fromForm @StoneEdgeRequest)
              @?= Left (decodeUtf8 SEF.ordersParseErrorXml)
      orderTransformTests :: TestTree
      orderTransformTests = testGroup "Order Transformation"
          [ testCase "Coupon" couponTransform
          , testCase "Coupon to Nothing" couponTransformNothing
          , testCase "Store Credit" storeCreditTransform
          , testCase "Store Credit to Nothing" storeCreditTransformNothing
          , testCase "Tax" taxTransform
          , testCase "Tax with Rate" taxTransformRate
          , testCase "Discount" discountTransform
          , testCase "Surcharge" surchargeTransform
          , testCase "Shipping Total" shippingTotalTransform
          ]
      couponTransform :: Assertion
      couponTransform =
          let c = Entity nullSqlKey $ Coupon "CC" "Coup" "" True (FlatDiscount $ mkCents 300) (mkCents 0) fillerTime 0 0 fillerTime
              li = Entity nullSqlKey $ OrderLineItem nullSqlKey CouponDiscountLine "Coup Discount" (mkCents 300)
              sc = StoneEdgeCoupon  "Coup" Nothing (StoneEdgeCents 300) (Just True)
          in Just sc @=? transformCoupon c li
      storeCreditTransform :: Assertion
      storeCreditTransform =
          let li = Entity nullSqlKey $ OrderLineItem nullSqlKey StoreCreditLine "Store Credit" (mkCents 500)
              sc = StoneEdgeOrderStoreCredit $ StoneEdgePaymentStoreCredit
                      (StoneEdgeCents 500) (Just "Store Credit")
          in Just sc @=? transformStoreCredit li
      couponTransformNothing :: Assertion
      couponTransformNothing =
          let c = Entity nullSqlKey $ Coupon "CC" "Coup" "" True (FlatDiscount $ mkCents 300) (mkCents 0) fillerTime 0 0 fillerTime
              li = Entity nullSqlKey $ OrderLineItem nullSqlKey PriorityShippingLine "Not a coupon" (mkCents 900)
          in Nothing @=? transformCoupon c li
      storeCreditTransformNothing :: Assertion
      storeCreditTransformNothing =
          let li = Entity nullSqlKey $ OrderLineItem nullSqlKey PriorityShippingLine "Not store credit" (mkCents 900)
          in Nothing @=? transformStoreCredit li
      taxTransform :: Assertion
      taxTransform =
          let st = StoneEdgeTax (StoneEdgeCents 9001) Nothing (Just True) (Just False) Nothing
          in st @=? transformTax (makeTaxLine "Tax Description" (Cents 9001))
      taxTransformRate :: Assertion
      taxTransformRate =
          let st = StoneEdgeTax (StoneEdgeCents 9001) (Just 0.053) (Just True) (Just False) Nothing
          in st @=? transformTax (makeTaxLine "VA Tax (5.3%)" (Cents 9001))
      discountTransform :: Assertion
      discountTransform =
          let dc = StoneEdgeDiscount (Just SEFlatDiscount) (Just "description")
                      Nothing (StoneEdgeCents 9001) (Just True)
              ol = Entity nullSqlKey $ OrderLineItem nullSqlKey MemberDiscountLine "description" (Cents 9001)
          in dc @=? transformDiscount ol
      surchargeTransform :: Assertion
      surchargeTransform =
          let ss = StoneEdgeSurcharge (StoneEdgeCents 200) (Just "Fee")
              ol = Entity nullSqlKey $ OrderLineItem nullSqlKey SurchargeLine "Fee" (Cents 200)
          in ss @=? transformSurcharge ol
      shippingTotalTransform :: Assertion
      shippingTotalTransform =
          let st = StoneEdgeShippingTotal (StoneEdgeCents 200) (Just "Shipping")
              ol = Entity nullSqlKey $ OrderLineItem nullSqlKey ShippingLine "Shipping" (Cents 200)
          in st @=? transformShippingTotal ol
      makeTaxLine :: Text -> Cents -> OrderLineItem
      makeTaxLine =
          OrderLineItem nullSqlKey TaxLine
      fillerTime :: UTCTime
      fillerTime =
          UTCTime
              (ModifiedJulianDay 1000)
              (secondsToDiffTime 0)
      nullSqlKey :: ToBackendKey SqlBackend a => Key a
      nullSqlKey = toSqlKey 0
  
  
  -- AVALARA
  avalara :: TestTree
  avalara = testGroup "Avalara Module"
      [ errorTests
      , pingTests
      , typeTests
      ]
    where
      errorTests :: TestTree
      errorTests = testGroup "Errors"
          [ testCase "ErrorInfo Parsing" errorInfoParsing
          , testCase "WithError Parsing - ErrorResponse" withErrorParsing
          , testCase "WithError Parsing - SuccessfulResponse" withErrorParsingSuccess
          ]
      errorInfoParsing :: Assertion
      errorInfoParsing =
          testJsonParsing AF.errorInfoJson errorInfoFixture
      withErrorParsing :: Assertion
      withErrorParsing =
          testJsonParsing AF.errorInfoJson errorInfoFixture
      withErrorParsingSuccess :: Assertion
      withErrorParsingSuccess =
          testJsonParsing AF.unauthenticatedPingResponse unauthorizedPingFixture
      errorInfoFixture :: ErrorInfo
      errorInfoFixture =
          ErrorInfo
              { eiCode = "AuthenticationIncomplete"
              , eiMessage = "Authentication Incomplete."
              , eiTarget = "HttpRequestHeaders"
              , eiDetails =
                  [ ErrorDetail
                      { edCode = "AuthenticationIncomplete"
                      , edNumber = 34
                      , edMessage = "Authentication Incomplete."
                      , edDescription = "You must provide an Authorization header of the type Basic or Bearer to authenticate correctly."
                      , edFaultCode = "Client"
                      , edHelpLink = "/avatax/errors/AuthenticationIncomplete"
                      , edSeverity = "Exception"
                      }
                  ]
              }
      pingTests :: TestTree
      pingTests = testGroup "Ping"
          [ testCase "Response Parsing - Unauthorized" unauthorizedPing
          , testCase "Response Parsing - Authorized" authorizedPing
          ]
      unauthorizedPing :: Assertion
      unauthorizedPing =
          testJsonParsing AF.unauthenticatedPingResponse unauthorizedPingFixture
      unauthorizedPingFixture :: PingResponse
      unauthorizedPingFixture =
          PingResponse
              { prVersion = "19.11.0"
              , prAuthenticated = False
              , prAuthenticationType = NoAuthentication
              , prUserName = Nothing
              , prUserId = Nothing
              , prAccountId = Nothing
              , prCrmId = Nothing
              }
      authorizedPing :: Assertion
      authorizedPing =
          testJsonParsing AF.authenticatedPingResponse $
              PingResponse
                  { prVersion = "1.0.0.0"
                  , prAuthenticated = True
                  , prAuthenticationType = UsernamePassword
                  , prUserName = Just "TestUser"
                  , prUserId = Just 98765
                  , prAccountId = Just 123456789
                  , prCrmId = Just "1111"
                  }
      typeTests :: TestTree
      typeTests =
          testGroup "Types"
              [ testProperty "RefundType Aeson Instances"
                  $ testJSON (Gen.enumBounded @Gen @RefundType)
              , testProperty "TransactionStatus Aeson Instances"
                  $ testJSON (Gen.enumBounded @Gen @TransactionStatus)
              , testProperty "Transaction Aeson Instances"
                  $ testJSON genTransaction
              ]
  
  
  -- ROUTES.ADMIN.SHIPPINGMETHODS
  routesAdminShipping :: TestTree
  routesAdminShipping = testGroup "Routes.Admin.ShippingMethods Module"
      [ aesonTests
      ]
    where
      aesonTests :: TestTree
      aesonTests = testGroup "Aeson Instances"
          [ testProperty "MethodData" $ testJSON genMethodData
          , testProperty "RateData" $ testJSON genRateData
          , testProperty "RateType" $ testJSON genRateType
          ]
      genRateType :: Gen RateType
      genRateType =
          Gen.choice [ return FlatRate, return PercentRate ]
      genRateData :: Gen RateData
      genRateData =
          RateData
              <$> genCents
              <*> Gen.integral (Range.linear 0 100)
              <*> genRateType
      genMethodData :: Gen MethodData
      genMethodData =
          MethodData
              <$> Gen.maybe genEntityKey
              <*> genText
              <*> Gen.list (Range.linear 1 10) genCountry
              <*> Gen.list (Range.linear 1 10) genRateData
              <*> genCents
              <*> Gen.integral (Range.linear 0 100)
              <*> Gen.bool
              <*> Gen.list (Range.linear 1 10) genEntityKey
              <*> Gen.list (Range.linear 1 10) genEntityKey
              <*> Gen.integral (Range.linear 1 1000)
              <*> Gen.bool
  
  -- Database migrations
  
  databaseMigrations :: TestTree
  databaseMigrations = withContainers setupPostgresContainer $ \connString ->
      testGroup "Database Migrations"
          [ testCase "Migration over empty DB is successful" (migrationOverEmptyDB connString)
          ]
      where
          migrationOverEmptyDB :: IO BS.ByteString -> Assertion
          migrationOverEmptyDB connString = do
              connStr <- connString
              conn <- runNoLoggingT $ createPostgresqlPool connStr 1
              runSqlPool runMigrations conn
  
  -- UTILITIES
  
  
  -- | Assert parsing of a FormUrlEncoded value decodes to the proper value.
  testFormParsing :: (FromForm a, Eq a, Show a) => LBS.ByteString -> a -> Assertion
  testFormParsing urlData expected =
      (urlDecodeForm urlData >>= fromForm) @?= Right expected
  
  -- | Assert parsing of a JSON vlaue decodes to the proper value.
  testJsonParsing :: (FromJSON a, Eq a, Show a) => LBS.ByteString -> a -> Assertion
  testJsonParsing json expected =
      eitherDecode json @?= Right expected
  
  -- | Test that the ToJSON & FromJSON instances are mirrors of each other.
  testJSON :: (FromJSON a, ToJSON a, Show a, Eq a) => Gen a -> Property
  testJSON gen = property $ do
      val <- forAll gen
      Success val === fromJSON (toJSON val)
  
  
  -- GENERATORS
  
  
  -- Generate an active coupon with minimum order size of 0 to $10.00
  genCoupon :: Gen Coupon
  genCoupon =
      Coupon
          <$> genText
          <*> genText
          <*> genText
          <*> pure True
          <*> genCouponType
          <*> genCentRange (Range.linear 0 1000)
          <*> genUTCTime
          <*> pure 0
          <*> pure 0
          <*> genUTCTime
  
  genCouponType :: Gen CouponType
  genCouponType =
      Gen.choice
          [ FlatDiscount <$> genCents
          , PercentageDiscount <$> genWholePercentage
          , pure FreeShipping
          ]
  
  -- Generate charges of $0.01 to $10.00
  genCartCharge :: Gen CartCharge
  genCartCharge =
      CartCharge
          <$> genText
          <*> genCentRange (Range.linear 1 1000)
  
  genPriorityFee :: Gen PriorityShippingFee
  genPriorityFee =
      PriorityShippingFee
          <$> genCentRange (Range.linear 1 1000)
          <*> genWholePercentage
  
  genProductVariant :: Gen ProductVariant
  genProductVariant =
      ProductVariant
          <$> fmap toSqlKey (Gen.integral $ Range.linear 1 100)
          <*> genText
          <*> genCentRange (Range.linear 1 999999)
          <*> Gen.integral (Range.linear 1 1000)
          <*> Gen.maybe genLotSize
          <*> Gen.bool
          <*> genInventoryPolicy
  
  genCategorySale :: SaleType -> Gen CategorySale
  genCategorySale saleType =
      CategorySale
          <$> genText
          <*> pure saleType
          <*> genUTCTime
          <*> genUTCTime
          <*> Gen.list (Range.linear 1 10) genEntityKey
  
  genTransaction :: Gen Transaction
  genTransaction =
      Transaction
          <$> Gen.maybe (Gen.integral $ Range.linear 1 1000)
          <*> Gen.maybe (TransactionCode <$> genText)
          <*> Gen.maybe (fmap CompanyId . Gen.integral $ Range.linear 1 1000)
          <*> Gen.maybe genDay
          <*> Gen.maybe Gen.enumBounded
          <*> Gen.maybe Gen.enumBounded
          <*> Gen.maybe (CustomerCode <$> genText)
          <*> Gen.maybe Gen.bool
          <*> Gen.maybe (return 3.14)
          <*> Gen.maybe (return 4.20)
          <*> Gen.maybe (return 9000.01)
          <*> Gen.maybe (return 2.71)
          <*> Gen.maybe (return 6.66)
          <*> Gen.maybe Gen.bool
          <*> Gen.maybe genText
          <*> Gen.maybe genText
  
  
  genEntity :: (ToBackendKey SqlBackend a) => Gen a -> Gen (Entity a)
  genEntity genModel =
      Entity <$> genEntityKey <*> genModel
  
  
  genEntityKey :: (ToBackendKey SqlBackend a) => Gen (Key a)
  genEntityKey =
      toSqlKey <$> Gen.int64 (Range.linear 1 1000)
  
  
  genCentRange :: Range Int64 -> Gen Cents
  genCentRange r =
      Cents <$> Gen.integral r
  
  genCents :: Gen Cents
  genCents = genCentRange $ Range.linear 0 999999
  
  genLotSize :: Gen LotSize
  genLotSize =
      Gen.choice
          [ Mass <$> genMilligrams
          , Bulbs <$> genInt
          , Slips <$> genInt
          , Plugs <$> genInt
          , CustomLotSize <$> genText
          ]
    where
      genInt =
          Gen.integral $ Range.linear 1 1000
      genMilligrams =
          Milligrams <$> Gen.integral (Range.linear 1 454000)
  
  genInventoryPolicy :: Gen InventoryPolicy
  genInventoryPolicy =
      Gen.choice $ return <$>
          [ RequireStock
          , AllowBackorder
          , Unlimited
          ]
  
  genWholePercentage :: Gen Percent
  genWholePercentage = Gen.integral $ Range.linear 1 100
  
  genText :: MonadGen m => m Text
  genText = Gen.text (Range.linear 1 10) Gen.alpha
  
  genUTCTime :: Gen UTCTime
  genUTCTime =
      UTCTime
          <$> genDay
          <*> genTime
    where
      genTime :: Gen DiffTime
      genTime = secondsToDiffTime <$> Gen.integral (Range.linear 0 86400)
  
  genDay :: Gen Day
  genDay = ModifiedJulianDay <$> Gen.integral (Range.linear 0 999999)
  
  genCountry :: Gen Country
  genCountry = Country <$> Gen.enumBounded
  
  genSaleType :: Gen SaleType
  genSaleType =
      Gen.choice
          [ FlatSale <$> genCents
          , PercentSale <$> genWholePercentage
          ]
  
  setupPostgresContainer :: MonadDocker m => m BS.ByteString
  setupPostgresContainer = do
      let
          pgImage = fromTag "postgres:16"
          pgUser = "postgres"
          pgPassword = "postgres"
          pgDbName = "postgres"
          container = containerRequest pgImage
              & setSuffixedName "postgres-test"
              & setEnv [("POSTGRES_USER", pgUser), ("POSTGRES_PASSWORD", pgPassword), ("POSTGRES_DB", pgDbName)]
              & setExpose [5432]
              & setWaitingFor (waitForLogLine Stderr ("database system is ready to accept connections" `isInfixOf`))
      postgresContainer <- run container
      let (ip, port) = containerAddress postgresContainer 5432
          connString :: BS.ByteString
          connString = encodeUtf8 $
              "host=" <> ip <>
              " port=" <> pack (show port) <>
              " user=" <> pgUser <>
              " password=" <> pgPassword <>
              " dbname=" <> pgDbName
  
      return connString
  