diff options
author | Julien Dessaux | 2023-07-22 00:10:02 +0200 |
---|---|---|
committer | Julien Dessaux | 2023-07-22 00:10:02 +0200 |
commit | d1f0faf30f5b5d05ae9f5eda36de8f9cffcade2d (patch) | |
tree | 3aa9d1c035d2dc5931db030a4fd764cf43b3f507 /haskell/src/SpaceTraders.hs | |
parent | [haskell] abstracted away common database access patterns (diff) | |
download | spacetraders-d1f0faf30f5b5d05ae9f5eda36de8f9cffcade2d.tar.gz spacetraders-d1f0faf30f5b5d05ae9f5eda36de8f9cffcade2d.tar.bz2 spacetraders-d1f0faf30f5b5d05ae9f5eda36de8f9cffcade2d.zip |
[haskell] Prevent que networking code from triggering the API rate limiting
Diffstat (limited to '')
-rw-r--r-- | haskell/src/SpaceTraders.hs | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/haskell/src/SpaceTraders.hs b/haskell/src/SpaceTraders.hs index 2a531fe..5bd7526 100644 --- a/haskell/src/SpaceTraders.hs +++ b/haskell/src/SpaceTraders.hs @@ -1,28 +1,46 @@ +{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-} module SpaceTraders ( SpaceTradersT + , microSinceEpoch + , newEnv , runSpaceTradersT , Env(..) , HasDatabaseConn , HasRequest , ask , getConn + , getLastAPICall , getRequest , liftIO ) where import Control.Monad.IO.Class import Control.Monad.Reader +import Data.IORef +import Data.Time.Clock +import Data.Time.Clock.POSIX import qualified Database.SQLite.Simple as S import Network.HTTP.Simple type SpaceTradersT a = ReaderT Env IO a +newEnv :: S.Connection -> Request -> IO Env +newEnv conn req = do + r <- newIORef 0 + return $ Env conn r req + runSpaceTradersT :: SpaceTradersT a -> Env -> IO a runSpaceTradersT = runReaderT +microSinceEpoch :: IO Integer +microSinceEpoch = do + t <- getCurrentTime + return $ floor . (1e6 *) . nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds t + data Env = Env { envConn :: S.Connection + , envLastAPICall :: IORef Integer , envRequest :: Request } class HasDatabaseConn a where @@ -33,6 +51,8 @@ instance HasDatabaseConn Env where getConn = envConn class HasRequest a where + getLastAPICall :: a -> IORef Integer getRequest :: a -> Request instance HasRequest Env where + getLastAPICall = envLastAPICall getRequest = envRequest |