{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Micro.Gateway.Types
( App (..)
, AppKey (..)
, AppSecret (..)
, Domain (..)
, newApp
, Provider (..)
, newProvider
) where
import Data.Aeson (FromJSON (..), ToJSON (..), withText)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LB (ByteString)
import Data.Int (Int64)
import Data.String (IsString (..))
import qualified Data.Text.Lazy as LT (Text, fromStrict, null, unpack)
import qualified Network.HTTP.Client as HTTP
import Network.Wai (Request (..))
newtype AppKey = AppKey {AppKey -> Text
unAppKey :: LT.Text}
deriving (AppKey -> AppKey -> Bool
(AppKey -> AppKey -> Bool)
-> (AppKey -> AppKey -> Bool) -> Eq AppKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppKey -> AppKey -> Bool
$c/= :: AppKey -> AppKey -> Bool
== :: AppKey -> AppKey -> Bool
$c== :: AppKey -> AppKey -> Bool
Eq)
instance Show AppKey where
show :: AppKey -> String
show = Text -> String
LT.unpack (Text -> String) -> (AppKey -> Text) -> AppKey -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppKey -> Text
unAppKey
instance IsString AppKey where
fromString :: String -> AppKey
fromString = Text -> AppKey
AppKey (Text -> AppKey) -> (String -> Text) -> String -> AppKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
instance FromJSON AppKey where
parseJSON :: Value -> Parser AppKey
parseJSON = String -> (Text -> Parser AppKey) -> Value -> Parser AppKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "AppKey" ((Text -> Parser AppKey) -> Value -> Parser AppKey)
-> (Text -> Parser AppKey) -> Value -> Parser AppKey
forall a b. (a -> b) -> a -> b
$ AppKey -> Parser AppKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppKey -> Parser AppKey)
-> (Text -> AppKey) -> Text -> Parser AppKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AppKey
AppKey (Text -> AppKey) -> (Text -> Text) -> Text -> AppKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict
instance ToJSON AppKey where
toJSON :: AppKey -> Value
toJSON (AppKey k :: Text
k) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
k
newtype AppSecret = AppSecret {AppSecret -> Text
unAppSecret :: LT.Text}
instance Show AppSecret where
show :: AppSecret -> String
show = Text -> String
LT.unpack (Text -> String) -> (AppSecret -> Text) -> AppSecret -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppSecret -> Text
unAppSecret
instance IsString AppSecret where
fromString :: String -> AppSecret
fromString = Text -> AppSecret
AppSecret (Text -> AppSecret) -> (String -> Text) -> String -> AppSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
instance FromJSON AppSecret where
parseJSON :: Value -> Parser AppSecret
parseJSON = String -> (Text -> Parser AppSecret) -> Value -> Parser AppSecret
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "AppSecret" ((Text -> Parser AppSecret) -> Value -> Parser AppSecret)
-> (Text -> Parser AppSecret) -> Value -> Parser AppSecret
forall a b. (a -> b) -> a -> b
$ AppSecret -> Parser AppSecret
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AppSecret -> Parser AppSecret)
-> (Text -> AppSecret) -> Text -> Parser AppSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AppSecret
AppSecret (Text -> AppSecret) -> (Text -> Text) -> Text -> AppSecret
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict
instance ToJSON AppSecret where
toJSON :: AppSecret -> Value
toJSON (AppSecret s :: Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s
newtype Domain = Domain {Domain -> Text
unDomain :: LT.Text}
instance Show Domain where
show :: Domain -> String
show = Text -> String
LT.unpack (Text -> String) -> (Domain -> Text) -> Domain -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Domain -> Text
unDomain
instance IsString Domain where
fromString :: String -> Domain
fromString = Text -> Domain
Domain (Text -> Domain) -> (String -> Text) -> String -> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
instance FromJSON Domain where
parseJSON :: Value -> Parser Domain
parseJSON = String -> (Text -> Parser Domain) -> Value -> Parser Domain
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Domain" ((Text -> Parser Domain) -> Value -> Parser Domain)
-> (Text -> Parser Domain) -> Value -> Parser Domain
forall a b. (a -> b) -> a -> b
$ Domain -> Parser Domain
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Domain -> Parser Domain)
-> (Text -> Domain) -> Text -> Parser Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Domain
Domain (Text -> Domain) -> (Text -> Text) -> Text -> Domain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict
instance ToJSON Domain where
toJSON :: Domain -> Value
toJSON (Domain d :: Text
d) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
d
data App = App
{ App -> AppKey
appKey :: AppKey
, App -> AppSecret
appSecret :: AppSecret
, App -> Bool
isKeyOnPath :: Bool
, App -> Bool
isSecure :: Bool
, App -> Bool
onlyProxy :: Bool
, App
-> (Request -> Manager -> IO (Response ByteString))
-> String
-> IO (Response ByteString)
doRequest :: (HTTP.Request -> HTTP.Manager -> IO (HTTP.Response LB.ByteString))
-> String -> IO (HTTP.Response LB.ByteString)
, App -> Maybe String -> Request -> IO (Either String ())
beforeRequest :: Maybe String -> Request -> IO (Either String ())
, App -> Int64 -> Int -> IO ()
afterRequest :: Int64 -> Int -> IO ()
, App -> IO ()
onErrorRequest :: IO ()
, App -> Int
maxRetry :: Int
, App -> Maybe String
retryError :: Maybe String
, App -> (String -> Int -> IO ()) -> IO ()
prepareWsRequest :: (String -> Int -> IO ()) -> IO ()
, App -> [Text]
replaceKeyPages :: [LT.Text]
, App -> ByteString
replaceKeyName :: ByteString
, App -> [Text]
allowPages :: [LT.Text]
}
newApp :: AppKey -> AppSecret -> Bool -> Bool -> App
newApp :: AppKey -> AppSecret -> Bool -> Bool -> App
newApp appKey :: AppKey
appKey appSecret :: AppSecret
appSecret isSecure :: Bool
isSecure onlyProxy :: Bool
onlyProxy = App :: AppKey
-> AppSecret
-> Bool
-> Bool
-> Bool
-> ((Request -> Manager -> IO (Response ByteString))
-> String -> IO (Response ByteString))
-> (Maybe String -> Request -> IO (Either String ()))
-> (Int64 -> Int -> IO ())
-> IO ()
-> Int
-> Maybe String
-> ((String -> Int -> IO ()) -> IO ())
-> [Text]
-> ByteString
-> [Text]
-> App
App
{ isKeyOnPath :: Bool
isKeyOnPath = Bool
False
, doRequest :: (Request -> Manager -> IO (Response ByteString))
-> String -> IO (Response ByteString)
doRequest = String
-> (Request -> Manager -> IO (Response ByteString))
-> String
-> IO (Response ByteString)
forall a. HasCallStack => String -> a
error "no implement"
, beforeRequest :: Maybe String -> Request -> IO (Either String ())
beforeRequest = \_ _ -> Either String () -> IO (Either String ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()
, afterRequest :: Int64 -> Int -> IO ()
afterRequest = \_ _ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, onErrorRequest :: IO ()
onErrorRequest = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, maxRetry :: Int
maxRetry = 3
, retryError :: Maybe String
retryError = Maybe String
forall a. Maybe a
Nothing
, prepareWsRequest :: (String -> Int -> IO ()) -> IO ()
prepareWsRequest = String -> (String -> Int -> IO ()) -> IO ()
forall a. HasCallStack => String -> a
error "no implement"
, replaceKeyPages :: [Text]
replaceKeyPages = []
, replaceKeyName :: ByteString
replaceKeyName = "__KEY__"
, allowPages :: [Text]
allowPages = []
, ..
}
data Provider = Provider
{ Provider -> AppKey -> IO (Maybe App)
getAppByKey :: AppKey -> IO (Maybe App)
, Provider -> Domain -> IO (Maybe App)
getAppByDomain :: Domain -> IO (Maybe App)
, Provider -> Domain -> IO Bool
isValidDomain :: Domain -> IO Bool
, Provider -> AppKey -> IO Bool
isValidKey :: AppKey -> IO Bool
}
notNull :: AppKey -> Bool
notNull :: AppKey -> Bool
notNull (AppKey k :: Text
k) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Bool
LT.null Text
k
newProvider :: Provider
newProvider :: Provider
newProvider = Provider :: (AppKey -> IO (Maybe App))
-> (Domain -> IO (Maybe App))
-> (Domain -> IO Bool)
-> (AppKey -> IO Bool)
-> Provider
Provider
{ getAppByKey :: AppKey -> IO (Maybe App)
getAppByKey = IO (Maybe App) -> AppKey -> IO (Maybe App)
forall a b. a -> b -> a
const (IO (Maybe App) -> AppKey -> IO (Maybe App))
-> IO (Maybe App) -> AppKey -> IO (Maybe App)
forall a b. (a -> b) -> a -> b
$ Maybe App -> IO (Maybe App)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe App
forall a. Maybe a
Nothing
, getAppByDomain :: Domain -> IO (Maybe App)
getAppByDomain = IO (Maybe App) -> Domain -> IO (Maybe App)
forall a b. a -> b -> a
const (IO (Maybe App) -> Domain -> IO (Maybe App))
-> IO (Maybe App) -> Domain -> IO (Maybe App)
forall a b. (a -> b) -> a -> b
$ Maybe App -> IO (Maybe App)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe App
forall a. Maybe a
Nothing
, isValidDomain :: Domain -> IO Bool
isValidDomain = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (Domain -> Bool) -> Domain -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Domain -> Bool
forall a b. a -> b -> a
const Bool
False
, isValidKey :: AppKey -> IO Bool
isValidKey = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> (AppKey -> Bool) -> AppKey -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppKey -> Bool
notNull
}