{-|
Module      : CircleCI.CheckoutKey
Copyright   : (c) Denis Shevchenko, 2016
License     : MIT
Maintainer  : me@dshevchenko.biz
Stability   : alpha

API calls for work with Checkout Keys. CircleCI uses Checkout Keys to check out your GitHub project, submodules, and private dependencies.

For more info please see "Checkout SSH keys" section in your CircleCI project's Settings.
-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}

module CircleCI.CheckoutKey (
    -- * API calls
      getCheckoutKeys
    , getCheckoutKey
    , createCheckoutKey
    , deleteCheckoutKey
    -- * Types for calls and responses
    , Fingerprint (..)
    , CheckoutKeyInfo (..)
    , CheckoutKeyType (..)
    , CheckoutKeyDeleted (..)
    , module CircleCI.Common.Types
    , module CircleCI.Common.Run
) where

import           CircleCI.Common.URL
import           CircleCI.Common.Types
import           CircleCI.Common.HTTPS
import           CircleCI.Common.Run

import           Control.Monad                  ( mzero )
import           Control.Monad.Except           ( runExceptT )
import           Control.Monad.Reader           ( ask )
import           Control.Monad.IO.Class         ( liftIO )
import           Data.Aeson
import           Data.Aeson.Types
import qualified Data.Proxy                     as P
import           Data.Text                      ( Text )
import           Data.Time.Clock                ( UTCTime )
import           Network.HTTP.Client            ( Manager )

import           Servant.API
import           Servant.Client

-- | Shows list of checkout keys. Based on https://circleci.com/docs/api/#list-checkout-keys.
--
-- Usage example:
--
-- @
-- {-\# LANGUAGE OverloadedStrings \#-}
-- {-\# LANGUAGE LambdaCase \#-}
--
-- import CircleCI
--
-- main :: IO ()
-- main = runCircleCI (getCheckoutKeys $ ProjectPoint "denisshevchenko" "circlehs")
--                    (AccountAPIToken "e64c674195bbc0d0be3ef9679b6c6ba2whatever")
--     >>= \\case
--         Left problem   -> print problem
--         Right keysList -> print keysList
-- @
getCheckoutKeys :: ProjectPoint    -- ^ Names of GitHub user/project.
                -> CircleCIResponse [CheckoutKeyInfo] -- ^ List of checkout keys.
getCheckoutKeys project = do
    AccountAPIToken token <- ask
    liftIO . runExceptT $ do
        manager <- httpsManager
        servantGetCheckoutKeys (userName project)
                               (projectName project)
                               (Just token)
                               manager
                               apiBaseUrl

-- | Shows single checkout key. Based on https://circleci.com/docs/api/#get-checkout-key.
getCheckoutKey :: ProjectPoint     -- ^ Names of GitHub user/project.
               -> Fingerprint      -- ^ Key fingerprint.
               -> CircleCIResponse CheckoutKeyInfo  -- ^ Checkout key info.
getCheckoutKey project (Fingerprint aFingerprint) = do
    AccountAPIToken token <- ask
    liftIO . runExceptT $ do
        manager <- httpsManager
        servantGetCheckoutKey (userName project)
                              (projectName project)
                              aFingerprint
                              (Just token)
                              manager
                              apiBaseUrl

-- | Creates checkout key. Based on https://circleci.com/docs/api/#new-checkout-key.
createCheckoutKey :: ProjectPoint    -- ^ Names of GitHub user/project.
                  -> CircleCIResponse CheckoutKeyInfo -- ^ New checkout key info.
createCheckoutKey project = do
    AccountAPIToken token <- ask
    liftIO . runExceptT $ do
        manager <- httpsManager
        servantCreateCheckoutKey (userName project)
                                 (projectName project)
                                 (Just token)
                                 manager
                                 apiBaseUrl

-- | Deletes single checkout key. Based on https://circleci.com/docs/api/#delete-checkout-key.
deleteCheckoutKey :: ProjectPoint    -- ^ Names of GitHub user/project.
                  -> Fingerprint     -- ^ Key fingerprint.
                  -> CircleCIResponse CheckoutKeyDeleted  -- ^ Status of checkout key deletion.
deleteCheckoutKey project (Fingerprint aFingerprint) = do
    AccountAPIToken token <- ask
    liftIO . runExceptT $ do
        manager <- httpsManager
        servantDeleteCheckoutKey (userName project)
                                 (projectName project)
                                 aFingerprint
                                 (Just token)
                                 manager
                                 apiBaseUrl

-- | Key fingerprint. For example, @"79:23:05:6a:6d:4c:cc:5c:0e:64:79:49:f0:e9:8d:a0"@.
newtype Fingerprint = Fingerprint Text deriving (Eq, Show)

-- | Type of checkout key.
data CheckoutKeyType = GitHubDeployKey  -- ^ Repo-specific SSH key.
                     | GitHubUserKey    -- ^ User-specific SSH key.
                     deriving (Eq, Show)

-- | Info about checkout key.
data CheckoutKeyInfo = CheckoutKeyInfo {
      publicKey   :: Text            -- ^ Public SSH key.
    , keyType     :: CheckoutKeyType -- ^ Key type.
    , fingerprint :: Fingerprint     -- ^ Key fingerprint.
    , preferred   :: Bool            -- ^ Preferred key or not.
    , issueDate   :: UTCTime         -- ^ Date when this key was issued.
    } deriving (Eq, Show)

-- How to create CheckoutKeyInfo from JSON.
instance FromJSON CheckoutKeyInfo where
    parseJSON (Object o) = CheckoutKeyInfo
        <$>  o .: "public_key"
        <*> (o .: "type" >>= toCheckoutKeyType)
        <*> (o .: "fingerprint" >>= toFingerprint)
        <*>  o .: "preferred"
        <*>  o .: "time"
    parseJSON _ = mzero

toCheckoutKeyType :: Text -> Parser CheckoutKeyType
toCheckoutKeyType "deploy-key"      = return GitHubDeployKey
toCheckoutKeyType "github-user-key" = return GitHubUserKey
toCheckoutKeyType _                 = return GitHubDeployKey

toFingerprint :: Text -> Parser Fingerprint
toFingerprint = return . Fingerprint

-- | Checkout key deleting status.
data CheckoutKeyDeleted = KeySuccessfullyDeleted
                        | UnableToDeleteKey ErrorMessage
                        deriving (Show)

-- How to create CheckoutKeyDeleted from JSON.
instance FromJSON CheckoutKeyDeleted where
    parseJSON (Object o) =
        o .: "message" >>= toCheckoutKeyDeleted
    parseJSON _ = mzero

toCheckoutKeyDeleted :: Text -> Parser CheckoutKeyDeleted
toCheckoutKeyDeleted "ok"       = return KeySuccessfullyDeleted
toCheckoutKeyDeleted rawMessage = return $ UnableToDeleteKey rawMessage

-------------------------------------------------------------------------------
-- API types for Servant ------------------------------------------------------
-------------------------------------------------------------------------------

-- Complete API for work with checkout keys.
type CheckoutKeyAPI =
         GetCheckoutKeysCall
    :<|> GetCheckoutKeyCall
    :<|> CreateCheckoutKeyCall
    :<|> DeleteCheckoutKeyCall

-- Lists checkout keys.
type GetCheckoutKeysCall =
       "project"
    :> Capture "username" UserName
    :> Capture "project" ProjectName
    :> "checkout-key"
    :> QueryParam "circle-token" Token
    :> Get '[JSON] [CheckoutKeyInfo]
    -- GET: /project/:username/:project/checkout-key?circle-token=:token

-- Get a checkout key.
type GetCheckoutKeyCall =
       "project"
    :> Capture "username" UserName
    :> Capture "project" ProjectName
    :> "checkout-key"
    :> Capture "fingerprint" Text
    :> QueryParam "circle-token" Token
    :> Get '[JSON] CheckoutKeyInfo
    -- GET: /project/:username/:project/checkout-key/:fingerprint?circle-token=:token

-- Create checkout key.
type CreateCheckoutKeyCall =
       "project"
    :> Capture "username" UserName
    :> Capture "project" ProjectName
    :> "checkout-key"
    :> QueryParam "circle-token" Token
    :> Post '[JSON] CheckoutKeyInfo
    -- POST: /project/:username/:project/checkout-key?circle-token=:token

-- Delete a checkout key.
type DeleteCheckoutKeyCall =
       "project"
    :> Capture "username" UserName
    :> Capture "project" ProjectName
    :> "checkout-key"
    :> Capture "fingerprint" Text
    :> QueryParam "circle-token" Token
    :> Delete '[JSON] CheckoutKeyDeleted
    -- DELETE: /project/:username/:project/checkout-key/:fingerprint?circle-token=:token

-------------------------------------------------------------------------------
-- API client calls for Servant -----------------------------------------------
-------------------------------------------------------------------------------

servantGetCheckoutKeys :: UserName
                       -> ProjectName
                       -> Maybe Token
                       -> Manager
                       -> BaseUrl
                       -> ClientM [CheckoutKeyInfo]

servantGetCheckoutKey :: UserName
                      -> ProjectName
                      -> Text
                      -> Maybe Token
                      -> Manager
                      -> BaseUrl
                      -> ClientM CheckoutKeyInfo

servantCreateCheckoutKey :: UserName
                         -> ProjectName
                         -> Maybe Token
                         -> Manager
                         -> BaseUrl
                         -> ClientM CheckoutKeyInfo

servantDeleteCheckoutKey :: UserName
                         -> ProjectName
                         -> Text
                         -> Maybe Token
                         -> Manager
                         -> BaseUrl
                         -> ClientM CheckoutKeyDeleted

servantGetCheckoutKeys
 :<|> servantGetCheckoutKey
 :<|> servantCreateCheckoutKey
 :<|> servantDeleteCheckoutKey = client checkoutKeyAPI

checkoutKeyAPI :: P.Proxy CheckoutKeyAPI
checkoutKeyAPI = P.Proxy