Replace 'req' with 'http-client'

.github/workflows/haskell-ci.yml

@@ -165,15 +165,11 @@ jobs:
           echo "package connexpay-optparse" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           cat >> cabal.project <<EOF
-          source-repository-package
-            type:     git
-            location: https://github.com/typeable/bucks.git
-            tag:      9e378b675fe7fb88d5ddb3af068d82eb441f343c
+          package connexpay
+            ghc-options: -Werror
 
-          source-repository-package
-            type:     git
-            location: https://github.com/typeable/req.git
-            tag:      8829ac5197f7a4b3f04b7fdfc3ea66cfe70ab0a5
+          package connexpay-optparse
+            ghc-options: -Werror
           EOF
           $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(connexpay|connexpay-optparse)$/; }' >> cabal.project.local
           cat cabal.project

.gitignore

@@ -27,3 +27,5 @@ stack.yaml.lock
 # Temp files
 *~
 \#*\#
+
+config.yml

cabal.haskell-ci

@@ -1 +1,2 @@
 branches: master
+local-ghc-options: -Werror

cabal.project

@@ -3,13 +3,3 @@ with-compiler: ghc-9.6.6
 packages:
   connexpay/
   connexpay-optparse/
-
-source-repository-package
-    type: git
-    location: https://github.com/typeable/bucks.git
-    tag: 9e378b675fe7fb88d5ddb3af068d82eb441f343c
-
-source-repository-package
-    type: git
-    location: https://github.com/typeable/req.git
-    tag: 8829ac5197f7a4b3f04b7fdfc3ea66cfe70ab0a5

cabal.project.freeze

@@ -4,9 +4,6 @@ constraints: any.Cabal ==3.10.3.0,
              any.OneTuple ==0.4.2,
              any.QuickCheck ==2.14.3,
              QuickCheck -old-random +templatehaskell,
-             any.RSA ==2.4.1,
-             any.SHA ==1.6.4.4,
-             SHA -exe,
              any.StateVar ==1.2.2,
              any.aeson ==2.1.2.1,
              aeson -cffi +ordered-keymap,
@@ -25,7 +22,6 @@ constraints: any.Cabal ==3.10.3.0,
              any.attoparsec ==0.14.4,
              attoparsec -developer,
              any.attoparsec-iso8601 ==1.1.1.0,
-             any.authenticate-oauth ==1.7,
              any.base ==4.18.2.1,
              any.base-compat ==0.13.1,
              any.base-compat-batteries ==0.13.1,
@@ -38,8 +34,6 @@ constraints: any.Cabal ==3.10.3.0,
              any.bitvec ==1.1.5.0,
              bitvec +simd,
              any.blaze-builder ==0.4.2.3,
-             any.bucks ==0.1,
-             bucks -aeson -openapi -rel8,
              any.byteorder ==1.0.4,
              any.bytestring ==0.11.5.3,
              any.case-insensitive ==1.2.1.0,
@@ -53,9 +47,6 @@ constraints: any.Cabal ==3.10.3.0,
              any.contravariant ==1.5.5,
              contravariant +semigroups +statevar +tagged,
              any.cookie ==0.4.6,
-             any.crypto-api ==0.13.3,
-             crypto-api -all_cpolys,
-             any.crypto-pubkey-types ==0.4.3,
              any.cryptohash-md5 ==0.11.101.0,
              any.cryptohash-sha1 ==0.11.101.0,
              any.crypton ==0.34,
@@ -65,11 +56,7 @@ constraints: any.Cabal ==3.10.3.0,
              any.crypton-x509-store ==1.6.9,
              any.crypton-x509-system ==1.6.7,
              any.crypton-x509-validation ==1.6.12,
-             any.data-default ==0.7.1.1,
              any.data-default-class ==0.1.2.0,
-             any.data-default-instances-containers ==0.0.1,
-             any.data-default-instances-dlist ==0.0.1,
-             any.data-default-instances-old-locale ==0.0.1,
              any.data-fix ==0.3.4,
              any.deepseq ==1.4.8.1,
              any.directory ==1.3.8.5,
@@ -85,7 +72,6 @@ constraints: any.Cabal ==3.10.3.0,
              any.ghc-bignum ==1.3,
              any.ghc-boot-th ==9.6.6,
              any.ghc-prim ==0.10.0,
-             any.groups ==0.5.3,
              any.hashable ==1.4.4.0,
              hashable +integer-gmp -random-initial-seed,
              any.hourglass ==0.2.12,
@@ -107,18 +93,11 @@ constraints: any.Cabal ==3.10.3.0,
              any.libyaml ==0.1.4,
              libyaml -no-unicode -system-libyaml,
              any.libyaml-clib ==0.2.5,
-             any.megaparsec ==9.5.0,
-             megaparsec -dev,
              any.memory ==0.18.0,
              memory +support_bytestring +support_deepseq,
              any.mime-types ==0.1.2.0,
-             any.modern-uri ==0.3.6.1,
-             modern-uri -dev,
-             any.monad-control ==1.0.3.1,
              any.mono-traversable ==1.0.20.0,
              any.mtl ==2.3.1,
-             any.mtl-compat ==0.2.2,
-             mtl-compat -two-point-one -two-point-two,
              any.network ==3.1.4.0,
              network -devel,
              any.network-info ==0.2.1,
@@ -129,25 +108,17 @@ constraints: any.Cabal ==3.10.3.0,
              optparse-applicative +process,
              any.os-string ==2.0.6,
              any.parsec ==3.1.16.1,
-             any.parser-combinators ==1.3.0,
-             parser-combinators -dev,
              any.pem ==0.2.4,
              any.pretty ==1.1.3.6,
              any.prettyprinter ==1.7.1,
              prettyprinter -buildreadme +text,
              any.prettyprinter-ansi-terminal ==1.1.3,
              any.primitive ==0.8.0.0,
              any.process ==1.6.19.0,
-             any.profunctors ==5.6.2,
              any.random ==1.2.1.2,
-             any.reflection ==2.1.8,
-             reflection -slow +template-haskell,
-             any.req ==3.13.4,
-             req -dev,
              any.resourcet ==1.3.0,
-             any.retry ==0.9.3.1,
-             retry -lib-werror,
              any.rts ==1.0.2,
+             any.safe-exceptions ==0.1.7.4,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
              any.semialign ==1.3.1,
@@ -177,8 +148,6 @@ constraints: any.Cabal ==3.10.3.0,
              any.tls ==1.8.0,
              tls +compat -hans +network,
              any.transformers ==0.6.1.0,
-             any.transformers-base ==0.4.6,
-             transformers-base +orphaninstances,
              any.transformers-compat ==0.7.2,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
              any.unix ==2.8.4.0,

connexpay-optparse/connexpay-optparse.cabal

@@ -14,15 +14,29 @@ build-type:         Simple
 
 tested-with: GHC ==9.8.4 || ==9.6.6
 
-common warnings
-    ghc-options: -Wall
+common common
+    default-extensions:
+      BlockArguments
+      DeriveAnyClass
+      DerivingVia
+      DuplicateRecordFields
+      LambdaCase
+      MultiWayIf
+      NoFieldSelectors
+      OverloadedLabels
+      OverloadedRecordDot
+      OverloadedStrings
+      RecordWildCards
+    default-language: GHC2021
+    ghc-options:
+      -Wall -Wmissing-deriving-strategies -Wprepositive-qualified-module
+      -Wunused-packages -Wredundant-constraints
 
 library
-    import:           warnings
+    import:           common
     exposed-modules:  Web.Connexpay.Cli
     build-depends:    base >=4.14 && < 5.0
+                 ,    connexpay
                  ,    optparse-applicative
-                 ,    text
-                 ,    uuid
     hs-source-dirs:   src
     default-language: Haskell2010

connexpay-optparse/src/Web/Connexpay/Cli.hs

@@ -1,18 +1,19 @@
+{-# LANGUAGE ApplicativeDo #-}
+
 module Web.Connexpay.Cli where
 
-import Data.UUID
-import Data.Text (Text)
 import Options.Applicative
+import Web.Connexpay.Types
 
-data ConnexpayCli = ConnexpayCli { login :: Text
-                                 , password :: Text
-                                 , deviceGuid :: UUID
-                                 , endpoint :: Text
-                                 } deriving Show
 
-connexpayOpts :: Parser ConnexpayCli
-connexpayOpts =
-  ConnexpayCli <$> option str (long "connexpay-login" <> metavar "LOGIN")
-               <*> option str (long "connexpay-password" <> metavar "PASSWORD")
-               <*> option auto (long "connexpay-devguid" <> metavar "GUID")
-               <*> option str (long "connexpay-endpoint" <> metavar "URL")
+connexpayOpts :: Parser Config
+connexpayOpts = do
+  host <- option str (long "connexpay-endpoint" <> metavar "URL")
+  login <- option str (long "connexpay-login" <> metavar "LOGIN")
+  password <- option str (long "connexpay-password" <> metavar "PASSWORD")
+  deviceGuid <- option str (long "connexpay-devguid" <> metavar "GUID")
+  useHttp <- switch (long "use-http" <> help "Use plain HTTP. Insecure!")
+  pure Config
+    { useTLS = not useHttp
+    , ..
+    }

connexpay/connexpay.cabal

@@ -34,38 +34,35 @@ common common
 
 library
     import:           common
-    exposed-modules: Web.Connexpay
-                     Web.Connexpay.Auth
-                     Web.Connexpay.Data
-                     Web.Connexpay.Init
-                     Web.Connexpay.Payments
-                     Web.Connexpay.Types
-                     Web.Connexpay.Utils
+    exposed-modules:
+      Web.Connexpay.Init
+      Web.Connexpay.Payments
+      Web.Connexpay.Types
+    other-modules:
+      Web.Connexpay.Auth
+      Web.Connexpay.Http
+      Web.Connexpay.Payments.Types
+      Web.Connexpay.Utils
     build-depends:    base >=4.14 && < 5.0
                  ,    aeson
                  ,    async
-                 ,    bucks
                  ,    bytestring
                  ,    http-api-data
                  ,    http-client
                  ,    http-types
-                 ,    mtl
-                 ,    req
+                 ,    safe-exceptions
                  ,    text
-                 ,    uuid
     hs-source-dirs:   src
 
 executable connexpay-tool
     import:           common
     build-depends:    base >= 4.17
                  ,    aeson
-                 ,    bucks
                  ,    connexpay
                  ,    http-client
                  ,    http-client-tls
                  ,    optparse-applicative
                  ,    text
-                 ,    uuid
                  ,    yaml
     hs-source-dirs:  tool
     main-is:       Main.hs

connexpay/src/Web/Connexpay/Auth.hs

@@ -1,22 +1,31 @@
 {-# LANGUAGE OverloadedLists #-}
 
-module Web.Connexpay.Auth (authenticate) where
-
-import Web.Connexpay.Types
+module Web.Connexpay.Auth
+  ( AuthReply(..)
+  , TokenReply(..)
+  , authenticate
+  ) where
 
 import Control.Monad
-import Control.Monad.Reader
 import Data.Aeson
 import Data.Aeson.Types
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as ByteString
+import Data.ByteString.Lazy qualified as Lazy
+import Data.ByteString.Lazy qualified as Lazy.ByteString
 import Data.Text (Text)
 import Data.Text qualified as Text
-import Network.HTTP.Req
+import Data.Text.Encoding qualified as Text
+import Network.HTTP.Client qualified as HTTP
+import Network.HTTP.Types
 import Numeric.Natural
 import Web.FormUrlEncoded
 import Web.HttpApiData
 
+import Web.Connexpay.Http
+import Web.Connexpay.Types
+
+
 data AuthForm = AuthForm { login :: Text
                          , password :: Text
                          }
@@ -27,12 +36,18 @@ instance ToForm AuthForm where
                 , ("password", toQueryParam auth.password)
                 ]
 
-mkAuthForm :: Text -> Text -> ByteString
-mkAuthForm login passwd = ByteString.toStrict (urlEncodeAsForm form)
-  where form = AuthForm login passwd
+mkAuthForm :: Config -> ByteString
+mkAuthForm cfg = ByteString.toStrict (urlEncodeAsForm form)
+  where form = AuthForm cfg.login cfg.password
+
+data AuthReply
+  = Authorized TokenReply
+  | Unauthorized (HTTP.Response Lazy.ByteString)
+  | AuthParseError String
+  deriving stock (Show)
 
 data TokenReply = TokenReply { token :: BearerToken
-                             , expires_in :: Natural
+                             , expiresIn :: Natural
                              } deriving stock (Show)
 
 instance FromJSON TokenReply where
@@ -43,16 +58,37 @@ instance FromJSON TokenReply where
                                        <*> v .: "expires_in"
   parseJSON v = typeMismatch "TokenReply" v
 
-authenticate :: ConnexpayM (BearerToken, Natural)
-authenticate = do login <- asks (.login)
-                  password <- asks (.password)
-                  host <- asks (.url)
-                  tls <- asks (.useTLS)
-                  let body = ReqBodyBs (mkAuthForm login password)
-                      url s = s host /: "api" /: "v1" /: "token"
-                  resp <-
-                    if tls
-                      then req POST (url https) body jsonResponse mempty
-                      else req POST (url http) body jsonResponse mempty
-                  let TokenReply tok ts = responseBody resp
-                  pure (tok, ts)
+authenticate :: Config -> Env -> IO AuthReply
+authenticate config env = do
+  let
+    req = HTTP.defaultRequest
+      { HTTP.method = "POST"
+      , HTTP.host = Text.encodeUtf8 config.host
+      , HTTP.port = if config.useTLS then 443 else 80
+      , HTTP.secure = config.useTLS
+      , HTTP.path = "api/v1/token"
+      , HTTP.requestHeaders =
+        [ ("Accept", "application/json")
+        , ("Accept-Encoding", "gzip")
+        ]
+      , HTTP.requestBody = HTTP.RequestBodyBS $ mkAuthForm config
+      }
+  env.logAction $ httpLog req $ "request" .= show @HTTP.Request req
+  resp <- HTTP.httpLbs req env.manager
+  let
+    res
+      | statusIsSuccessful resp.responseStatus
+      = either AuthParseError Authorized $ eitherDecode resp.responseBody
+      | otherwise
+      = Unauthorized resp
+  env.logAction $ httpLog req case res of
+    -- Don't log body! As it contains sensitive info
+    Authorized _ -> "result".= ("success" :: Text)
+    Unauthorized _ -> "result" .= ("unauthorized" :: Text) <> "body:" .=
+      (Text.decodeUtf8Lenient $ Lazy.ByteString.toStrict resp.responseBody)
+    AuthParseError err -> mconcat
+      [ "result" .= ("parse_error: " <> err)
+      , "body" .=
+        (Text.decodeUtf8Lenient $ Lazy.ByteString.toStrict resp.responseBody)
+      ]
+  pure res