diff options
author | Julien Dessaux | 2023-07-02 22:58:30 +0200 |
---|---|---|
committer | Julien Dessaux | 2023-07-02 23:01:01 +0200 |
commit | a775330b4fa17fb367e55343e6fda6c7ae9e34b4 (patch) | |
tree | 8c572f799dbf434459d4659e32559c121421f120 /haskell/src/SpaceTraders/APIClient/Client.hs | |
parent | Moved the nodejs agent to its own subfolder to make room for my haskell agent (diff) | |
download | spacetraders-a775330b4fa17fb367e55343e6fda6c7ae9e34b4.tar.gz spacetraders-a775330b4fa17fb367e55343e6fda6c7ae9e34b4.tar.bz2 spacetraders-a775330b4fa17fb367e55343e6fda6c7ae9e34b4.zip |
Bootstrapped my haskell client
Diffstat (limited to '')
-rw-r--r-- | haskell/src/SpaceTraders/APIClient/Client.hs | 69 |
1 files changed, 69 insertions, 0 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Client.hs b/haskell/src/SpaceTraders/APIClient/Client.hs new file mode 100644 index 0000000..e4744aa --- /dev/null +++ b/haskell/src/SpaceTraders/APIClient/Client.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE OverloadedStrings #-} + +module SpaceTraders.APIClient.Client + ( APIError(..) + , APIMessage(..) + , defaultReq + , fromJSONValue + , send + , tokenReq + ) where + +import Control.Exception +import Control.Monad +import Data.Aeson +import Data.Aeson.Types +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import Network.HTTP.Simple +import Network.HTTP.Types.Status + +data APIError = APIError { apiErrorCode :: Int + , apiErrorMessage :: T.Text + } deriving Show +instance Exception APIError +instance FromJSON APIError where + parseJSON (Object o) = do + e <- o .: "error" + APIError <$> e .: "code" + <*> e .: "message" + parseJSON _ = mzero + +data APIMessage = APIMessage { data_ :: Value } deriving (Show) +instance FromJSON APIMessage where + parseJSON (Object o) = APIMessage <$> o .: "data" + parseJSON _ = mzero + +defaultReq :: Request +defaultReq = setRequestHost "api.spacetraders.io" + $ setRequestPort 443 + $ setRequestSecure True + $ setRequestHeader "Content-Type" ["application/json"] + $ defaultRequest + +tokenReq :: T.Text -> Request +tokenReq token = setRequestHeader "Authorization" [T.encodeUtf8 $ "Bearer " <> token] + $ defaultReq + +fromJSONValue :: FromJSON a => Value -> Either String a +fromJSONValue = parseEither parseJSON + +send :: FromJSON a => Request -> IO (Either APIError a) +send request = do + response <- httpLbs request + let status = statusCode $ getResponseStatus response + body = getResponseBody response + if status >= 200 && status <= 299 + then case eitherDecode body of + Left e -> return $ Left APIError{apiErrorCode = -1000, apiErrorMessage = T.pack $ concat ["Error decoding JSON APIMessage: ", e]} + Right r -> case fromJSONValue (data_ r) of + Left e -> return $ Left APIError{apiErrorCode = -1001, apiErrorMessage = T.pack $ concat ["Error decoding JSON message contents: ", e]} + Right m -> return $ Right m + else case eitherDecode body of + Left e -> return $ Left APIError{apiErrorCode = -status, apiErrorMessage = T.pack $ concat ["Error decoding JSON APIError: ", e, ". Got HTTP body: ", show body]} + Right e -> return $ Left e + +--handleAPIError :: SomeException -> IO (Maybe RegisterMessage) +--handleAPIError e = do +-- print e +-- return Nothing |