{-# 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 ())
  -- beforeRequest retryError req
  , App -> Int64 -> Int -> IO ()
afterRequest   :: Int64 -> Int -> IO ()
  -- afterRequest contentLength statusCode
  , App -> IO ()
onErrorRequest :: IO ()
  , App -> Int
maxRetry       :: Int
  -- set the max retry on bad gateway error
  , 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

  -- allow page prefix
  , 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
  }