diff --git a/argo/argo.cabal b/argo/argo.cabal index 8510496..68bffaa 100644 --- a/argo/argo.cabal +++ b/argo/argo.cabal @@ -32,7 +32,7 @@ common warnings common deps build-depends: base >= 4.11.1.0 && < 4.16, - aeson >= 1.4.2, + aeson >= 1.4.2 && < 2.1, async ^>= 2.2, bytestring ^>= 0.10.8, containers >= 0.5.11 && <0.7, diff --git a/argo/src/Argo.hs b/argo/src/Argo.hs index 5ddb24c..e78f7a4 100644 --- a/argo/src/Argo.hs +++ b/argo/src/Argo.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -99,7 +100,6 @@ import Data.IORef import Data.List.NonEmpty (NonEmpty(..)) import Data.Map (Map) import qualified Data.Map as Map -import qualified Data.HashMap.Strict as HM import Data.Maybe (maybeToList) import Data.Scientific (Scientific) import Data.Set (Set) @@ -136,6 +136,13 @@ import qualified Web.Scotty as Scotty status, text ) +#if MIN_VERSION_aeson(2,0,0) +import Data.Aeson.Key (Key) +import qualified Data.Aeson.KeyMap as KM +#else +import qualified Data.HashMap.Strict as HM +#endif + import Network.Wai.Handler.Warp (Port, defaultSettings, setPort, setFork) import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings) @@ -1023,7 +1030,7 @@ handleRequest opts respond app req = do withoutStateID :: IO a -> IO a withoutStateID act = - if HM.member "state" (requestParams req) + if memberKM "state" (requestParams req) then throwIO unexpectedStateID else act @@ -1060,7 +1067,7 @@ serveStdIO opts = serveHandles opts stdin stdout getStateID :: Request -> IO StateID getStateID req = - case HM.lookup "state" (requestParams req) of + case lookupKM "state" (requestParams req) of Just sid -> case JSON.fromJSON sid of JSON.Success i -> pure i @@ -1356,3 +1363,18 @@ serveHttp opts httpOpts app port = do else do Scotty.status stat Scotty.text $ "The header \"" <> h <> "\" should be \"application/json\"." Scotty.finish + +-- TODO: When the ecosystem widely uses aeson-2.0.0.0 or later, remove this CPP. +#if MIN_VERSION_aeson(2,0,0) +lookupKM :: Key -> KM.KeyMap JSON.Value -> Maybe JSON.Value +lookupKM = KM.lookup + +memberKM :: Key -> KM.KeyMap JSON.Value -> Bool +memberKM = KM.member +#else +lookupKM :: Text -> HM.HashMap Text JSON.Value -> Maybe JSON.Value +lookupKM = HM.lookup + +memberKM :: Text -> HM.HashMap Text JSON.Value -> Bool +memberKM = HM.member +#endif