gistfile1.hs

------------------------------------------------------------------------------
-- | Processes each file upload in storeUploadedFile
copyUploadedFile :: MonadSnap m 
                 => (PartInfo, Either PolicyViolationException FilePath) 
                 -> m UploadInfo
copyUploadedFile (pif, efn) = either l r efn
  where
    l e = do logError $ B.pack $ show e 
             return $ UploadError "unknown upload error"
    r tfp = case (partFileName pif) of
             Nothing -> do logError $ B.pack $ "filename missing in upload" 
                           return $ UploadError "filename missing in upload"
             Just bn -> do i <- liftIO $ getPackageInfo tfp
                           let pn = getPackageName i
                           let pv = getPackageVersion i 
                           f i bn tfp pn pv
    f i bn tfp pn pv
        | check = do liftIO $ renameFile tfp $ newN
                     return $ UploadInfo i
        | otherwise = do logError $ B.pack $ fnErr
                         return $ UploadError fnErr
      where
        fnErr = "invalid filename: expected " ++ expect
        check = bn == B.pack expect
        expect = (pn ++ "-" ++ v2s ++ ".tar.gz")
        v2s = intercalate "." . map show $ versionBranch pv
        newN = (packageDir ++ [pathSeparator] ++ (T.unpack . decodeUtf8 $ bn))