{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- |

Highly unstable implementation of the Fastly API. Contributions are welcome.

'purge', 'purgeKey', and 'purgeAll' are reasonably well tested.

-}
module Network.Fastly
    ( FastlyAuth(..)
    , Username(..)
    , Password(..)
    , FastlyClient
    , fastlyClient
    , fastly
    , FastlyResponse(..)
      -- Account
    {-
    -}
      -- Configuration
    {-
    , listBackends
    , getBackend
    , createBackend
    , updateBackend
    , deleteBackend
    -}
    {-
    , listCacheSettings
    , getCacheSettings
    , createCacheSettings
    , updateCacheSettings
    , deleteCacheSettings
    -}
    {-
    , listConditions
    , getCondition
    , createCondition
    , updateCondition
    , deleteCondition
    -}
    -- Dictionaries
    , listDictionaries
    , getDictionary
    , createDictionary
    , updateDictionary
    , deleteDictionary
    -- Dictionary items
    , listDictionaryItems
    , getDictionaryItem
    , createDictionaryItem
    , upsertDictionaryItem
    , updateDictionaryItem
    , batchEditDictionaryItems
    , deleteDictionaryItem
    {-
    , getDiff
    -}
    {-
    , listDirectors
    , getDirector
    , createDirector
    , updateDirector
    , deleteDirector
    -}
    {-
    , getDirectorBackendRelationship
    , establishDirectorBackendRelationship
    , deleteDirectorBackendRelationship
    -}
    , checkDomainRecords
    , checkDomainRecord
    , listDomains
    , getDomain
    , createDomain
    {-
    , updateDomain
    , deleteDomain
    -}
    , listGzipConfigurations
    , getGzipConfiguration
    {-
    , createGzipConfiguration
    , updateGzipConfiguration
    -}
    , deleteGzipConfiguration
    {-
    , listHeaders
    , getHeader
    , createHeader
    , updateHeader
    , deleteHeader
    -}
    {-
    , listHealthchecks
    , getHealthcheck
    , createHealthcheck
    , updateHealthcheck
    , deleteHealthcheck
    -}
    {-
    , getRequestSettingsObject
    , listRequestSettingsObjects
    , createRequestSettingsObject
    , deleteRequestSettingsObject
    , updateRequestSettingsObject
    -}
    {-
    , getResponseObject
    , listResponseObjects
    , createResponseObject
    , deleteResponseObject
    , updateResponseObject
    -}
    {-
    -}
    , listServices
    , getServiceDetails
    , getServiceByName
    , getService
    , ServiceId(..)
    , Service(..)
    {-
    , createService
    , deleteService
    , updateService
    , listServiceDomains
    -}
    {-
    , getServiceSettings
    , updateServiceSettings
    -}
    {-
    , getServiceStats
    -}
    {-
    , getVcls
    , getBoilerplateVcl
    , getVcl
    , getSyntaxHighlightedVcl
    , downloadVcl -- ????
    , getGeneratedVcl
    , getSyntaxHighlightedGeneratedVcl
    , uploadVcl
    , deleteVcl
    , setMainVcl
    , updateVcl
    -}
    {-
    , getServiceVersion
    , createServiceVersion
    , listServiceVersions
    , updateServiceVersion
    , activateServiceVersion
    , deactivateServiceVersion
    , cloneServiceVersion
    , validateServiceVersion
    , lockServiceVersion
    -}
    {-
    , getWordpressConfiguration
    , listWordpressConfigurations
    , createWordpressConfiguration
    , deleteWordpressConfiguration
    , updateWordpressConfiguration
    -}
      -- Purging
    , PurgeMode(..)
    , SurrogateKey(..)
    , purge
    , purgeKey
    , purgeAll
    , PurgeResult(..)
    , PurgeAllResult(..)
      -- Historical Stats

      -- Remote Logging

      -- Miscellaneous
    , edgeCheck
    , CacheStatus(..)
    , CacheStatusRequest(..)
    , CacheStatusResponse(..)
    , publicIpList
    , Addresses(..)
    ) where
import Control.Applicative
import Control.Exception
import Control.Monad.Except
import Data.Aeson
import Data.Aeson.Types
import Data.IP
import Data.Monoid
import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lex.Integral (readDecimal_)
import Data.Text (Text, pack, unpack)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Thyme.Clock (UTCTime)
import Data.Thyme.Format
import Data.HashMap.Strict (HashMap)
import GHC.Generics
import Network.HTTP.Client as C
import qualified Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Types
import System.IO.Unsafe
import System.Locale

data FastlyResponse a = FastlyResponse
                        { fastlyResponseRateLimitRemaining :: Int
                        , fastlyResponseRateLimitReset     :: Int -- ^ UTC epoch seconds
                        , fastlyResponseValue              :: a
                        } deriving (Show)

data FastlyClient = FastlyClient
  { fastlyClientBaseRequest   :: Request
  }

data FastlyError = InvalidOrMissingRateLimitData
                 | JsonError String (Maybe Value)
                 | InvalidUrl String
                 deriving (Show, Eq)

instance Exception FastlyError

pedanticDecode :: (Monad m, FromJSON a) => Response ByteString -> m (Either FastlyError a)
pedanticDecode r = return $ case eitherDecode $ responseBody r of
  Right r -> Right r
  Left e -> case eitherDecode $ responseBody r of
    Left je -> Left $ JsonError je Nothing
    Right j -> Left $ JsonError e (Just j)

readFromResponse :: Response a -> (Response a -> Either FastlyError b) -> Either FastlyError (FastlyResponse b)
readFromResponse r f = do
  case details of
    Nothing -> Left InvalidOrMissingRateLimitData
    Just (rem, res) -> do
      x <- f r
      return $ FastlyResponse rem res x
  where
    hs = responseHeaders r
    details = do
      remBs <- lookup "Fastly-RateLimit-Remaining" hs
      resBs <- lookup "Fastly-RateLimit-Reset" hs
      return (readDecimal_ remBs, readDecimal_ resBs)

fastlyRootRequest :: Request
fastlyRootRequest = parseRequest_ "https://api.fastly.com/"

newtype Username = Username Text
newtype Password = Password Text

data FastlyAuth = AuthToken Text
                | Login Username Password

fastlyClient :: FastlyAuth -> IO FastlyClient
fastlyClient (AuthToken t) = do
  return $
    FastlyClient
      (fastlyRootRequest
       { requestHeaders =
           ("Fastly-Key", encodeUtf8 t) :
           ("Accept", "application/json") : requestHeaders fastlyRootRequest
       })
fastlyClient (Login (Username u) (Password p)) = do
  error "Login not supported yet"
  {-
  m <- newManager
  let req' = fastlyRootRequest { cookieJar = Just mempty
                               , path = "/login"
                               }
  let reqEditor r = case cookieJar r of
  resp <- httpNoBody req'' m
  reqRef <- newIORef $ fastlyRootRequest { cookieJar = responseCookieJar resp }
  return $ FastlyClient m reqRef
  -}

type FastlyM a = ExceptT FastlyError IO a

fastly :: Text -> (FastlyClient -> FastlyM a) -> IO (Either FastlyError a)
fastly t f = do
  c <- fastlyClient $ AuthToken t
  let (ExceptT m) = f c
  m


jsonOpts :: Int -> Options
jsonOpts x = defaultOptions { fieldLabelModifier = camelTo2 '_' . drop x }

get :: FromJSON a => FastlyClient -> (Request -> Request) -> FastlyM a
get c f = ExceptT $ do
  m <- getGlobalManager
  r <- httpLbs ((f $ fastlyClientBaseRequest c) { method = "GET" }) m
  pedanticDecode r

post :: FromJSON a => FastlyClient -> (Request -> Request) -> FastlyM a
post c f = ExceptT $ do
  m <- getGlobalManager
  r <- httpLbs ((f $ fastlyClientBaseRequest c) { method = "POST" }) m
  pedanticDecode r

put :: FromJSON a => FastlyClient -> (Request -> Request) -> FastlyM a
put c f = ExceptT $ do
  m <- getGlobalManager
  r <- httpLbs ((f $ fastlyClientBaseRequest c) { method = "PUT" }) m
  pedanticDecode r

delete :: FromJSON a => FastlyClient -> (Request -> Request) -> FastlyM a
delete c f = ExceptT $ do
  m <- getGlobalManager
  r <- httpLbs ((f $ fastlyClientBaseRequest c) { method = "DELETE" }) m
  pedanticDecode r

patch :: FromJSON a => FastlyClient -> (Request -> Request) -> FastlyM a
patch c f = ExceptT $ do
  m <- getGlobalManager
  r <- httpLbs ((f $ fastlyClientBaseRequest c) { method = "PATCH" }) m
  pedanticDecode r

newtype DictionaryId = DictionaryId Text
                     deriving (Show, ToJSON, FromJSON)

data Dictionary = Dictionary
                  { dictionaryCreatedAt :: Timestamp
                  , dictionaryDeletedAt :: Maybe Timestamp
                  , dictionaryId        :: DictionaryId
                  , dictionaryName      :: Text
                  , dictionaryServiceId :: ServiceId
                  , dictionaryUpdatedAt :: Maybe Timestamp
                  , dictionaryVersion   :: ServiceVersionNumber
                  } deriving (Show, Generic)

instance ToJSON Dictionary where
  toJSON = genericToJSON (jsonOpts 10)

instance FromJSON Dictionary where
  parseJSON = genericParseJSON (jsonOpts 10)

listDictionaries :: FastlyClient
                 -> ServiceId
                 -> ServiceVersionNumber
                 -> FastlyM [Dictionary]
listDictionaries c (ServiceId sid) (ServiceVersionNumber v) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 sid <> "/version/" <> BS.pack (show v) <> "/dictionary" }

getDictionary :: FastlyClient
              -> ServiceId
              -> ServiceVersionNumber
              -> Text -- ^ Dictionary name
              -> FastlyM Dictionary
getDictionary c (ServiceId sid) (ServiceVersionNumber v) d = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 sid <> "/version/" <> BS.pack (show v) <> "/dictionary/" <> urlEncode False (encodeUtf8 d) }

createDictionary :: FastlyClient
                 -> ServiceId
                 -> ServiceVersionNumber
                 -> Text -- ^ Dictionary name
                 -> FastlyM Dictionary
createDictionary c (ServiceId sid) (ServiceVersionNumber v) d = post c $ \r -> urlEncodedBody [("name", encodeUtf8 d)] $
  r { path = "/service/" <> encodeUtf8 sid <> "/version/" <> BS.pack (show v) <> "/dictionary"
    }

updateDictionary :: FastlyClient
                 -> ServiceId
                 -> ServiceVersionNumber
                 -> Text
                 -> Text
                 -> FastlyM Dictionary
updateDictionary c (ServiceId sid) (ServiceVersionNumber v) dOld dNew = put c $ \r -> urlEncodedBody [("name", encodeUtf8 dNew)] $
  r { path = "/service/" <> encodeUtf8 sid <> "/version/" <> BS.pack (show v) <> "/dictionary/" <> urlEncode False (encodeUtf8 dOld) }


data DeleteDictionaryResult = DeleteDictionaryResult
                              { deleteDictionaryResultStatus :: Text
                              } deriving (Show, Generic)

instance ToJSON DeleteDictionaryResult where
  toJSON = genericToJSON (jsonOpts 22)

instance FromJSON DeleteDictionaryResult where
  parseJSON = genericParseJSON (jsonOpts 22)

deleteDictionary :: FastlyClient
                 -> ServiceId
                 -> ServiceVersionNumber
                 -> Text -- ^ Dictionary name
                 -> FastlyM Dictionary
deleteDictionary c (ServiceId sid) (ServiceVersionNumber v) d = delete c $ \r ->
  r { path = "/service/" <> encodeUtf8 sid <> "/version/" <> BS.pack (show v) <> "/dictionary/" <> urlEncode False (encodeUtf8 d) }

data DictionaryItem = DictionaryItem
                      { dictionaryItemDictionaryId :: DictionaryId
                      , dictionaryItemServiceId    :: ServiceId
                      , dictionaryItemItemKey      :: Text
                      , dictionaryItemItemValue    :: Text
                      , dictionaryItemCreatedAt    :: Timestamp
                      , dictionaryItemUpdatedAt    :: Timestamp
                      , dictionaryItemDeletedAt    :: Maybe Timestamp
                      } deriving (Show, Generic)

instance ToJSON DictionaryItem where
  toJSON = genericToJSON (jsonOpts 14)

instance FromJSON DictionaryItem where
  parseJSON = genericParseJSON (jsonOpts 14)

listDictionaryItems :: FastlyClient
                    -> ServiceId
                    -> DictionaryId
                    -> FastlyM [DictionaryItem]
listDictionaryItems c (ServiceId s) (DictionaryId d) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/items" }

getDictionaryItem :: FastlyClient
                  -> ServiceId
                  -> DictionaryId
                  -> Text -- ^ Key
                  -> FastlyM DictionaryItem
getDictionaryItem c (ServiceId s) (DictionaryId d) k = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/item/" <> urlEncode False (encodeUtf8 k)}

createDictionaryItem :: FastlyClient
                     -> ServiceId
                     -> DictionaryId
                     -> Text -- ^ Key
                     -> Text -- ^ Value
                     -> FastlyM DictionaryItem
createDictionaryItem c (ServiceId s) (DictionaryId d) k v = post c $ \r -> urlEncodedBody [("item_key", encodeUtf8 k), ("item_value", encodeUtf8 v)] $
  r { requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : requestHeaders r
    , path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/item"
    }

upsertDictionaryItem :: FastlyClient
                     -> ServiceId
                     -> DictionaryId
                     -> Text -- ^ Key
                     -> Text -- ^ Value
                     -> FastlyM DictionaryItem
upsertDictionaryItem c (ServiceId s) (DictionaryId d) k v = put c $ \r -> urlEncodedBody [("item_value", encodeUtf8 v)] $
  r { requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : requestHeaders r
    , path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/item/" <> urlEncode False (encodeUtf8 k)
    }

updateDictionaryItem :: FastlyClient
                     -> ServiceId
                     -> DictionaryId
                     -> Text -- ^ Key
                     -> Text -- ^ Value
                     -> FastlyM DictionaryItem
updateDictionaryItem c (ServiceId s) (DictionaryId d) k v = put c $ \r -> urlEncodedBody [("item_value", encodeUtf8 v)] $
  r { requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : requestHeaders r
    , path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/item/" <> urlEncode False (encodeUtf8 k)
    }

data DictionaryItemOp = CreateItem { dictionaryOpKey :: Text, dictionaryOpValue :: Text }
                      | UpdateItem { dictionaryOpKey :: Text, dictionaryOpValue :: Text }
                      | UpsertItem { dictionaryOpKey :: Text, dictionaryOpValue :: Text }
                      | DeleteItem { dictionaryOpKey :: Text }

instance ToJSON DictionaryItemOp where
  toJSON (CreateItem k v) = object [ "op" .= String "create"
                                   , "item_key" .= k
                                   , "item_value" .= v
                                   ]
  toJSON (UpdateItem k v) = object [ "op" .= String "update"
                                   , "item_key" .= k
                                   , "item_value" .= v
                                   ]
  toJSON (UpsertItem k v) = object [ "op" .= String "upsert"
                                   , "item_key" .= k
                                   , "item_value" .= v
                                   ]
  toJSON (DeleteItem k)   = object [ "op" .= String "delete"
                                   , "item_key" .= k
                                   ]

data BatchEditResult = BatchEditResult
                       { batchEditResultStatus :: Text
                       } deriving (Show, Generic)

instance ToJSON BatchEditResult where
  toJSON = genericToJSON (jsonOpts 15)

instance FromJSON BatchEditResult where
  parseJSON = genericParseJSON (jsonOpts 15)

batchEditDictionaryItems :: FastlyClient
                         -> ServiceId
                         -> DictionaryId
                         -> [DictionaryItemOp]
                         -> FastlyM BatchEditResult
batchEditDictionaryItems c (ServiceId s) (DictionaryId d) ops = patch c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/items"
    , requestBody = RequestBodyLBS $ encode $ object [ "items" .= ops ]
    }

data DeleteDictionaryItemResult = DeleteDictionaryItemResult
                              { deleteDictionaryItemResultStatus :: Text
                              } deriving (Show, Generic)

instance ToJSON DeleteDictionaryItemResult where
  toJSON = genericToJSON (jsonOpts 26)

instance FromJSON DeleteDictionaryItemResult where
  parseJSON = genericParseJSON (jsonOpts 26)

deleteDictionaryItem :: FastlyClient
                     -> ServiceId
                     -> DictionaryId
                     -> Text -- ^ Key
                     -> FastlyM DeleteDictionaryItemResult
deleteDictionaryItem c (ServiceId s) (DictionaryId d) k = delete c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/dictionary/" <> encodeUtf8 d <> "/item/" <> urlEncode False (encodeUtf8 k) }

data Domain = Domain
  { domainComment   :: Text
  , domainLocked    :: Bool
  , domainName      :: Text
  , domainServiceId :: ServiceId
  , domainVersion   :: ServiceVersionNumber
  , domainUpdatedAt :: Maybe Timestamp
  , domainDeletedAt :: Maybe Timestamp
  , domainCreatedAt :: Maybe Timestamp
  } deriving (Show, Generic)

instance ToJSON Domain where
  toJSON = genericToJSON (jsonOpts 6)

instance FromJSON Domain where
  parseJSON = genericParseJSON (jsonOpts 6)

checkDomainRecords
  :: FastlyClient
  -> ServiceId
  -> ServiceVersionNumber
  -> FastlyM [(Domain, Text, Bool)]
checkDomainRecords c (ServiceId s) (ServiceVersionNumber v) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/domain/check_all" }

checkDomainRecord
  :: FastlyClient
  -> ServiceId
  -> ServiceVersionNumber
  -> Text
  -> FastlyM (Domain, Text, Bool)
checkDomainRecord c (ServiceId s) (ServiceVersionNumber v) n = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/domain/" <> urlEncode False (encodeUtf8 n) <> "/check" }

listDomains
  :: FastlyClient
  -> ServiceId
  -> ServiceVersionNumber
  -> FastlyM [Domain]
listDomains c (ServiceId s) (ServiceVersionNumber v) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/domain" }

getDomain
  :: FastlyClient
  -> ServiceId
  -> ServiceVersionNumber
  -> Text
  -> FastlyM Domain
getDomain c (ServiceId s) (ServiceVersionNumber v) n = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/domain/" <> urlEncode False (encodeUtf8 n) }

createDomain
  :: FastlyClient
  -> ServiceId
  -> ServiceVersionNumber
  -> Text -- ^ Domain name
  -> FastlyM Domain
createDomain c (ServiceId s) (ServiceVersionNumber v) n = post c $ \r -> urlEncodedBody [("name", encodeUtf8 n)] $
  r { requestHeaders = ("Content-Type", "application/x-www-form-urlencoded") : requestHeaders r
    , path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/domain"
    }



toJsonSpaceList :: [Text] -> Value
toJsonSpaceList = String . T.intercalate " "

fromJsonSpaceList :: Monad m => Value -> m [Text]
fromJsonSpaceList (String ts) = return $ T.splitOn " " ts
fromJsonSpaceList wat = fail "Expected a String, got something else for JSON space-delimited list"

newtype ContentTypes = ContentTypes [Text]
                     deriving (Show)

instance ToJSON ContentTypes where
  toJSON (ContentTypes ts) = toJsonSpaceList ts

instance FromJSON ContentTypes where
  parseJSON ts = ContentTypes <$> fromJsonSpaceList ts

newtype Extensions = Extensions [Text]
                   deriving (Show)

instance ToJSON Extensions where
  toJSON (Extensions ts) = toJsonSpaceList ts

instance FromJSON Extensions where
  parseJSON ts = Extensions <$> fromJsonSpaceList ts

data GzipConfiguration = GzipConfiguration
                         { gzipConfigurationCacheCondition :: Text
                         , gzipConfigurationContentTypes   :: ContentTypes
                         , gzipConfigurationExtensions     :: Extensions
                         , gzipConfigurationName           :: Text
                         , gzipConfigurationServiceId      :: ServiceId
                         , gzipConfigurationVersion        :: ServiceVersionNumber
                         } deriving (Show, Generic)

instance ToJSON GzipConfiguration where
  toJSON = genericToJSON (jsonOpts 17)

instance FromJSON GzipConfiguration where
  parseJSON = genericParseJSON (jsonOpts 17)

listGzipConfigurations :: FastlyClient
                       -> ServiceId
                       -> ServiceVersionNumber
                       -> FastlyM [GzipConfiguration]
listGzipConfigurations c (ServiceId s) (ServiceVersionNumber v) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/gzip" }

getGzipConfiguration :: FastlyClient
                     -> ServiceId
                     -> ServiceVersionNumber
                     -> Text -- ^ Configuration name
                     -> FastlyM GzipConfiguration
getGzipConfiguration c (ServiceId s) (ServiceVersionNumber v) n = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/gzip/" <> urlEncode False (encodeUtf8 n) }

data DeleteGzipConfigurationResult = DeleteGzipConfigurationResult
                                     { deleteGzipConfigurationResultStatus :: Text
                                     } deriving (Show, Generic)

instance ToJSON DeleteGzipConfigurationResult where
  toJSON = genericToJSON (jsonOpts 29)

instance FromJSON DeleteGzipConfigurationResult where
  parseJSON = genericParseJSON (jsonOpts 29)

deleteGzipConfiguration :: FastlyClient
                        -> ServiceId
                        -> ServiceVersionNumber
                        -> Text -- ^ Configuration name
                        -> FastlyM DeleteGzipConfigurationResult
deleteGzipConfiguration c (ServiceId s) (ServiceVersionNumber v) n = delete c $ \r ->
  r { path = "/service/" <> encodeUtf8 s <> "/version/" <> BS.pack (show v) <> "/gzip/" <> urlEncode False (encodeUtf8 n) }


data HeaderAction = SetHeader
                  | AppendHeader
                  | DeleteHeader
                  | RegexHeader
                  | RegexRepeatHeader

data HeaderType = Request
                | Fetch
                | Cache
                | Response

data Header = Header
              { headerAction            :: HeaderAction
              , headerCacheCondition    :: Maybe Text
              , headerDst               :: Text
              , headerIgnoreIfSet       :: Int -- ^ TODO it's actually a bool, except for JSON format
              , headerName              :: Text
              , headerPriority          :: Int
              , headerRegex             :: Text
              , headerRequestCondition  :: Text
              , headerResponseCondition :: Text
              , headerServiceId         :: ServiceId
              , headerSrc               :: Text
              , headerSubstitution      :: Text
              , headerType              :: HeaderType
              , headerVersion           :: ServiceVersionNumber
              }





newtype ServiceVersionNumber = ServiceVersionNumber Int
                       deriving (Show, ToJSON)

instance FromJSON ServiceVersionNumber where
  parseJSON (String str) = return $ ServiceVersionNumber $ read $ unpack str
  parseJSON num@(Number n) = fmap ServiceVersionNumber $ parseJSON num
  parseJSON wat = typeMismatch "ServiceVersion" wat

newtype ServiceId = ServiceId Text
                  deriving (Show, ToJSON, FromJSON)

newtype CustomerId = CustomerId Text
                   deriving (Show, ToJSON, FromJSON)

newtype Timestamp = Timestamp { fromTimestamp :: UTCTime }
                    deriving (Show)

instance ToJSON Timestamp where
  toJSON (Timestamp t) = String $ pack $ formatTime defaultTimeLocale "%Y-%M-%dT%H:%M:%S" t

instance FromJSON Timestamp where
  parseJSON (String s) = let ts = unpack s in
    case parseTime defaultTimeLocale "%Y-%M-%dT%H:%M:%S" ts <|>
         parseTime defaultTimeLocale "%Y-%M-%dT%H:%M:%S%z" ts <|>
         parseTime defaultTimeLocale "%Y-%M-%dT%H:%M:%SZ" ts of
      Nothing -> fail "Invalid time parse"
      Just t -> return $ Timestamp t
  parseJSON wat = typeMismatch "Timestamp" wat

newtype Boolean = Boolean Bool
                deriving (Show)

instance ToJSON Boolean where
  toJSON (Boolean b) = String $ if b then "1" else "0"

instance FromJSON Boolean where
  parseJSON (String s) = case s of
    "0" -> return $ Boolean False
    "1" -> return $ Boolean True
  parseJSON (Bool b) = return $ Boolean b

data ServiceBasicVersion = ServiceBasicVersion
                           { serviceBasicVersionDeployed         :: Value
                           , serviceBasicVersionLocked           :: Maybe Boolean
                           , serviceBasicVersionTesting          :: Maybe Boolean
                           , serviceBasicVersionActive           :: Value
                           , serviceBasicVersionUpdatedAt        :: Maybe Timestamp
                           , serviceBasicVersionDeletedAt        :: Maybe Timestamp
                           , serviceBasicVersionServiceId        :: ServiceId
                           , serviceBasicVersionInheritServiceId :: Maybe ServiceId
                           , serviceBasicVersionCreatedAt        :: Maybe Timestamp
                           , serviceBasicVersionNumber           :: ServiceVersionNumber
                           , serviceBasicVersionComment          :: Text
                           , serviceBasicVersionStaging          :: Value
                           } deriving (Show, Generic)

instance ToJSON ServiceBasicVersion where
  toJSON = genericToJSON (jsonOpts 19)

instance FromJSON ServiceBasicVersion where
  parseJSON = genericParseJSON (jsonOpts 19)

data ServiceVersion = ServiceVersion
                      { serviceVersionBackends        :: [Object]
                      , serviceVersionGzips           :: [Object]
                      , serviceVersionDeployed        :: Value
                      , serviceVersionVcls            :: [Value]
                      , serviceVersionLocked          :: Maybe Boolean
                      , serviceVersionSettings        :: Object
                      , serviceVersionMatches         :: [Value]
                      , serviceVersionTesting         :: Value
                      , serviceVersionActive          :: Value
                      , serviceVersionHeaders         :: [Object]
                      , serviceVersionServiceId       :: ServiceId
                      , serviceVersionResponseObjects :: [Object]
                      , serviceVersionConditions      :: [Object]
                      , serviceVersionNumber          :: ServiceVersionNumber
                      , serviceVersionDomains         :: [Object]
                      , serviceVersionRequestSettings :: [Object]
                      , serviceVersionComment         :: Text
                      , serviceVersionDirectors       :: [Object]
                      , serviceVersionCacheSettings   :: [Object]
                      , serviceVersionHealthchecks    :: [Object]
                      , serviceVersionStaging         :: Value
                      , serviceVersionWordpress       :: [Object]
                      } deriving (Show, Generic)

instance ToJSON ServiceVersion where
  toJSON = genericToJSON (jsonOpts 14)

instance FromJSON ServiceVersion where
  parseJSON = genericParseJSON (jsonOpts 14)

data Service = Service
               { serviceId            :: ServiceId
               , serviceName          :: Text
               , serviceCustomerId    :: CustomerId
               , serviceComment       :: Text
               , serviceActiveVersion :: Maybe ServiceVersion
               , serviceVersion       :: Maybe ServiceVersion
               , serviceVersions      :: [ServiceBasicVersion]
               } deriving (Show, Generic)

instance ToJSON Service where
  toJSON = genericToJSON (jsonOpts 7)

instance FromJSON Service where
  parseJSON = genericParseJSON (jsonOpts 7)

data ServiceListItem = ServiceListItem
                       { serviceListItemCustomerId :: CustomerId
                       , serviceListItemVersions   :: [ServiceBasicVersion]
                       , serviceListItemVersion    :: ServiceVersionNumber
                       , serviceListItemName       :: Text
                       , serviceListItemId         :: ServiceId
                       , serviceListItemComment    :: Text
                       } deriving (Show, Generic)

instance ToJSON ServiceListItem where
  toJSON = genericToJSON (jsonOpts 15)

instance FromJSON ServiceListItem where
  parseJSON = genericParseJSON (jsonOpts 15)

listServices :: FastlyClient
             -> FastlyM [ServiceListItem]
listServices c = get c $ \r ->
  r { path = "/service" }

getService :: FastlyClient
           -> ServiceId
           -> FastlyM Service
getService c (ServiceId sid) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 sid }

getServiceDetails :: FastlyClient
           -> ServiceId
           -> FastlyM Service
getServiceDetails c (ServiceId sid) = get c $ \r ->
  r { path = "/service/" <> encodeUtf8 sid <> "/details" }

getServiceByName :: FastlyClient
                 -> Text
                 -> FastlyM (Maybe Service)
getServiceByName c name = get c $ \r -> setQueryString [("name", Just $ encodeUtf8 name)] $
  r { path = "/service/search"
    }



data PurgeMode = Instant
               | Soft

data PurgeResult = PurgeResult
  { purgeResultStatus :: Text
  , purgeResultId     :: Text
  } deriving (Show, Generic)

instance ToJSON PurgeResult where
  toJSON = genericToJSON (jsonOpts 11)

instance FromJSON PurgeResult where
  parseJSON = genericParseJSON (jsonOpts 11)

purge :: FastlyClient
      -> PurgeMode
      -> String -- ^ URL
      -> FastlyM PurgeResult
purge c mode url = ExceptT $ do
  m <- getGlobalManager
  case parseRequest url of
    Left str -> return $ Left $ InvalidUrl $ show str
    Right req -> do
      let f r = case mode of
            Instant -> r
            Soft -> (r { requestHeaders = ("Fastly-Soft-Purge", "1") : requestHeaders r})
      r <- httpLbs ((f req) { method = "PURGE" }) m
      return $ case eitherDecode $ responseBody r of
        Left e -> Left $ JsonError e Nothing
        Right j -> case fromJSON j of
          Error s -> Left $ JsonError s (Just j)
          Success r -> Right r

newtype SurrogateKey = SurrogateKey Text

purgeKey :: FastlyClient
         -> PurgeMode
         -> ServiceId
         -> SurrogateKey
         -> FastlyM PurgeResult
purgeKey c mode (ServiceId sid) (SurrogateKey skey) = ExceptT $ do
  m <- getGlobalManager
  let baseReq = fastlyClientBaseRequest c
      req = baseReq { method = "POST"
                    , path = "/service/" <> encodeUtf8 sid <> "/purge/" <> encodeUtf8 skey
                    , requestHeaders = case mode of
                        Instant -> requestHeaders baseReq
                        Soft -> ("Fastly-Soft-Purge", "1") : requestHeaders baseReq
                    }
  r <- httpLbs req m
  pedanticDecode r

data PurgeAllResult = PurgeAllResult
                      { purgeAllResultStatus :: Text
                      } deriving (Show, Generic)

instance ToJSON PurgeAllResult where
  toJSON = genericToJSON (jsonOpts 14)

instance FromJSON PurgeAllResult where
  parseJSON = genericParseJSON (jsonOpts 14)

purgeAll :: FastlyClient
         -> ServiceId
         -> FastlyM PurgeAllResult
purgeAll c (ServiceId sid) = ExceptT $ do
  m <- getGlobalManager
  let req = (fastlyClientBaseRequest c) { method = "POST"
                                        , path = "/service/" <> encodeUtf8 sid <> "/purge_all"
                                        }
  r <- httpLbs req m
  pedanticDecode r









data CacheStatus = CacheStatus
  { cacheStatusHash         :: Text
  , cacheStatusResponse     :: CacheStatusResponse
  , cacheStatusResponseTime :: Double
  , cacheStatusServer       :: Text
  , cacheStatusRequest      :: CacheStatusRequest
  } deriving (Show, Generic)

instance ToJSON CacheStatus where
  toJSON = genericToJSON (jsonOpts 11)

instance FromJSON CacheStatus where
  parseJSON = genericParseJSON (jsonOpts 11)

data CacheStatusRequest = CacheStatusRequest
  { cacheStatusRequestUrl     :: Maybe Text
  , cacheStatusRequestHeaders :: HashMap Text Text
  , cacheStatusRequestMethod  :: Maybe Text
  } deriving (Show, Generic)

instance ToJSON CacheStatusRequest where
  toJSON = genericToJSON (jsonOpts 18)

instance FromJSON CacheStatusRequest where
  parseJSON = genericParseJSON (jsonOpts 18)

data CacheStatusResponse = CacheStatusResponse
  { cacheStatusResponseStatus :: Int
  , cacheStatusResponseHeaders :: HashMap Text Text
  } deriving (Show, Generic)

instance ToJSON CacheStatusResponse where
  toJSON = genericToJSON (jsonOpts 19)

instance FromJSON CacheStatusResponse where
  parseJSON = genericParseJSON (jsonOpts 19)

edgeCheck :: FastlyClient -> Text -> FastlyM [CacheStatus]
edgeCheck c t = get c (p . setQueryString [("url", Just $ encodeUtf8 t)])
  where
    p r = r { path = "/content/edge_check" }

data Addresses = Addresses
                 { addresses :: [IPRange]
                 } deriving (Show)

instance FromJSON Addresses where
  parseJSON (Object o) = do
    r <- o .: "addresses"
    return $ Addresses $ map read r


publicIpList :: FastlyM Addresses
publicIpList = ExceptT $ do
  m <- getGlobalManager
  r <- httpLbs req m
  pedanticDecode r
  where
    (Just req) = C.parseRequest "https://api.fastly.com/public-ip-list"