module Network.Octohat.Types ( Member(..)
, MemberWithKey(..)
, Team(..)
, TeamPermission(..)
, Repo(..)
, Organization(..)
, BearerToken(..)
, OrganizationName(..)
, TeamName(..)
, StatusInTeam(..)
, EmptyBody(..)
, DidDelete(..)
, PublicKey(..)
, PublicKeyFingerprint(..)
, TeamCreateRequest(..)
, GitHubReturnStatus(..)
, DidAddKey(..)
, AddPublicKeyRequest(..)
, Links(..)
, Pagination(..)
, runGitHub
, runGitHub'
, GitHub) where
import Control.Applicative
import Control.Monad.Reader (ReaderT(..))
import Control.Monad.State (StateT(..), evalStateT)
import Control.Monad.Trans.Either
import Data.Aeson
import Data.Aeson.TH
import Data.Char (toLower)
import Network.HTTP.Client
import Network.Wreq.Types
import System.Environment.Compat (lookupEnv)
import qualified Data.HashMap.Strict as HS
import qualified Data.Text as T
data Member =
Member { memberLogin :: T.Text
, memberId :: Integer
} deriving (Show, Eq)
data TeamPermission = OwnerAccess
| PullAccess
| PushAccess
| AdminAccess
deriving (Show,Eq)
data Team =
Team { teamId :: Integer
, teamName :: T.Text
, teamDescription :: Maybe T.Text
, teamPermission :: TeamPermission
} deriving (Show, Eq)
data TeamCreateRequest =
TeamCreateRequest { newTeamName :: T.Text
, newTeamDescription :: T.Text
, newTeamPermission :: TeamPermission
} deriving (Show, Eq)
data Organization =
Organization
{ orgLogin :: T.Text
, orgDescription :: Maybe T.Text
} deriving (Show, Eq)
data Repo =
Repo { repoName :: T.Text
, repoDescription :: Maybe T.Text
, repoPrivate :: Bool
} deriving (Show, Eq)
data MemberWithKey =
MemberWithKey { member :: Member
, memberKey :: [PublicKey]
, memberKeyFingerprint :: [PublicKeyFingerprint]
} deriving (Show, Eq)
data PublicKey =
PublicKey { publicKeyId :: Integer
, publicKey :: T.Text
} deriving (Show, Eq)
data PublicKeyFingerprint =
PublicKeyFingerprint { fingerprintId :: Integer
, publicKeyFingerprint :: T.Text
} deriving (Show, Eq)
data EmptyBody = EmptyBody deriving (Show, Eq)
data StatusInTeam = Active | Pending deriving (Show, Eq)
data DidDelete = Deleted | NotDeleted deriving (Show, Eq)
instance FromJSON PublicKey where
parseJSON (Object o) = PublicKey <$> o .: "id" <*> o .: "key"
parseJSON _ = fail "Could not find public keys in document"
data DidAddKey = KeyAdded | KeyNotAdded
data AddPublicKeyRequest =
AddPublicKeyRequest {
addPublicKeyRequestKey :: T.Text,
addPublicKeyRequestTitle :: T.Text
}
instance FromJSON StatusInTeam where
parseJSON (Object o) =
case HS.lookup "state" o of
Just "active" -> pure Active
Just "pending" -> pure Pending
Just _ -> fail "\"state\" key not \"active\" or \"pending\""
Nothing -> (fail . maybe "No error message from GitHub" show) (HS.lookup "message" o)
parseJSON _ = fail "Expected a membership document, got something else"
instance FromJSON TeamPermission where
parseJSON (String p) =
case p of
"pull" -> pure PullAccess
"push" -> pure PushAccess
"admin" -> pure AdminAccess
"owner" -> pure OwnerAccess
_ -> fail "Expected a valid team permission ?"
parseJSON _ = fail "Expected a team permssion, got something else"
instance ToJSON TeamPermission where
toJSON p =
case p of
PullAccess -> String "pull"
PushAccess -> String "push"
AdminAccess -> String "admin"
OwnerAccess -> String "owner"
$(deriveJSON defaultOptions { fieldLabelModifier = drop 6 . map toLower } ''Member)
$(deriveJSON defaultOptions { fieldLabelModifier = drop 4 . map toLower } ''Team)
$(deriveJSON defaultOptions { fieldLabelModifier = drop 4 . map toLower } ''Repo)
$(deriveJSON defaultOptions { fieldLabelModifier = drop 3 . map toLower } ''Organization)
$(deriveJSON defaultOptions { fieldLabelModifier = drop 7 . map toLower } ''TeamCreateRequest)
$(deriveJSON defaultOptions { fieldLabelModifier = drop 19 . map toLower } ''AddPublicKeyRequest)
data GitHubReturnStatus = InvalidJSON
| ValidationFailed
| InternalError
| NotFound
| NotAllowed
| AllOk
| RequiresAuthentication
| UnexpectedJSON String
deriving (Show, Eq)
instance Putable EmptyBody where
putPayload EmptyBody req = return $ req {requestBody = RequestBodyLBS ""}
instance Postable TeamCreateRequest where
postPayload createRequest req = return $ req { requestBody = RequestBodyLBS (encode createRequest)}
instance Postable AddPublicKeyRequest where
postPayload createRequest req = return $ req { requestBody = RequestBodyLBS (encode createRequest)}
newtype BearerToken = BearerToken { unBearerToken :: T.Text } deriving Show
newtype OrganizationName = OrganizationName { unOrganizationName :: T.Text } deriving Show
newtype TeamName = TeamName { unTeamName :: T.Text } deriving Show
data Links = Links { linkNext :: Maybe Link, linkLast :: Maybe Link
, linkFirst :: Maybe Link, linkPrev :: Maybe Link } deriving Show
data Pagination = Pagination { perPage :: Int, page :: Int, links :: Links, recurse :: Bool } deriving Show
defPagination :: Pagination
defPagination = Pagination 30 1 (Links Nothing Nothing Nothing Nothing) True
type GitHub = EitherT GitHubReturnStatus (ReaderT BearerToken (StateT Pagination IO))
runGitHub' :: GitHub a -> BearerToken -> IO (Either GitHubReturnStatus a)
runGitHub' comp token = evalStateT (runReaderT (runEitherT comp) token) defPagination
runGitHub :: GitHub a -> IO (Either GitHubReturnStatus a)
runGitHub comp = do
maybeToken <- lookupEnv "GITHUB_TOKEN"
case maybeToken of
Just acquiredToken -> runGitHub' comp (BearerToken $ T.pack acquiredToken)
Nothing -> fail "Couldn't find GITHUB_TOKEN in environment"