mdapi (empty) → 1
raw patch · 6 files changed
+346/−0 lines, 6 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, data-default, lens, lens-aeson, text, transformers, wreq
Files
- LICENSE +26/−0
- Setup.hs +2/−0
- mdapi.cabal +32/−0
- src/Fedora/Mdapi.hs +38/−0
- src/Fedora/Mdapi/Internal.hs +46/−0
- src/Fedora/Mdapi/Types.hs +202/−0
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright (c) 2015, Ricky Elrod+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the+ distribution.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mdapi.cabal view
@@ -0,0 +1,32 @@+name: mdapi+version: 1+synopsis: Haskell interface to Fedora's mdapi+-- description:+homepage: https://github.com/relrod/mdapi-hs+license: BSD2+license-file: LICENSE+author: Ricky Elrod+maintainer: relrod@redhat.com+copyright: (c) 2015 Red Hat, Inc.+category: Fedora+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ exposed-modules: Fedora.Mdapi.Internal+ , Fedora.Mdapi.Types+ , Fedora.Mdapi+ -- other-modules:+ -- other-extensions:+ build-depends: aeson >= 0.7 && < 1+ , base >= 4 && < 5+ , bytestring >= 0.10 && < 1+ , data-default+ , lens >= 4 && < 5+ , lens-aeson >= 1 && < 2+ , text >= 1 && < 2+ , transformers >= 0.3 && < 0.5+ , wreq >= 0.3 && < 0.5+ hs-source-dirs: src+ default-language: Haskell2010
+ src/Fedora/Mdapi.hs view
@@ -0,0 +1,38 @@+-----------------------------------------------------------------------------+-- |+-- Module : Fedora.Mdapi+-- Copyright : (C) 2015 Red hat, Inc.+-- License : BSD2 (see LICENSE file)+-- Maintainer : Ricky Elrod <relrod@redhat.com>+-- Stability : experimental+-- Portability : ghc (lens)+--+-- Mdapi API Client+----------------------------------------------------------------------------+module Fedora.Mdapi where++import Control.Lens+import Data.Aeson+--import Data.Aeson.Lens (key, nth)+import qualified Data.ByteString.Lazy.Char8 as BL+import Fedora.Mdapi.Internal+import Fedora.Mdapi.Types+import Network.Wreq++pkg :: Branch -> String -> MdapiT (Either String PackageResponse)+pkg branch package = do+ rawResp <- mdapiGet $ "/" ++ branchToBranchName branch ++ "/pkg/" ++ package+ return $ eitherDecode (rawResp ^. responseBody)++files :: Branch -> String -> MdapiT (Either String FilesResponse)+files branch package = do+ rawResp <- mdapiGet $ "/" ++ branchToBranchName branch ++ "/files/" ++ package+ return $ eitherDecode (rawResp ^. responseBody)++changelog :: Branch -> String -> MdapiT (Either String ChangelogResponse)+changelog branch package = do+ rawResp <- mdapiGet $+ "/" ++ branchToBranchName branch ++ "/changelog/" ++ package+ -- https://pagure.io/mdapi/issue/23+ --resp <- asJSON =<< rawResp+ return $ eitherDecode (rawResp ^. responseBody)
+ src/Fedora/Mdapi/Internal.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+-- |+-- Module : Fedora.Mdapi.Internal+-- Copyright : (C) 2015 Red Hat, Inc.+-- License : BSD2 (see LICENSE file)+-- Maintainer : Ricky Elrod <relrod@redhat.com>+-- Stability : experimental+-- Portability : ghc (lens)+--+-- Low-level access to mdapi.+----------------------------------------------------------------------------+module Fedora.Mdapi.Internal where++import Control.Lens+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+--import Data.Aeson (toJSON)+--import Data.Aeson.Lens (key, nth)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.List (dropWhileEnd)+import Data.Monoid+import Network.Wreq+import Network.Wreq.Types (Postable)+import Fedora.Mdapi.Types++-- | Construct an API URL path. Strips any preceeding slashes from the given+-- 'String' parameter as well as the '_baseUrl' of the 'MdapiConfig'.+mdapiUrl :: String -> MdapiT String+mdapiUrl s = do+ MdapiConfig url <- ask+ return $ dropWhileEnd (== '/') url ++ "/" ++ dropWhile (== '/') s++mdapiWreqOptions :: Monad m => m Options+mdapiWreqOptions = return defaults++-- | Perform a @GET@ request to the API.+mdapiGetWith :: Options -> String -> MdapiT (Response BL.ByteString)+mdapiGetWith opts path = do+ path' <- mdapiUrl path+ liftIO $ getWith opts path'++-- | Perform a @GET@ request to the API with default options.+mdapiGet :: String -> MdapiT (Response BL.ByteString)+mdapiGet s = mdapiWreqOptions >>= flip mdapiGetWith s
+ src/Fedora/Mdapi/Types.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+-----------------------------------------------------------------------------+-- |+-- Module : Fedora.Mdapi.Types+-- Copyright : (C) 2015 Red hat, Inc.+-- License : BSD2 (see LICENSE file)+-- Maintainer : Ricky Elrod <relrod@redhat.com>+-- Stability : experimental+-- Portability : ghc (lens)+--+-- Types for Mdapi+----------------------------------------------------------------------------+module Fedora.Mdapi.Types where++import Control.Lens+import Control.Monad.IO.Class+import Control.Monad.Trans.Reader+import Data.Aeson+--import Data.Aeson.Lens (key, nth)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Default+import Data.List (dropWhileEnd)+import Data.Maybe (fromMaybe)+import Data.Monoid+import qualified Data.Text as T+import Network.Wreq+import Network.Wreq.Types (Postable)++-- | Our 'MdapiT' type which is really a 'ReaderT' with 'IO' as its base. For+-- now, at least.+type MdapiT a = ReaderT MdapiConfig IO a++-- | Run the whole transformer stack.+runMdapiT :: MdapiT a -> MdapiConfig -> IO a+runMdapiT = runReaderT++-- | Describes how to connect to the mdapi instance.+data MdapiConfig = MdapiConfig {+ _baseUrl :: String+ } deriving (Eq, Show)++-- | Default to <https://apps.fedoraproject.org/mdapi/>.+instance Default MdapiConfig where+ def = MdapiConfig "https://apps.fedoraproject.org/mdapi/"++data Branch =+ Dist6Epel+ | F23+ | Rawhide+ | F22+ | Koji+ | Dist5Epel+ | Dist6+ | Dist5+ | Epel7+ | F21++branchToBranchName :: Branch -> String+branchToBranchName Dist6Epel = "dist-6E-epel"+branchToBranchName F23 = "f23"+branchToBranchName Rawhide = "rawhide"+branchToBranchName F22 = "f22"+branchToBranchName Koji = "koji"+branchToBranchName Dist5Epel = "dist-5E-epel"+branchToBranchName Dist6 = "dist-6E"+branchToBranchName Dist5 = "dist-5E"+branchToBranchName Epel7 = "epel7"+branchToBranchName F21 = "f21"++--------------------------------------------------------------------------------+-- Package+--------------------------------------------------------------------------------++data NEVR =+ NEVR { _name :: Maybe T.Text+ , _epoch :: Maybe T.Text+ , _version :: Maybe T.Text+ , _release :: Maybe T.Text+ } deriving (Eq, Show)++makeLenses ''NEVR++instance FromJSON NEVR where+ parseJSON (Object v) = NEVR <$>+ v .: "name" <*>+ v .: "epoch" <*>+ v .: "version" <*>+ v .: "release"+ parseJSON _ = mempty++data PackageResponse =+ PackageResponse { _arch :: T.Text+ , _basename :: T.Text+ , _copackages :: [T.Text]+ , _conflicts :: [NEVR]+ , _description :: T.Text+ , _enhances :: [NEVR] -- Sometimes null, sometimes []?+ , _pkgEpoch :: T.Text+ , _obsoletes :: [NEVR]+ , _provides :: [NEVR]+ , _recommends :: [NEVR]+ , _pkgRelease :: T.Text+ , _pkgRepo :: T.Text+ , _requires :: [NEVR]+ , _suggests :: [NEVR]+ , _summary :: T.Text+ , _supplements :: [NEVR]+ , _pkgVersion :: T.Text+ } deriving (Eq, Show)++makeLenses ''PackageResponse++instance FromJSON PackageResponse where+ parseJSON (Object v) = PackageResponse <$>+ v .: "arch" <*>+ v .: "basename" <*>+ v .: "co-packages" <*>+ v .: "conflicts" <*>+ v .: "description" <*>+ fmap fixNull (v .: "enhances") <*>+ v .: "epoch" <*>+ v .: "obsoletes" <*>+ v .: "provides" <*>+ fmap fixNull (v .: "recommends") <*>+ v .: "release" <*>+ v .: "repo" <*>+ v .: "requires" <*>+ fmap fixNull (v .: "suggests") <*>+ v .: "summary" <*>+ fmap fixNull (v .: "supplements") <*>+ v .: "version"+ where+ fixNull = fromMaybe []+ parseJSON _ = mempty+++--------------------------------------------------------------------------------+-- Changelog+--------------------------------------------------------------------------------++data ChangelogEntry =+ ChangelogEntry { _author :: T.Text+ , _log :: T.Text+ , _date :: Integer+ } deriving (Eq, Show)++makeLenses ''ChangelogEntry++instance FromJSON ChangelogEntry where+ parseJSON (Object v) = ChangelogEntry <$>+ v .: "author" <*>+ v .: "changelog" <*>+ v .: "date"+ parseJSON _ = mempty++data ChangelogResponse =+ ChangelogResponse { _changelogResponseEntries :: [ChangelogEntry]+ -- ^ Why is this called 'files' upstream?+ , _changelogResponseRepo :: String+ } deriving (Eq, Show)++makeLenses ''ChangelogResponse++instance FromJSON ChangelogResponse where+ parseJSON (Object v) = ChangelogResponse <$>+ v .: "files" <*>+ v .: "repo"+ parseJSON _ = mempty++--------------------------------------------------------------------------------+-- Files+--------------------------------------------------------------------------------++data FileEntry =+ FileEntry { _dirname :: T.Text+ , _filenames :: T.Text+ , _filetypes :: T.Text+ } deriving (Eq, Show)++makeLenses ''FileEntry++instance FromJSON FileEntry where+ parseJSON (Object v) = FileEntry <$>+ v .: "dirname" <*>+ v .: "filenames" <*>+ v .: "filetypes"+ parseJSON _ = mempty++data FilesResponse =+ FilesResponse { _filesResponseEntries :: [FileEntry]+ , _filesResponseRepo :: String+ } deriving (Eq, Show)++makeLenses ''FilesResponse++instance FromJSON FilesResponse where+ parseJSON (Object v) = FilesResponse <$>+ v .: "files" <*>+ v .: "repo"+ parseJSON _ = mempty