style: handle fourmolu suggestions...

geniusyield · Jul 16, 2024 · cef00a8 · cef00a8
1 parent 96c77c8
commit cef00a8
Show file tree

Hide file tree

Showing 11 changed files with 173 additions and 156 deletions.
diff --git a/geniusyield-orderbot-lib/src/GeniusYield/OrderBot/Domain/Markets.hs b/geniusyield-orderbot-lib/src/GeniusYield/OrderBot/Domain/Markets.hs
@@ -74,13 +74,13 @@ instance Swagger.ToParamSchema OrderAssetPair where
 
 instance Swagger.ToSchema OrderAssetPair where
   declareNamedSchema p =
-    pure $
-      Swagger.named "OrderAssetPair" $
-        Swagger.paramSchemaToSchema p
-          & Swagger.example
-          ?~ toJSON ("f43a62fdc3965df486de8a0d32fe800963589c41b38946602a0dc535.41474958_dda5fdb1002f7389b33e036b6afee82a8189becb6cba852e8b79b4fb.0014df1047454e53" ∷ String)
-            & Swagger.description
-          ?~ "Market pair identifier. It's an underscore delimited concatenation of offered and asked asset's \"token detail\". A token detail is given by dot delimited concatenation of policy id and token name."
+    pure
+      $ Swagger.named "OrderAssetPair"
+      $ Swagger.paramSchemaToSchema p
+      & Swagger.example
+      ?~ toJSON ("f43a62fdc3965df486de8a0d32fe800963589c41b38946602a0dc535.41474958_dda5fdb1002f7389b33e036b6afee82a8189becb6cba852e8b79b4fb.0014df1047454e53" ∷ String)
+        & Swagger.description
+      ?~ "Market pair identifier. It's an underscore delimited concatenation of offered and asked asset's \"token detail\". A token detail is given by dot delimited concatenation of policy id and token name."
 
 {- | Two order asset pairs are considered "equivalent" (but not strictly equal, as in 'Eq'),
      if they contain the same 2 assets irrespective of order.

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Api.hs b/geniusyield-server-lib/src/GeniusYield/Server/Api.hs
@@ -158,21 +158,21 @@ assetPairToKVT ac i = K.fromText (f ac) Aeson..= toUrlPiece i
 
 instance Swagger.ToSchema GYBalance where
   declareNamedSchema _ = do
-    pure $
-      Swagger.named "GYBalance" $
-        mempty
-          & Swagger.type_
-            ?~ Swagger.SwaggerObject
-          & Swagger.example
-            ?~ toJSON
-              ( GYBalance $
-                  valueFromList
-                    [ (GYLovelace, 22),
-                      (GYToken "ff80aaaf03a273b8f5c558168dc0e2377eea810badbae6eceefc14ef" "GOLD", 101)
-                    ]
-              )
-          & Swagger.description
-            ?~ "A multi asset quantity, represented as map where each key represents an asset: policy ID and token name in hex concatenated by a dot."
+    pure
+      $ Swagger.named "GYBalance"
+      $ mempty
+      & Swagger.type_
+      ?~ Swagger.SwaggerObject
+        & Swagger.example
+      ?~ toJSON
+        ( GYBalance
+            $ valueFromList
+              [ (GYLovelace, 22),
+                (GYToken "ff80aaaf03a273b8f5c558168dc0e2377eea810badbae6eceefc14ef" "GOLD", 101)
+              ]
+        )
+        & Swagger.description
+      ?~ "A multi asset quantity, represented as map where each key represents an asset: policy ID and token name in hex concatenated by a dot."
 
 -------------------------------------------------------------------------------
 -- Server's API.
@@ -218,49 +218,49 @@ geniusYieldAPIOpenApi ∷ OpenApi
 geniusYieldAPIOpenApi =
   toOpenApi geniusYieldAPI
     & info
-      . title
-      .~ "GeniusYield DEX Server API"
-    & info
+    . title
+    .~ "GeniusYield DEX Server API"
+      & info
       . version
-      .~ "0.0.1"
-    & info
+    .~ "0.0.1"
+      & info
       . license
-      ?~ ("Apache-2.0" & url ?~ URL "https://opensource.org/licenses/apache-2-0")
-    & info
+    ?~ ("Apache-2.0" & url ?~ URL "https://opensource.org/licenses/apache-2-0")
+      & info
       . contact
-      ?~ ( mempty
-            & url
-              ?~ URL "https://www.geniusyield.co/"
+    ?~ ( mempty
+          & url
+          ?~ URL "https://www.geniusyield.co/"
             & email
-              ?~ "[email protected]"
+          ?~ "[email protected]"
             & name
-              ?~ "GeniusYield Technical Support"
-         )
-    & info
+          ?~ "GeniusYield Technical Support"
+       )
+      & info
       . description
-      ?~ "API to interact with GeniusYield DEX."
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("tx" +> TxAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Transaction" & description ?~ "Endpoints related to transaction hex such as submitting a transaction"]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("markets" +> MarketsAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Markets" & description ?~ "Endpoints related to accessing markets information"]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("orders" +> OrdersAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Orders" & description ?~ "Endpoints related to interacting with orders"]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("settings" +> SettingsAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Settings" & description ?~ "Endpoint to get server settings such as network, version, and revision"]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("trading-fees" +> TradingFeesAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Trading Fees" & description ?~ "Endpoint to get trading fees of DEX."]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("assets" +> AssetsAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Assets" & description ?~ "Endpoint to fetch asset details."]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("order-books" +> OrderBookAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Order Book" & description ?~ "Endpoint to fetch order book."]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("historical-prices" +> HistoricalPricesAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Historical Prices" & description ?~ "Endpoints to fetch historical prices."]
-    & applyTagsFor (subOperations (Proxy ∷ Proxy ("balances" +> BalancesAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Balances" & description ?~ "Endpoint to fetch token balances."]
+    ?~ "API to interact with GeniusYield DEX."
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("tx" +> TxAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Transaction" & description ?~ "Endpoints related to transaction hex such as submitting a transaction"]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("markets" +> MarketsAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Markets" & description ?~ "Endpoints related to accessing markets information"]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("orders" +> OrdersAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Orders" & description ?~ "Endpoints related to interacting with orders"]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("settings" +> SettingsAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Settings" & description ?~ "Endpoint to get server settings such as network, version, and revision"]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("trading-fees" +> TradingFeesAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Trading Fees" & description ?~ "Endpoint to get trading fees of DEX."]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("assets" +> AssetsAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Assets" & description ?~ "Endpoint to fetch asset details."]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("order-books" +> OrderBookAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Order Book" & description ?~ "Endpoint to fetch order book."]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("historical-prices" +> HistoricalPricesAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Historical Prices" & description ?~ "Endpoints to fetch historical prices."]
+      & applyTagsFor (subOperations (Proxy ∷ Proxy ("balances" +> BalancesAPI)) (Proxy ∷ Proxy GeniusYieldAPI)) ["Balances" & description ?~ "Endpoint to fetch token balances."]
 
 geniusYieldServer ∷ Ctx → ServerT GeniusYieldAPI IO
 geniusYieldServer ctx =
-  ignoredAuthResult $
-    handleSettings ctx
-      :<|> handleOrdersApi ctx
-      :<|> handleMarketsApi ctx
-      :<|> handleTxApi ctx
-      :<|> handleTradingFeesApi ctx
-      :<|> handleAssetsApi ctx
-      :<|> handleOrderBookApi ctx
-      :<|> handleHistoricalPricesApi ctx
-      :<|> handleBalancesApi ctx
+  ignoredAuthResult
+    $ handleSettings ctx
+    :<|> handleOrdersApi ctx
+    :<|> handleMarketsApi ctx
+    :<|> handleTxApi ctx
+    :<|> handleTradingFeesApi ctx
+    :<|> handleAssetsApi ctx
+    :<|> handleOrderBookApi ctx
+    :<|> handleHistoricalPricesApi ctx
+    :<|> handleBalancesApi ctx
  where
   ignoredAuthResult f _authResult = f
 
@@ -341,8 +341,8 @@ handleOrderBookApi ctx@Ctx {..} orderAssetPair mownAddress = do
           )
           ([] :!: [])
           os'
-  pure $
-    OrderBookInfo
+  pure
+    $ OrderBookInfo
       { obiMarketPairId = orderAssetPair,
         obiTimestamp = gytime,
         obiAsks = sortBy (\a b → compare (oiPrice a) (oiPrice b)) asks, -- sort by increasing price

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/Maestro.hs b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/Maestro.hs
@@ -96,13 +96,13 @@ instance Swagger.ToParamSchema MaestroOrder where
 
 instance Swagger.ToSchema MaestroOrder where
   declareNamedSchema p =
-    pure $
-      Swagger.NamedSchema (Just "MaestroOrder") $
-        Swagger.paramSchemaToSchema p
-          & Swagger.example
-            ?~ toJSON (MaestroOrder Ascending)
-          & Swagger.description
-            ?~ "Order of the results"
+    pure
+      $ Swagger.NamedSchema (Just "MaestroOrder")
+      $ Swagger.paramSchemaToSchema p
+      & Swagger.example
+      ?~ toJSON (MaestroOrder Ascending)
+        & Swagger.description
+      ?~ "Order of the results"
 
 newtype MaestroResolution = MaestroResolution {unMaestroResolution ∷ Resolution}
   deriving stock (Show)
@@ -113,13 +113,13 @@ instance Swagger.ToParamSchema MaestroResolution where
 
 instance Swagger.ToSchema MaestroResolution where
   declareNamedSchema p =
-    pure $
-      Swagger.NamedSchema (Just "MaestroResolution") $
-        Swagger.paramSchemaToSchema p
-          & Swagger.example
-            ?~ toJSON (MaestroResolution Res1m)
-          & Swagger.description
-            ?~ "Resolution of the data"
+    pure
+      $ Swagger.NamedSchema (Just "MaestroResolution")
+      $ Swagger.paramSchemaToSchema p
+      & Swagger.example
+      ?~ toJSON (MaestroResolution Res1m)
+        & Swagger.description
+      ?~ "Resolution of the data"
 
 newtype MaestroDex = MaestroDex {unMaestroDex ∷ Dex}
   deriving stock (Show)
@@ -130,13 +130,13 @@ instance Swagger.ToParamSchema MaestroDex where
 
 instance Swagger.ToSchema MaestroDex where
   declareNamedSchema p =
-    pure $
-      Swagger.NamedSchema (Just "MaestroDex") $
-        Swagger.paramSchemaToSchema p
-          & Swagger.example
-            ?~ toJSON (MaestroDex GeniusYield)
-          & Swagger.description
-            ?~ "DEX to fetch data from"
+    pure
+      $ Swagger.NamedSchema (Just "MaestroDex")
+      $ Swagger.paramSchemaToSchema p
+      & Swagger.example
+      ?~ toJSON (MaestroDex GeniusYield)
+        & Swagger.description
+      ?~ "DEX to fetch data from"
 
 type MaestroPriceHistoryAPI =
   Summary "Get price history using Maestro."

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools.hs b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools.hs
@@ -21,11 +21,11 @@ newtype TapToolsNumIntervals = TapToolsNumIntervals {unTapToolsNumIntervals ∷
 -- Since this is a query parameter, our schema description wouldn't be registered for in swagger specification :(. Following OpenAPI 3.0 would allow for it.
 instance Swagger.ToSchema TapToolsNumIntervals where
   declareNamedSchema p =
-    pure $
-      Swagger.named "TapToolsNumIntervals" $
-        Swagger.paramSchemaToSchema p
-          & Swagger.description
-            ?~ "The number of intervals to return, e.g. if you want 180 days of data in 1d intervals, then pass 180 here."
+    pure
+      $ Swagger.named "TapToolsNumIntervals"
+      $ Swagger.paramSchemaToSchema p
+      & Swagger.description
+      ?~ "The number of intervals to return, e.g. if you want 180 days of data in 1d intervals, then pass 180 here."
 
 type TapToolsPriceHistoryAPI =
   Summary "Get price history using TapTools."

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs b/geniusyield-server-lib/src/GeniusYield/Server/Dex/HistoricalPrices/TapTools/Client.hs
@@ -80,13 +80,13 @@ instance Swagger.ToParamSchema TapToolsInterval where
 
 instance Swagger.ToSchema TapToolsInterval where
   declareNamedSchema p =
-    pure $
-      Swagger.NamedSchema (Just "TapToolsInterval") $
-        Swagger.paramSchemaToSchema p
-          & Swagger.example
-            ?~ toJSON TTI1M
-          & Swagger.description
-            ?~ "The time interval"
+    pure
+      $ Swagger.NamedSchema (Just "TapToolsInterval")
+      $ Swagger.paramSchemaToSchema p
+      & Swagger.example
+      ?~ toJSON TTI1M
+        & Swagger.description
+      ?~ "The time interval"
 
 type TapToolsOHLCVPrefix ∷ Symbol
 type TapToolsOHLCVPrefix = "tapToolsOHLCV"

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Dex/PartialOrder.hs b/geniusyield-server-lib/src/GeniusYield/Server/Dex/PartialOrder.hs
@@ -200,11 +200,11 @@ newtype ChangeAddress = ChangeAddress GYAddressBech32
 instance Swagger.ToSchema ChangeAddress where
   declareNamedSchema _ = do
     addrBech32Schema ← Swagger.declareSchema (Proxy @GYAddressBech32)
-    return $
-      Swagger.named "ChangeAddress" $
-        addrBech32Schema
-          & Swagger.description
-            %~ (\mt → mt <> Just " This is used as a change address by our balancer to send left over funds from selected inputs. If not provided, first address from given addresses list is used instead.")
+    return
+      $ Swagger.named "ChangeAddress"
+      $ addrBech32Schema
+      & Swagger.description
+      %~ (\mt → mt <> Just " This is used as a change address by our balancer to send left over funds from selected inputs. If not provided, first address from given addresses list is used instead.")
 
 type PlaceOrderReqPrefix ∷ Symbol
 type PlaceOrderReqPrefix = "pop"
@@ -434,11 +434,12 @@ handlePlaceOrder ctx@Ctx {..} pops@PlaceOrderParameters {..} = do
       pocVersion = POCVersion1_1
   SomeRefPocd (RefPocd (cfgRef :!: pocd)) ← runQuery ctx $ fetchPartialOrderConfig pocVersion porefs
   let unitPrice =
-        rationalFromGHC $
-          toInteger popPriceAmount % toInteger popOfferAmount
+        rationalFromGHC
+          $ toInteger popPriceAmount
+          % toInteger popOfferAmount
   (nftAC, txBody) ←
-    runSkeletonF ctx (NonEmpty.toList popAddresses') changeAddr popCollateral $
-      placePartialOrder''
+    runSkeletonF ctx (NonEmpty.toList popAddresses') changeAddr popCollateral
+      $ placePartialOrder''
         porefs
         changeAddr
         (naturalToGHC popOfferAmount, popOfferToken)
@@ -522,8 +523,9 @@ handleOrdersDetails ctx@Ctx {..} acs = do
   let porefs = dexPORefs ctxDexInfo
   os ← forM acs $ \ac → do
     logDebug ctx $ "Getting order details for NFT token: " +|| ac ||+ ""
-    runQuery ctx $
-      fmap poiToOrderInfoDetailed <$> orderByNft porefs ac
+    runQuery ctx
+      $ fmap poiToOrderInfoDetailed
+      <$> orderByNft porefs ac
   pure $ catMaybes os
 
 handleFillOrders ∷ Ctx → FillOrderParameters → IO FillOrderTransactionDetails

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/ErrorMiddleware.hs b/geniusyield-server-lib/src/GeniusYield/Server/ErrorMiddleware.hs
@@ -43,9 +43,12 @@ Example of responses which are not in JSON: Servant body parse error, url not fo
 errorJsonWrapMiddleware ∷ Wai.Middleware
 errorJsonWrapMiddleware app req respond = app req $ \res → do
   let (status, headers, body) = Wai.responseToStream res
-  if lookup "Content-Type" headers /= Just "application/json" -- Don't overwrite responses which are already json!
-    && statusCode status >= 400
-    && statusCode status < 600
+  if lookup "Content-Type" headers
+    /= Just "application/json" -- Don't overwrite responses which are already json!
+    && statusCode status
+    >= 400
+    && statusCode status
+    < 600
     then do
       lbs ←
         if statusCode status == 404
@@ -58,8 +61,10 @@ errorJsonWrapMiddleware app req respond = app req $ \res → do
 errorLoggerMiddleware ∷ (LT.Text → IO ()) → Wai.Middleware
 errorLoggerMiddleware errorLogger app req respond = app req $ \res → do
   let (status, _headers, body) = Wai.responseToStream res
-  when (statusCode status >= 400 && statusCode status < 600) $
-    sinkStreamingBody body >>= errorLogger . lazyDecodeUtf8Lenient
+  when (statusCode status >= 400 && statusCode status < 600)
+    $ sinkStreamingBody body
+    >>= errorLogger
+    . lazyDecodeUtf8Lenient
   respond res
 
 {- | Reinterpret exceptions raised by the server (mostly contract exceptions) into 'GYApiError's.
@@ -131,23 +136,23 @@ exceptionHandler =
         GYConversionException convErr → someBackendError $ tShow convErr
         GYQueryUTxOException txErr → someBackendError $ tShow txErr
         GYNoSuitableCollateralException minAmt addr →
-          someBackendError $
-            "No suitable collateral of at least "
-              <> tShow minAmt
-              <> " was found at the address "
-              <> tShow addr
+          someBackendError
+            $ "No suitable collateral of at least "
+            <> tShow minAmt
+            <> " was found at the address "
+            <> tShow addr
         GYSlotOverflowException slot advAmt →
-          someBackendError $
-            "Slot value "
-              <> tShow slot
-              <> " overflows when advanced by "
-              <> tShow advAmt
+          someBackendError
+            $ "Slot value "
+            <> tShow slot
+            <> " overflows when advanced by "
+            <> tShow advAmt
         GYTimeUnderflowException sysStart time →
-          someBackendError $
-            "Timestamp "
-              <> tShow time
-              <> " is before known system start "
-              <> tShow sysStart
+          someBackendError
+            $ "Timestamp "
+            <> tShow time
+            <> " is before known system start "
+            <> tShow sysStart
         GYQueryDatumException qdErr → someBackendError $ tShow qdErr
         GYDatumMismatch actualDatum scriptWitness → someBackendError $ "Actual datum in UTxO is: " <> tShow actualDatum <> ", but witness has wrong corresponding datum information: " <> tShow scriptWitness
         GYApplicationException e → toApiError e,

diff --git a/geniusyield-server-lib/src/GeniusYield/Server/Options.hs b/geniusyield-server-lib/src/GeniusYield/Server/Options.hs
@@ -17,12 +17,12 @@ newtype ServeCommand = ServeCommand (Maybe FilePath)
 
 parseCommand ∷ Parser Command
 parseCommand =
-  subparser $
-    mconcat
+  subparser
+    $ mconcat
       [ command
           "serve"
-          ( info (Serve <$> parseServeCommand <**> helper) $
-              progDesc "Serve endpoints"
+          ( info (Serve <$> parseServeCommand <**> helper)
+              $ progDesc "Serve endpoints"
           )
       ]