module LaunchDarkly.Server.Features where

import Control.Lens (element, (^?))
import Control.Monad (mzero)
import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, withObject, (.!=), (.:), (.:?), (.=))
import Data.Generics.Product (getField)
import Data.HashSet (HashSet)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import GHC.Generics (Generic)
import GHC.Natural (Natural)

import LaunchDarkly.Server.Details (EvaluationReason (..))
import qualified LaunchDarkly.Server.Details as D
import LaunchDarkly.Server.Operators (Op)
import LaunchDarkly.Server.Reference (Reference, makeLiteral, makeReference)

data Target = Target
    { values :: !(HashSet Text)
    , variation :: !Integer
    , contextKind :: Text
    }
    deriving (Generic, ToJSON, Show, Eq)

instance FromJSON Target where
    parseJSON = withObject "Target" $ \t ->
        Target
            <$> t .: "values"
            <*> t .: "variation"
            <*> t .:? "contextKind" .!= "user"

data Rule = Rule
    { id :: !Text
    , clauses :: ![Clause]
    , variationOrRollout :: !VariationOrRollout
    , trackEvents :: !Bool
    }
    deriving (Generic, Show, Eq)

instance FromJSON Rule where
    parseJSON = withObject "Rule" $ \o -> do
        id <- o .:? "id"
        clauses <- o .: "clauses"
        variation <- o .:? "variation"
        rollout <- o .:? "rollout"
        trackEvents <- o .: "trackEvents"
        pure
            Rule
                { id = fromMaybe "" id
                , clauses = clauses
                , variationOrRollout =
                    VariationOrRollout
                        { variation = variation
                        , rollout = rollout
                        }
                , trackEvents = trackEvents
                }

instance ToJSON Rule where
    toJSON rule =
        object
            [ "id" .= getField @"id" rule
            , "clauses" .= getField @"clauses" rule
            , "trackEvents" .= getField @"trackEvents" rule
            , "variation" .= getField @"variation" (getField @"variationOrRollout" rule)
            , "rollout" .= getField @"rollout" (getField @"variationOrRollout" rule)
            ]

data WeightedVariation = WeightedVariation
    { variation :: !Integer
    , weight :: !Float
    , untracked :: !Bool
    }
    deriving (Generic, ToJSON, Show, Eq)

instance FromJSON WeightedVariation where
    parseJSON = withObject "WeightedVariation" $ \o -> do
        variation <- o .: "variation"
        weight <- o .: "weight"
        untracked <- o .:? "untracked" .!= False
        pure WeightedVariation {..}

data RolloutKind = RolloutKindExperiment | RolloutKindRollout
    deriving (Eq, Show)

instance ToJSON RolloutKind where
    toJSON x = String $ case x of
        RolloutKindExperiment -> "experiment"
        RolloutKindRollout -> "rollout"

instance FromJSON RolloutKind where
    parseJSON x = case x of
        (String "experiment") -> pure RolloutKindExperiment
        (String "rollout") -> pure RolloutKindRollout
        _ -> mzero

data Rollout = Rollout
    { variations :: ![WeightedVariation]
    , bucketBy :: !(Maybe Text)
    , kind :: !RolloutKind
    , contextKind :: !(Maybe Text)
    , seed :: !(Maybe Int)
    }
    deriving (Generic, ToJSON, Show, Eq)

instance FromJSON Rollout where
    parseJSON = withObject "rollout" $ \o -> do
        variations <- o .: "variations"
        bucketBy <- o .:? "bucketBy"
        kind <- o .:? "kind" .!= RolloutKindRollout
        contextKind <- o .:? "contextKind"
        seed <- o .:? "seed"
        pure Rollout {..}

data VariationOrRollout = VariationOrRollout
    { variation :: !(Maybe Integer)
    , rollout :: !(Maybe Rollout)
    }
    deriving (Generic, FromJSON, ToJSON, Show, Eq)

data ClientSideAvailability = ClientSideAvailability
    { usingEnvironmentId :: !Bool
    , usingMobileKey :: !Bool
    , explicit :: !Bool
    }
    deriving (Generic, Show, Eq)

instance FromJSON ClientSideAvailability where
    parseJSON = withObject "ClientSideAvailability" $ \obj ->
        ClientSideAvailability
            <$> obj .: "usingEnvironmentId"
            <*> obj .: "usingMobileKey"
            <*> pure True

instance ToJSON ClientSideAvailability where
    toJSON (ClientSideAvailability env mob _) =
        object ["usingEnvironmentId" .= env, "usingMobileKey" .= mob]

data Flag = Flag
    { key :: !Text
    , version :: !Natural
    , on :: !Bool
    , trackEvents :: !Bool
    , trackEventsFallthrough :: !Bool
    , deleted :: !Bool
    , prerequisites :: ![Prerequisite]
    , salt :: !Text
    , targets :: ![Target]
    , contextTargets :: ![Target]
    , rules :: ![Rule]
    , fallthrough :: !VariationOrRollout
    , offVariation :: !(Maybe Integer)
    , variations :: ![Value]
    , debugEventsUntilDate :: !(Maybe Natural)
    , clientSideAvailability :: !ClientSideAvailability
    }
    deriving (Generic, Show, Eq)

instance ToJSON Flag where
    toJSON flag =
        object $
            [ "key" .= getField @"key" flag
            , "version" .= getField @"version" flag
            , "on" .= getField @"on" flag
            , "trackEvents" .= getField @"trackEvents" flag
            , "trackEventsFallthrough" .= getField @"trackEventsFallthrough" flag
            , "deleted" .= getField @"deleted" flag
            , "prerequisites" .= getField @"prerequisites" flag
            , "salt" .= getField @"salt" flag
            , "targets" .= getField @"targets" flag
            , "contextTargets" .= getField @"contextTargets" flag
            , "rules" .= getField @"rules" flag
            , "fallthrough" .= getField @"fallthrough" flag
            , "offVariation" .= getField @"offVariation" flag
            , "variations" .= getField @"variations" flag
            , "debugEventsUntilDate" .= getField @"debugEventsUntilDate" flag
            , "clientSide" .= (getField @"usingEnvironmentId" $ getField @"clientSideAvailability" flag)
            ]
                <> case getField @"explicit" $ getField @"clientSideAvailability" flag of
                    True -> ["clientSideAvailability" .= getField @"clientSideAvailability" flag]
                    False -> []

instance FromJSON Flag where
    parseJSON = withObject "Flag" $ \obj -> do
        key <- obj .: "key"
        version <- obj .: "version"
        on <- obj .: "on"
        trackEvents <- obj .: "trackEvents"
        trackEventsFallthrough <- obj .: "trackEventsFallthrough"
        deleted <- obj .: "deleted"
        prerequisites <- obj .: "prerequisites"
        salt <- obj .: "salt"
        targets <- obj .: "targets"
        contextTargets <- obj .:? "contextTargets" .!= mempty
        rules <- obj .: "rules"
        fallthrough <- obj .: "fallthrough"
        offVariation <- obj .:? "offVariation"
        variations <- obj .: "variations"
        debugEventsUntilDate <- obj .:? "debugEventsUntilDate"
        clientSide <- obj .:? "clientSide" .!= False
        clientSideAvailability <- obj .:? "clientSideAvailability" .!= ClientSideAvailability clientSide True False
        pure Flag {..}

isClientSideOnlyFlag :: Flag -> Bool
isClientSideOnlyFlag flag = getField @"usingEnvironmentId" $ getField @"clientSideAvailability" flag

-- If the reason for the flag is in an experiment,
-- or if it's a fallthrough reason and the flag has trackEventsFallthrough
-- or if it's a rule match and the rule that matched has track events turned on
-- otherwise false
isInExperiment :: Flag -> EvaluationReason -> Bool
isInExperiment _ reason
    | D.isInExperiment reason = True
isInExperiment flag EvaluationReasonFallthrough {} = getField @"trackEventsFallthrough" flag
isInExperiment flag (EvaluationReasonRuleMatch ruleIndex _ _) =
    let index = fromIntegral ruleIndex
        rules = getField @"rules" flag
        rule = rules ^? element index
     in fromMaybe False $ fmap (getField @"trackEvents") rule
isInExperiment _ _ = False

data Prerequisite = Prerequisite
    { key :: !Text
    , variation :: !Integer
    }
    deriving (Generic, FromJSON, ToJSON, Show, Eq)

data SegmentRule = SegmentRule
    { id :: !Text
    , clauses :: ![Clause]
    , weight :: !(Maybe Float)
    , bucketBy :: !(Maybe Text)
    , rolloutContextKind :: !(Maybe Text)
    }
    deriving (Generic, ToJSON, Show, Eq)

instance FromJSON SegmentRule where
    parseJSON = withObject "SegmentRule" $ \o -> do
        id <- o .: "id"
        clauses <- o .: "clauses"
        weight <- o .:? "weight"
        bucketBy <- o .:? "bucketBy"
        rolloutContextKind <- o .:? "rolloutContextKind"
        return $ SegmentRule {..}

data Segment = Segment
    { key :: !Text
    , included :: !(HashSet Text)
    , includedContexts :: ![SegmentTarget]
    , excluded :: !(HashSet Text)
    , excludedContexts :: ![SegmentTarget]
    , salt :: !Text
    , rules :: ![SegmentRule]
    , version :: !Natural
    , deleted :: !Bool
    }
    deriving (Generic, FromJSON, ToJSON, Show, Eq)

data SegmentTarget = SegmentTarget
    { values :: !(HashSet Text)
    , contextKind :: !Text
    }
    deriving (Generic, FromJSON, ToJSON, Show, Eq)

data Clause = Clause
    { attribute :: !Reference
    , contextKind :: !Text
    , negate :: !Bool
    , op :: !Op
    , values :: ![Value]
    }
    deriving (Generic, ToJSON, Show, Eq)

instance FromJSON Clause where
    parseJSON = withObject "Clause" $ \o -> do
        attr <- o .: "attribute"
        kind <- o .:? "contextKind"
        negate <- o .: "negate"
        op <- o .: "op"
        values <- o .: "values"

        let contextKind = fromMaybe "user" kind
            attribute = case kind of Nothing -> makeLiteral (attr); _ -> makeReference (attr)
        return $ Clause {..}