module Google.Cloud.Internal.Types where
import Control.Applicative
import Control.Exception
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad.Reader
import Control.Monad.Except
import Control.Applicative
import Data.Time
import Data.Text (Text)
import qualified Data.Text as T
import System.Random
import Network.HTTP.Client (Manager)
import Prelude
data Handle = Handle
{ hManager :: !Manager
, hToken :: !(TVar (Maybe Token))
, hFetchToken :: !(Cloud Token)
}
data Token = Token
{ tokenExpiresAt :: !UTCTime
, tokenValue :: !Text
} deriving (Show)
data Error
= UnknownError !Text
| IOError !String
| DecodeError !String
deriving (Show)
newtype Cloud a = Cloud
{ runCloud :: ReaderT Handle (ExceptT Error IO) a
} deriving (Functor, Applicative, Monad, MonadIO,
MonadError Error, MonadReader Handle)
instance Alternative Cloud where
empty = throwError $ UnknownError "empty"
a <|> b = catchError a (const b)
evalCloud :: Handle -> Cloud a -> IO (Either Error a)
evalCloud h m = (runExceptT $ runReaderT (runCloud m) h) `catch`
(\e -> transformException (UnknownError . T.pack . show) e >>= return . Left)
transformException :: (SomeException -> Error) -> SomeException -> IO Error
transformException f e = case fromException e of
Just async -> throwIO (async :: AsyncException)
Nothing -> return $ f e
cloudIO :: IO a -> Cloud a
cloudIO m = do
res <- liftIO $ (Right <$> m) `catch`
(\e -> transformException (IOError . show) e >>= return . Left)
case res of
Left e -> throwError e
Right r -> return r
retry :: Cloud a -> Cloud a
retry = go 0
where
maxRetries = 5
randomDelay i = cloudIO $ do
jitter <- getStdRandom (randomR (0,500000))
threadDelay $ jitter + 1000000 * (floor $ (2 :: Float) ** fromIntegral i)
go :: Int -> Cloud a -> Cloud a
go i m
| i > maxRetries = throwError $ UnknownError "retry: Too many retries"
| otherwise = m <|> (randomDelay i >> go (i + 1) m)