packages feed

hup-0.3.0.3: test-hspec/Distribution/Hup/Upload/MockWebApp.hs

{-# LANGUAGE OverloadedStrings #-}

module Distribution.Hup.Upload.MockWebApp
  (
    webApp
  )
  where

import qualified Data.ByteString.Char8 as BS
import qualified Data.Text.Lazy as TL
import Network.Wai                            (Application )
import Network.Wai.Parse as Parse             (FileInfo(..), fileName)
import Web.Scotty hiding (request)

import Distribution.Hup.Upload
import Distribution.Hup.Parse

webApp :: IO Application
webApp =
    scottyApp $ do
      post "/packages/" $
        files >>= handlePost NormalPkg
      post "/packages/candidates/" $
        files >>= handlePost CandidatePkg
      put "/package/:pkgVer/docs" $ do
        pkgVer <- param "pkgVer"
        handlePut NormalPkg pkgVer
      put "/package/:pkgVer/candidate/docs" $ do
        pkgVer <- param "pkgVer"
        handlePut CandidatePkg pkgVer
  where
    handlePost
      :: IsCandidate -> [File] -> ActionM ()
    handlePost isCand files =
      case files of
        [(_fname, body)]  -> do
          let
              filename = BS.unpack $ Parse.fileName body

              parsed :: Either String (IsDocumentation, Package)
              parsed = parseTgzFilename' filename
          text $ TL.pack $ show (IsPackage, isCand, parsed)
        _       -> raise "posted package should have exactly 1 file"

    handlePut :: IsCandidate -> FilePath -> ActionM ()
    handlePut isCand filename = do
      let parsed :: Either String (IsDocumentation, Package)
          parsed = parseTgzFilename' (filename ++ "-docs.tar.gz")
      text $ TL.pack $
                show (IsDocumentation, isCand, parsed)