content: {-# LANGUAGE RankNTypes      #-}
  {-# LANGUAGE RecordWildCards #-}
  
  -- | Logic related to downloading update.
  
  module Pos.Network.Update.Download
         ( installerHash
         , downloadUpdate
         ) where
  
  import           Universum
  
  import           Control.Exception.Safe (handleAny)
  import           Control.Lens (views)
  import           Control.Monad.Except (ExceptT (..), throwError)
  import qualified Data.ByteArray as BA
  import qualified Data.ByteString.Lazy as BSL
  import qualified Data.HashMap.Strict as HM
  import           Formatting (build, sformat, stext, (%))
  import           Network.HTTP.Client (Manager, newManager)
  import           Network.HTTP.Client.TLS (tlsManagerSettings)
  import           Network.HTTP.Simple (getResponseBody, getResponseStatus,
                       getResponseStatusCode, httpLBS, parseRequest,
                       setRequestManager)
  import qualified Serokell.Util.Base16 as B16
  import           Serokell.Util.Text (listJsonIndent, mapJson)
  import           System.Directory (doesFileExist)
  
  import           Pos.Binary.Class (Raw)
  import           Pos.Chain.Update (ConfirmedProposalState (..),
                       SoftwareVersion (..), UpdateConfiguration,
                       UpdateData (..), UpdateParams (..), UpdateProposal (..),
                       curSoftwareVersion, ourSystemTag)
  import           Pos.Core.Exception (reportFatalError)
  import           Pos.Crypto (Hash, castHash, hash)
  import           Pos.DB.Update (UpdateContext (..), isUpdateInstalled)
  import           Pos.Infra.Reporting (reportOrLogW)
  import           Pos.Listener.Update (UpdateMode)
  import           Pos.Util.Concurrent (withMVar)
  import           Pos.Util.Util (HasLens (..), (<//>))
  import           Pos.Util.Wlog (WithLogger, logDebug, logInfo, logWarning)
  
  -- | Compute hash of installer, this is hash is 'udPkgHash' from 'UpdateData'.
  --
  -- NB: we compute it by first CBOR-encoding it and then applying hash
  -- function, which is a bit strange, but it's done for historical
  -- reasons.
  installerHash :: LByteString -> Hash Raw
  installerHash = castHash . hash
  
  -- | Download a software update for given 'ConfirmedProposalState' and
  -- put it into a variable which holds 'ConfirmedProposalState' of
  -- downloaded update.
  -- Parallel downloads aren't supported, so this function may blocks.
  -- If we have already downloaded an update successfully, this function won't
  -- download new updates.
  --
  -- The caller must ensure that:
  -- 1. This update is for our software.
  -- 2. This update is for our system (according to system tag).
  -- 3. This update brings newer software version than our current version.
  downloadUpdate :: forall ctx m . UpdateMode ctx m => ConfirmedProposalState -> m ()
  downloadUpdate cps = do
      downloadLock <- ucDownloadLock <$> view (lensOf @UpdateContext)
      withMVar downloadLock $ \() -> do
          downloadedUpdateMVar <-
              ucDownloadedUpdate <$> view (lensOf @UpdateContext)
          tryReadMVar downloadedUpdateMVar >>= \case
              Nothing -> do
                  updHash <- getUpdateHash cps
                  installed <- isUpdateInstalled updHash
                  if installed
                      then onAlreadyInstalled
                      else downloadUpdateDo updHash cps
              Just existingCPS -> onAlreadyDownloaded existingCPS
    where
      proposalToDL = cpsUpdateProposal cps
      onAlreadyDownloaded ConfirmedProposalState {..} =
          logInfo $
          sformat
              ("We won't download an update for proposal "%build%
               ", because we have already downloaded another update: "%build%
               " and we are waiting for it to be applied")
              proposalToDL
              cpsUpdateProposal
      onAlreadyInstalled =
          logInfo $
          sformat
              ("We won't download an update for proposal "%build%
               ", because it's already installed")
              proposalToDL
  
  getUpdateHash :: UpdateMode ctx m => ConfirmedProposalState -> m (Hash Raw)
  getUpdateHash ConfirmedProposalState{..} = do
      useInstaller <- views (lensOf @UpdateParams) upUpdateWithPkg
      uc <- view (lensOf @UpdateConfiguration)
      let data_ = upData cpsUpdateProposal
          dataHash = if useInstaller then udPkgHash else udAppDiffHash
          mupdHash = dataHash <$> HM.lookup (ourSystemTag uc) data_
  
      logDebug $ sformat ("Proposal's upData: "%mapJson) data_
  
      -- It must be enforced by the caller.
      maybe (reportFatalError $ sformat
              ("We are trying to download an update not for our "%
              "system, update proposal is: "%build)
              cpsUpdateProposal)
          pure
          mupdHash
  
  -- Download and save archive update by given `ConfirmedProposalState`
  downloadUpdateDo :: UpdateMode ctx m => Hash Raw -> ConfirmedProposalState -> m ()
  downloadUpdateDo updHash cps@ConfirmedProposalState {..} = do
      updateServers <- views (lensOf @UpdateParams) upUpdateServers
      uc <- view (lensOf @UpdateConfiguration)
  
      logInfo $ sformat ("We are going to start downloading an update for "%build)
                cpsUpdateProposal
      res <- handleAny handleErr $ runExceptT $ do
          let updateVersion = upSoftwareVersion cpsUpdateProposal
          -- It's just a sanity check which must always pass due to the
          -- outside logic. We take only updates for our software and
          -- explicitly request only new updates. This invariant must be
          -- ensure by the caller of 'downloadUpdate'.
          unless (isVersionAppropriate uc updateVersion) $
              reportFatalError $
              sformat ("Update #"%build%" hasn't been downloaded: "%
                      "its version is not newer than current software "%
                      "software version or it's not for our "%
                      "software at all") updHash
  
          updPath <- views (lensOf @UpdateParams) upUpdatePath
          whenM (liftIO $ doesFileExist updPath) $
              throwError "There's unapplied update already downloaded"
  
          logInfo "Downloading update..."
          file <- ExceptT $ downloadHash updateServers updHash <&>
                  first (sformat ("Update download (hash "%build%
                                  ") has failed: "%stext) updHash)
  
          logInfo $ "Update was downloaded, saving to " <> show updPath
  
          liftIO $ BSL.writeFile updPath file
          logInfo $ "Update was downloaded, saved to " <> show updPath
          downloadedMVar <- views (lensOf @UpdateContext) ucDownloadedUpdate
          putMVar downloadedMVar cps
          logInfo "Update MVar filled, wallet is notified"
  
      whenLeft res logDownloadError
    where
      handleErr e =
          Left (pretty e) <$ reportOrLogW "Update downloading failed: " e
      logDownloadError e =
          logWarning $ sformat
              ("Failed to download update proposal "%build%": "%stext)
              cpsUpdateProposal e
      -- Check that we really should download an update with given
      -- 'SoftwareVersion'.
      isVersionAppropriate :: UpdateConfiguration -> SoftwareVersion -> Bool
      isVersionAppropriate uc ver =
          svAppName ver == svAppName (curSoftwareVersion uc)
          && svNumber ver > svNumber (curSoftwareVersion uc)
  
  -- Download a file by its hash.
  --
  -- Tries all servers in turn, fails if none of them work.
  downloadHash ::
         (MonadIO m, WithLogger m)
      => [Text]
      -> Hash Raw
      -> m (Either Text LByteString)
  downloadHash updateServers h = do
      manager <- liftIO $ newManager tlsManagerSettings
  
      let -- try all servers in turn until there's a Right
          go errs (serv:rest) = do
              let uri = toString serv <//> showHash h
              logDebug $ "Trying url " <> show uri
              liftIO (downloadUri manager uri h) >>= \case
                  Left e -> go (e:errs) rest
                  Right r -> return (Right r)
  
          -- if there were no servers, that's really weird
          go [] [] = return . Left $ "no update servers are known"
  
          -- if we've tried all servers already, fail
          go errs [] = return . Left $
              sformat ("all update servers failed: "%listJsonIndent 2)
                      (reverse errs)
  
      go [] updateServers
    where
      showHash :: Hash a -> FilePath
      showHash = toString . B16.encode . BA.convert
  
  -- Download a file and check its hash.
  downloadUri :: Manager
              -> String
              -> Hash Raw
              -> IO (Either Text LByteString)
  downloadUri manager uri h = do
      request <- setRequestManager manager <$> parseRequest uri
      resp <- httpLBS request
      let (st, stc) = (getResponseStatus resp, getResponseStatusCode resp)
          h' = installerHash (getResponseBody resp)
      return $ if | stc /= 200 -> Left ("error, " <> show st)
                  | h /= h'    -> Left "hash mismatch"
                  | otherwise  -> Right (getResponseBody resp)
  
  {- TODO
  
  * check timeouts?
  * how should we in general deal with e.g. 1B/s download speed?
  * if we expect updates to be big, use laziness/conduits (httpLBS isn't lazy,
    despite the “L” in its name)
  
  -}
  