Skip to content

Instantly share code, notes, and snippets.

@junjihashimoto
Created February 25, 2014 21:14
Show Gist options
  • Save junjihashimoto/9217909 to your computer and use it in GitHub Desktop.
Save junjihashimoto/9217909 to your computer and use it in GitHub Desktop.
restclint-sample
{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as L
import Network.HTTP
import Network.HTTP.Base
import Network.URI
import Control.Applicative
import Control.Monad
import qualified Data.HashMap.Strict as M
data OSAuth=
OSRAuthP{
osaUsername :: T.Text
,osaPassword :: T.Text
,osaTenantName :: Maybe T.Text
,osaTenantId :: Maybe T.Text
}|
OSRAuthT{
osaToken :: T.Text
,osaTenantName :: Maybe T.Text
,osaTenantId :: Maybe T.Text
} deriving (Show,Read)
instance FromJSON OSAuth where
parseJSON (Object v) = do
case (M.lookup "auth" v) of
Just (Object v')->do
case (M.lookup "passwordCredentials" v') of
Just (Object v'')->do
case (M.lookup "token" v'') of
Just _->
OSRAuthT <$>
v'' .: "token" <*>
v' .:? "tenantName" <*>
v' .:? "tenantId"
_ ->
OSRAuthP <$>
v' .: "username" <*>
v' .: "password" <*>
v' .:? "tenantName" <*>
v' .:? "tenantId"
_ -> mzero
_ -> mzero
parseJSON _ = mzero
instance ToJSON OSAuth where
toJSON (OSRAuthP name password tenantName tenantId) =
object [
"auth" .=
object [
"tenantName" .= tenantName,
"teantnId" .= tenantId,
"passwordCredentials" .=
object [
"username" .= name,
"password" .= password
]
]
]
rest'::(ToJSON a)=>RequestMethod->T.Text->a->IO L.ByteString
rest' mth url dat'=do
let (Just url')=parseURI $ T.unpack url
let dat=encode dat'
let len =L.length dat
let r = Request { rqURI = url'
, rqMethod = mth
, rqHeaders = [ mkHeader HdrContentType "application/json"
, mkHeader HdrAccept "application/json"
, mkHeader HdrContentLength $ show $ len
]
, rqBody = dat
}
res <- simpleHTTP r
body <- getResponseBody res
return body
rest::(ToJSON a,FromJSON b)=>RequestMethod->T.Text->a->IO (Maybe b)
rest mth url dat'=do
body<-rest' mth url dat'
return (decode body)
doAuth::T.Text->T.Text->T.Text->IO (Maybe OSAuth)
doAuth url id pass=do
let dat=OSRAuthP id pass Nothing Nothing
body <- rest POST url dat
return body
main=do
let dat=("raw data"::String)
let (Just t)=(decode $ "{\"auth\":{\"username\":\"hello\"}}" ) :: Maybe OSAuth
print $ t
print $ encode t
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment