2011-07-05 14:37:01 +00:00
-- | Connect to a single server or a replica set of servers
2010-06-15 03:14:40 +00:00
2011-07-05 14:37:01 +00:00
{- # LANGUAGE CPP, OverloadedStrings, ScopedTypeVariables, TupleSections # -}
2010-06-15 03:14:40 +00:00
2016-05-20 04:44:42 +00:00
# if ( __GLASGOW_HASKELL__ >= 706 )
{- # LANGUAGE RecursiveDo # -}
# else
{- # LANGUAGE DoRec # -}
# endif
2010-06-15 03:14:40 +00:00
module Database.MongoDB.Connection (
2013-12-26 14:57:33 +00:00
-- * Util
2013-12-26 15:23:02 +00:00
Secs ,
2013-12-26 14:57:33 +00:00
-- * Connection
Pipe , close , isClosed ,
-- * Server
Host ( .. ) , PortID ( .. ) , defaultPort , host , showHostPort , readHostPort ,
2012-06-10 19:47:14 +00:00
readHostPortM , globalConnectTimeout , connect , connect' ,
2013-12-26 14:57:33 +00:00
-- * Replica Set
2022-06-17 17:16:02 +00:00
ReplicaSetName , openReplicaSet , openReplicaSet' , openReplicaSetTLS , openReplicaSetTLS' ,
openReplicaSetSRV , openReplicaSetSRV' , openReplicaSetSRV'' , openReplicaSetSRV''' ,
2013-12-26 14:57:33 +00:00
ReplicaSet , primary , secondaryOk , routedHost , closeReplicaSet , replSetName
2010-06-15 03:14:40 +00:00
) where
2011-03-14 20:24:28 +00:00
import Prelude hiding ( lookup )
2012-06-10 19:47:14 +00:00
import Data.IORef ( IORef , newIORef , readIORef )
import Data.List ( intersect , partition , ( \\ ) , delete )
2019-10-04 16:10:24 +00:00
import Data.Maybe ( fromJust )
2015-05-15 13:23:40 +00:00
# if ! MIN_VERSION_base ( 4 , 8 , 0 )
2012-06-10 19:47:14 +00:00
import Control.Applicative ( ( <$> ) )
2015-05-15 13:23:40 +00:00
# endif
2019-09-11 06:08:22 +00:00
import Control.Monad ( forM_ , guard )
2012-06-10 19:47:14 +00:00
import System.IO.Unsafe ( unsafePerformIO )
import System.Timeout ( timeout )
2019-09-11 06:08:22 +00:00
import Text.ParserCombinators.Parsec ( parse , many1 , letter , digit , char , anyChar , eof ,
2012-06-10 19:47:14 +00:00
spaces , try , ( <|> ) )
import qualified Data.List as List
2019-05-29 23:57:51 +00:00
import Control.Monad.Except ( throwError )
2012-06-10 19:47:14 +00:00
import Control.Concurrent.MVar.Lifted ( MVar , newMVar , withMVar , modifyMVar ,
readMVar )
import Data.Bson ( Document , at , ( =: ) )
2012-05-08 15:13:25 +00:00
import Data.Text ( Text )
2012-06-10 19:47:14 +00:00
import qualified Data.Bson as B
2012-05-08 15:13:25 +00:00
import qualified Data.Text as T
2012-06-10 19:47:14 +00:00
2019-11-01 16:55:59 +00:00
import Database.MongoDB.Internal.Network ( Host ( .. ) , HostName , PortID ( .. ) , connectTo , lookupSeedList , lookupReplicaSetName )
2016-04-11 00:45:30 +00:00
import Database.MongoDB.Internal.Protocol ( Pipe , newPipe , close , isClosed )
2013-12-26 15:23:02 +00:00
import Database.MongoDB.Internal.Util ( untilSuccess , liftIOE ,
2012-06-10 19:47:14 +00:00
updateAssocs , shuffle , mergesortM )
import Database.MongoDB.Query ( Command , Failure ( ConnectionFailure ) , access ,
2016-05-20 04:44:42 +00:00
slaveOk , runCommand , retrieveServerData )
2019-11-01 16:55:59 +00:00
import qualified Database.MongoDB.Transport.Tls as TLS ( connect )
2011-07-05 14:37:01 +00:00
2013-12-26 15:23:02 +00:00
adminCommand :: Command -> Pipe -> IO Document
2011-07-05 14:37:01 +00:00
-- ^ Run command against admin database on server connected to pipe. Fail if connection fails.
adminCommand cmd pipe =
2013-12-26 15:23:02 +00:00
liftIOE failureToIOError $ access pipe slaveOk " admin " $ runCommand cmd
2011-07-05 14:37:01 +00:00
where
2013-12-26 14:57:33 +00:00
failureToIOError ( ConnectionFailure e ) = e
failureToIOError e = userError $ show e
2010-07-27 21:18:53 +00:00
2010-06-15 03:14:40 +00:00
defaultPort :: PortID
2011-07-13 19:34:52 +00:00
-- ^ Default MongoDB port = 27017
2010-06-15 03:14:40 +00:00
defaultPort = PortNumber 27017
2010-07-27 21:18:53 +00:00
host :: HostName -> Host
2011-07-13 19:34:52 +00:00
-- ^ Host on 'defaultPort'
2010-07-27 21:18:53 +00:00
host hostname = Host hostname defaultPort
2010-06-15 03:14:40 +00:00
2010-07-27 21:18:53 +00:00
showHostPort :: Host -> String
2020-04-01 14:53:37 +00:00
-- ^ Display host as \"host:port\"
2019-09-11 06:08:22 +00:00
-- TODO: Distinguish Service port
showHostPort ( Host hostname ( PortNumber port ) ) = hostname ++ " : " ++ show port
# if ! defined ( mingw32_HOST_OS ) && ! defined ( cygwin32_HOST_OS ) && ! defined ( _WIN32 )
showHostPort ( Host _ ( UnixSocket path ) ) = " unix: " ++ path
# endif
2010-06-15 03:14:40 +00:00
2019-10-04 16:10:24 +00:00
readHostPortM :: ( MonadFail m ) => String -> m Host
2011-07-13 19:34:52 +00:00
-- ^ Read string \"hostname:port\" as @Host hosthame (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Fail if string does not match either syntax.
2020-04-01 13:11:17 +00:00
2019-09-11 06:08:22 +00:00
-- TODO: handle Service port
2010-07-27 21:18:53 +00:00
readHostPortM = either ( fail . show ) return . parse parser " readHostPort " where
2020-02-01 08:27:20 +00:00
hostname = many1 ( letter <|> digit <|> char '-' <|> char '.' <|> char '_' )
2013-12-26 14:57:33 +00:00
parser = do
spaces
h <- hostname
try ( spaces >> eof >> return ( host h ) ) <|> do
_ <- char ':'
2019-09-11 06:08:22 +00:00
try ( do port :: Int <- read <$> many1 digit
spaces >> eof
return $ Host h ( PortNumber $ fromIntegral port ) )
# if ! defined ( mingw32_HOST_OS ) && ! defined ( cygwin32_HOST_OS ) && ! defined ( _WIN32 )
<|> do guard ( h == " unix " )
p <- many1 anyChar
eof
return $ Host " " ( UnixSocket p )
# endif
2010-06-15 03:14:40 +00:00
2010-07-27 21:18:53 +00:00
readHostPort :: String -> Host
2011-07-13 19:34:52 +00:00
-- ^ Read string \"hostname:port\" as @Host hostname (PortNumber port)@ or \"hostname\" as @host hostname@ (default port). Error if string does not match either syntax.
2019-10-04 16:10:24 +00:00
readHostPort = fromJust . readHostPortM
2010-06-15 03:14:40 +00:00
2011-07-21 15:27:19 +00:00
type Secs = Double
globalConnectTimeout :: IORef Secs
2020-04-01 13:11:17 +00:00
-- ^ 'connect' (and 'openReplicaSet') fails if it can't connect within this many seconds (default is 6 seconds). Use 'connect'' (and 'openReplicaSet'') if you want to ignore this global and specify your own timeout. Note, this timeout only applies to initial connection establishment, not when reading/writing to the connection.
2011-07-21 15:27:19 +00:00
globalConnectTimeout = unsafePerformIO ( newIORef 6 )
{- # NOINLINE globalConnectTimeout # -}
2013-12-26 15:23:02 +00:00
connect :: Host -> IO Pipe
2020-04-01 13:11:17 +00:00
-- ^ Connect to Host returning pipelined TCP connection. Throw 'IOError' if connection refused or no response within 'globalConnectTimeout'.
2013-12-26 15:23:02 +00:00
connect h = readIORef globalConnectTimeout >>= flip connect' h
2011-07-21 15:27:19 +00:00
2013-12-26 15:23:02 +00:00
connect' :: Secs -> Host -> IO Pipe
2020-04-01 13:11:17 +00:00
-- ^ Connect to Host returning pipelined TCP connection. Throw 'IOError' if connection refused or no response within given number of seconds.
2011-07-21 15:27:19 +00:00
connect' timeoutSecs ( Host hostname port ) = do
2013-12-26 15:23:02 +00:00
mh <- timeout ( round $ timeoutSecs * 1000000 ) ( connectTo hostname port )
handle <- maybe ( ioError $ userError " connect timed out " ) return mh
2016-05-20 04:44:42 +00:00
rec
p <- newPipe sd handle
sd <- access p slaveOk " admin " retrieveServerData
return p
2011-07-05 14:37:01 +00:00
2010-10-27 20:13:23 +00:00
-- * Replica Set
2010-06-15 03:14:40 +00:00
2012-05-08 15:13:25 +00:00
type ReplicaSetName = Text
2011-07-05 14:37:01 +00:00
2019-11-01 17:00:06 +00:00
data TransportSecurity = Secure | Unsecure
2019-11-01 16:55:59 +00:00
2011-07-05 14:37:01 +00:00
-- | Maintains a connection (created on demand) to each server in the named replica set
2019-11-01 16:55:59 +00:00
data ReplicaSet = ReplicaSet ReplicaSetName ( MVar [ ( Host , Maybe Pipe ) ] ) Secs TransportSecurity
2011-07-21 15:27:19 +00:00
2012-05-08 15:13:25 +00:00
replSetName :: ReplicaSet -> Text
2020-04-01 13:11:17 +00:00
-- ^ Get the name of connected replica set.
2019-11-01 16:55:59 +00:00
replSetName ( ReplicaSet rsName _ _ _ ) = rsName
2011-07-05 14:37:01 +00:00
2013-12-26 15:23:02 +00:00
openReplicaSet :: ( ReplicaSetName , [ Host ] ) -> IO ReplicaSet
2020-04-01 13:11:17 +00:00
-- ^ Open connections (on demand) to servers in replica set. Supplied hosts is seed list. At least one of them must be a live member of the named replica set, otherwise fail. The value of 'globalConnectTimeout' at the time of this call is the timeout used for future member connect attempts. To use your own value call 'openReplicaSet'' instead.
2013-12-26 15:23:02 +00:00
openReplicaSet rsSeed = readIORef globalConnectTimeout >>= flip openReplicaSet' rsSeed
2011-07-21 15:27:19 +00:00
2013-12-26 15:23:02 +00:00
openReplicaSet' :: Secs -> ( ReplicaSetName , [ Host ] ) -> IO ReplicaSet
2011-07-21 15:27:19 +00:00
-- ^ Open connections (on demand) to servers in replica set. Supplied hosts is seed list. At least one of them must be a live member of the named replica set, otherwise fail. Supplied seconds timeout is used for connect attempts to members.
2019-11-01 17:00:06 +00:00
openReplicaSet' timeoutSecs ( rs , hosts ) = _openReplicaSet timeoutSecs ( rs , hosts , Unsecure )
2019-11-01 16:55:59 +00:00
2022-06-17 17:16:02 +00:00
openReplicaSetTLS :: ( ReplicaSetName , [ Host ] ) -> IO ReplicaSet
2020-04-01 13:11:17 +00:00
-- ^ Open secure connections (on demand) to servers in the replica set. Supplied hosts is seed list. At least one of them must be a live member of the named replica set, otherwise fail. The value of 'globalConnectTimeout' at the time of this call is the timeout used for future member connect attempts. To use your own value call 'openReplicaSetTLS'' instead.
2019-11-01 16:55:59 +00:00
openReplicaSetTLS rsSeed = readIORef globalConnectTimeout >>= flip openReplicaSetTLS' rsSeed
2022-06-17 17:16:02 +00:00
openReplicaSetTLS' :: Secs -> ( ReplicaSetName , [ Host ] ) -> IO ReplicaSet
2019-11-01 16:55:59 +00:00
-- ^ Open secure connections (on demand) to servers in replica set. Supplied hosts is seed list. At least one of them must be a live member of the named replica set, otherwise fail. Supplied seconds timeout is used for connect attempts to members.
openReplicaSetTLS' timeoutSecs ( rs , hosts ) = _openReplicaSet timeoutSecs ( rs , hosts , Secure )
_openReplicaSet :: Secs -> ( ReplicaSetName , [ Host ] , TransportSecurity ) -> IO ReplicaSet
2022-06-17 17:16:02 +00:00
_openReplicaSet timeoutSecs ( rsName , seedList , transportSecurity ) = do
2013-12-26 14:57:33 +00:00
vMembers <- newMVar ( map ( , Nothing ) seedList )
2019-11-01 16:55:59 +00:00
let rs = ReplicaSet rsName vMembers timeoutSecs transportSecurity
2013-12-26 14:57:33 +00:00
_ <- updateMembers rs
return rs
2011-07-05 14:37:01 +00:00
2022-06-17 17:16:02 +00:00
openReplicaSetSRV :: HostName -> IO ReplicaSet
2020-04-01 13:11:17 +00:00
-- ^ Open /non-secure/ connections (on demand) to servers in a replica set. The seedlist and replica set name is fetched from the SRV and TXT DNS records for the given hostname. The value of 'globalConnectTimeout' at the time of this call is the timeout used for future member connect attempts. To use your own value call 'openReplicaSetSRV''' instead.
2022-06-17 17:16:02 +00:00
openReplicaSetSRV hostname = do
2019-11-01 17:00:06 +00:00
timeoutSecs <- readIORef globalConnectTimeout
_openReplicaSetSRV timeoutSecs Unsecure hostname
2022-06-17 17:16:02 +00:00
openReplicaSetSRV' :: HostName -> IO ReplicaSet
2020-04-01 13:11:17 +00:00
-- ^ Open /secure/ connections (on demand) to servers in a replica set. The seedlist and replica set name is fetched from the SRV and TXT DNS records for the given hostname. The value of 'globalConnectTimeout' at the time of this call is the timeout used for future member connect attempts. To use your own value call 'openReplicaSetSRV'''' instead.
2022-01-06 22:43:29 +00:00
--
-- The preferred connection method for cloud MongoDB providers. A typical connecting sequence is shown in the example below.
--
-- ==== __Example__
-- > do
-- > pipe <- openReplicatSetSRV' "cluster#.xxxxx.yyyyy.zzz"
-- > is_auth <- access pipe master "admin" $ auth user_name password
2022-09-02 08:53:06 +00:00
-- > unless is_auth (throwIO $ userError "Authentication failed!")
2022-06-17 17:16:02 +00:00
openReplicaSetSRV' hostname = do
2019-11-01 17:00:06 +00:00
timeoutSecs <- readIORef globalConnectTimeout
_openReplicaSetSRV timeoutSecs Secure hostname
2022-06-17 17:16:02 +00:00
openReplicaSetSRV'' :: Secs -> HostName -> IO ReplicaSet
2020-04-01 13:11:17 +00:00
-- ^ Open /non-secure/ connections (on demand) to servers in a replica set. The seedlist and replica set name is fetched from the SRV and TXT DNS records for the given hostname. Supplied seconds timeout is used for connect attempts to members.
2019-11-01 17:00:06 +00:00
openReplicaSetSRV'' timeoutSecs = _openReplicaSetSRV timeoutSecs Unsecure
2022-06-17 17:16:02 +00:00
openReplicaSetSRV''' :: Secs -> HostName -> IO ReplicaSet
2020-04-01 13:11:17 +00:00
-- ^ Open /secure/ connections (on demand) to servers in a replica set. The seedlist and replica set name is fetched from the SRV and TXT DNS records for the given hostname. Supplied seconds timeout is used for connect attempts to members.
2019-11-01 17:00:06 +00:00
openReplicaSetSRV''' timeoutSecs = _openReplicaSetSRV timeoutSecs Secure
2022-06-17 17:16:02 +00:00
_openReplicaSetSRV :: Secs -> TransportSecurity -> HostName -> IO ReplicaSet
_openReplicaSetSRV timeoutSecs transportSecurity hostname = do
replicaSetName <- lookupReplicaSetName hostname
hosts <- lookupSeedList hostname
case ( replicaSetName , hosts ) of
2019-11-01 17:00:06 +00:00
( Nothing , _ ) -> throwError $ userError " Failed to lookup replica set name "
( _ , [] ) -> throwError $ userError " Failed to lookup replica set seedlist "
2022-06-17 17:16:02 +00:00
( Just rsName , _ ) ->
case transportSecurity of
2019-11-01 17:00:06 +00:00
Secure -> openReplicaSetTLS' timeoutSecs ( rsName , hosts )
Unsecure -> openReplicaSet' timeoutSecs ( rsName , hosts )
2011-07-13 19:34:52 +00:00
closeReplicaSet :: ReplicaSet -> IO ()
-- ^ Close all connections to replica set
2019-11-01 16:55:59 +00:00
closeReplicaSet ( ReplicaSet _ vMembers _ _ ) = withMVar vMembers $ mapM_ ( maybe ( return () ) close . snd )
2011-07-13 19:34:52 +00:00
2013-12-26 15:23:02 +00:00
primary :: ReplicaSet -> IO Pipe
2011-07-13 19:34:52 +00:00
-- ^ Return connection to current primary of replica set. Fail if no primary available.
2019-11-01 16:55:59 +00:00
primary rs @ ( ReplicaSet rsName _ _ _ ) = do
2013-12-26 14:57:33 +00:00
mHost <- statedPrimary <$> updateMembers rs
case mHost of
Just host' -> connection rs Nothing host'
Nothing -> throwError $ userError $ " replica set " ++ T . unpack rsName ++ " has no primary "
2011-07-05 14:37:01 +00:00
2013-12-26 15:23:02 +00:00
secondaryOk :: ReplicaSet -> IO Pipe
2011-07-13 19:34:52 +00:00
-- ^ Return connection to a random secondary, or primary if no secondaries available.
2011-07-05 14:37:01 +00:00
secondaryOk rs = do
2013-12-26 14:57:33 +00:00
info <- updateMembers rs
2013-12-26 15:23:02 +00:00
hosts <- shuffle ( possibleHosts info )
2013-12-26 14:57:33 +00:00
let hosts' = maybe hosts ( \ p -> delete p hosts ++ [ p ] ) ( statedPrimary info )
untilSuccess ( connection rs Nothing ) hosts'
2011-07-05 14:37:01 +00:00
2013-12-26 15:23:02 +00:00
routedHost :: ( ( Host , Bool ) -> ( Host , Bool ) -> IO Ordering ) -> ReplicaSet -> IO Pipe
2012-02-12 04:34:07 +00:00
-- ^ Return a connection to a host using a user-supplied sorting function, which sorts based on a tuple containing the host and a boolean indicating whether the host is primary.
routedHost f rs = do
info <- updateMembers rs
2013-12-26 15:23:02 +00:00
hosts <- shuffle ( possibleHosts info )
2022-06-17 17:16:02 +00:00
let addIsPrimary h = ( h , Just h == statedPrimary info )
2012-02-12 04:34:07 +00:00
hosts' <- mergesortM ( \ a b -> f ( addIsPrimary a ) ( addIsPrimary b ) ) hosts
untilSuccess ( connection rs Nothing ) hosts'
2011-07-05 14:37:01 +00:00
type ReplicaInfo = ( Host , Document )
-- ^ Result of isMaster command on host in replica set. Returned fields are: setName, ismaster, secondary, hosts, [primary]. primary only present when ismaster = false
statedPrimary :: ReplicaInfo -> Maybe Host
-- ^ Primary of replica set or Nothing if there isn't one
2012-06-10 19:47:14 +00:00
statedPrimary ( host' , info ) = if ( at " ismaster " info ) then Just host' else readHostPort <$> B . lookup " primary " info
2011-07-05 14:37:01 +00:00
possibleHosts :: ReplicaInfo -> [ Host ]
-- ^ Non-arbiter, non-hidden members of replica set
possibleHosts ( _ , info ) = map readHostPort $ at " hosts " info
2013-12-26 15:23:02 +00:00
updateMembers :: ReplicaSet -> IO ReplicaInfo
2011-07-05 14:37:01 +00:00
-- ^ Fetch replica info from any server and update members accordingly
2019-11-01 16:55:59 +00:00
updateMembers rs @ ( ReplicaSet _ vMembers _ _ ) = do
2013-12-26 14:57:33 +00:00
( host' , info ) <- untilSuccess ( fetchReplicaInfo rs ) =<< readMVar vMembers
modifyMVar vMembers $ \ members -> do
let ( ( members' , old ) , new ) = intersection ( map readHostPort $ at " hosts " info ) members
2013-12-26 15:23:02 +00:00
forM_ old $ \ ( _ , mPipe ) -> maybe ( return () ) close mPipe
2013-12-26 14:57:33 +00:00
return ( members' ++ map ( , Nothing ) new , ( host' , info ) )
2011-07-05 14:37:01 +00:00
where
2013-12-26 14:57:33 +00:00
intersection :: ( Eq k ) => [ k ] -> [ ( k , v ) ] -> ( ( [ ( k , v ) ] , [ ( k , v ) ] ) , [ k ] )
intersection keys assocs = ( partition ( flip elem inKeys . fst ) assocs , keys \\ inKeys ) where
assocKeys = map fst assocs
inKeys = intersect keys assocKeys
2011-07-05 14:37:01 +00:00
2013-12-26 15:23:02 +00:00
fetchReplicaInfo :: ReplicaSet -> ( Host , Maybe Pipe ) -> IO ReplicaInfo
2011-07-05 14:37:01 +00:00
-- Connect to host and fetch replica info from host creating new connection if missing or closed (previously failed). Fail if not member of named replica set.
2019-11-01 16:55:59 +00:00
fetchReplicaInfo rs @ ( ReplicaSet rsName _ _ _ ) ( host' , mPipe ) = do
2013-12-26 14:57:33 +00:00
pipe <- connection rs mPipe host'
info <- adminCommand [ " isMaster " =: ( 1 :: Int ) ] pipe
case B . lookup " setName " info of
Nothing -> throwError $ userError $ show host' ++ " not a member of any replica set, including " ++ T . unpack rsName ++ " : " ++ show info
Just setName | setName /= rsName -> throwError $ userError $ show host' ++ " not a member of replica set " ++ T . unpack rsName ++ " : " ++ show info
Just _ -> return ( host' , info )
2011-07-05 14:37:01 +00:00
2013-12-26 15:23:02 +00:00
connection :: ReplicaSet -> Maybe Pipe -> Host -> IO Pipe
2011-07-05 14:37:01 +00:00
-- ^ Return new or existing connection to member of replica set. If pipe is already known for host it is given, but we still test if it is open.
2019-11-01 16:55:59 +00:00
connection ( ReplicaSet _ vMembers timeoutSecs transportSecurity ) mPipe host' =
2013-12-26 15:23:02 +00:00
maybe conn ( \ p -> isClosed p >>= \ bad -> if bad then conn else return p ) mPipe
2010-10-27 20:13:23 +00:00
where
2013-12-26 14:57:33 +00:00
conn = modifyMVar vMembers $ \ members -> do
2019-11-01 16:55:59 +00:00
let ( Host h p ) = host'
2022-06-17 17:16:02 +00:00
let conn' = case transportSecurity of
Secure -> TLS . connect h p
2019-11-01 17:00:06 +00:00
Unsecure -> connect' timeoutSecs host'
2019-11-01 16:55:59 +00:00
let new = conn' >>= \ pipe -> return ( updateAssocs host' ( Just pipe ) members , pipe )
2013-12-26 14:57:33 +00:00
case List . lookup host' members of
2013-12-26 15:23:02 +00:00
Just ( Just pipe ) -> isClosed pipe >>= \ bad -> if bad then new else return ( members , pipe )
2013-12-26 14:57:33 +00:00
_ -> new
2010-06-15 03:14:40 +00:00
{- Authors: Tony Hannan <tony@10gen.com>
2011-03-11 00:37:48 +00:00
Copyright 2011 10 gen Inc .
2010-06-15 03:14:40 +00:00
Licensed under the Apache License , Version 2.0 ( the " License " ) ; you may not use this file except in compliance with the License . You may obtain a copy of the License at : http :// www . apache . org / licenses / LICENSE - 2.0 . Unless required by applicable law or agreed to in writing , software distributed under the License is distributed on an " AS IS " BASIS , WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND , either express or implied . See the License for the specific language governing permissions and limitations under the License . - }