{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.BackupStorage.PutChunk
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Upload chunk.
module Amazonka.BackupStorage.PutChunk
  ( -- * Creating a Request
    PutChunk (..),
    newPutChunk,

    -- * Request Lenses
    putChunk_backupJobId,
    putChunk_uploadId,
    putChunk_chunkIndex,
    putChunk_length,
    putChunk_checksum,
    putChunk_checksumAlgorithm,
    putChunk_data,

    -- * Destructuring the Response
    PutChunkResponse (..),
    newPutChunkResponse,

    -- * Response Lenses
    putChunkResponse_httpStatus,
    putChunkResponse_chunkChecksum,
    putChunkResponse_chunkChecksumAlgorithm,
  )
where

import Amazonka.BackupStorage.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutChunk' smart constructor.
data PutChunk = PutChunk'
  { -- | Backup job Id for the in-progress backup.
    PutChunk -> Text
backupJobId :: Prelude.Text,
    -- | Upload Id for the in-progress upload.
    PutChunk -> Text
uploadId :: Prelude.Text,
    -- | Describes this chunk\'s position relative to the other chunks
    PutChunk -> Integer
chunkIndex :: Prelude.Integer,
    -- | Data length
    PutChunk -> Integer
length :: Prelude.Integer,
    -- | Data checksum
    PutChunk -> Text
checksum :: Prelude.Text,
    -- | Checksum algorithm
    PutChunk -> DataChecksumAlgorithm
checksumAlgorithm :: DataChecksumAlgorithm,
    -- | Data to be uploaded
    PutChunk -> HashedBody
data' :: Data.HashedBody
  }
  deriving (Int -> PutChunk -> ShowS
[PutChunk] -> ShowS
PutChunk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutChunk] -> ShowS
$cshowList :: [PutChunk] -> ShowS
show :: PutChunk -> String
$cshow :: PutChunk -> String
showsPrec :: Int -> PutChunk -> ShowS
$cshowsPrec :: Int -> PutChunk -> ShowS
Prelude.Show, forall x. Rep PutChunk x -> PutChunk
forall x. PutChunk -> Rep PutChunk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutChunk x -> PutChunk
$cfrom :: forall x. PutChunk -> Rep PutChunk x
Prelude.Generic)

-- |
-- Create a value of 'PutChunk' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'backupJobId', 'putChunk_backupJobId' - Backup job Id for the in-progress backup.
--
-- 'uploadId', 'putChunk_uploadId' - Upload Id for the in-progress upload.
--
-- 'chunkIndex', 'putChunk_chunkIndex' - Describes this chunk\'s position relative to the other chunks
--
-- 'length', 'putChunk_length' - Data length
--
-- 'checksum', 'putChunk_checksum' - Data checksum
--
-- 'checksumAlgorithm', 'putChunk_checksumAlgorithm' - Checksum algorithm
--
-- 'data'', 'putChunk_data' - Data to be uploaded
newPutChunk ::
  -- | 'backupJobId'
  Prelude.Text ->
  -- | 'uploadId'
  Prelude.Text ->
  -- | 'chunkIndex'
  Prelude.Integer ->
  -- | 'length'
  Prelude.Integer ->
  -- | 'checksum'
  Prelude.Text ->
  -- | 'checksumAlgorithm'
  DataChecksumAlgorithm ->
  -- | 'data''
  Data.HashedBody ->
  PutChunk
newPutChunk :: Text
-> Text
-> Integer
-> Integer
-> Text
-> DataChecksumAlgorithm
-> HashedBody
-> PutChunk
newPutChunk
  Text
pBackupJobId_
  Text
pUploadId_
  Integer
pChunkIndex_
  Integer
pLength_
  Text
pChecksum_
  DataChecksumAlgorithm
pChecksumAlgorithm_
  HashedBody
pData_ =
    PutChunk'
      { $sel:backupJobId:PutChunk' :: Text
backupJobId = Text
pBackupJobId_,
        $sel:uploadId:PutChunk' :: Text
uploadId = Text
pUploadId_,
        $sel:chunkIndex:PutChunk' :: Integer
chunkIndex = Integer
pChunkIndex_,
        $sel:length:PutChunk' :: Integer
length = Integer
pLength_,
        $sel:checksum:PutChunk' :: Text
checksum = Text
pChecksum_,
        $sel:checksumAlgorithm:PutChunk' :: DataChecksumAlgorithm
checksumAlgorithm = DataChecksumAlgorithm
pChecksumAlgorithm_,
        $sel:data':PutChunk' :: HashedBody
data' = HashedBody
pData_
      }

-- | Backup job Id for the in-progress backup.
putChunk_backupJobId :: Lens.Lens' PutChunk Prelude.Text
putChunk_backupJobId :: Lens' PutChunk Text
putChunk_backupJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {Text
backupJobId :: Text
$sel:backupJobId:PutChunk' :: PutChunk -> Text
backupJobId} -> Text
backupJobId) (\s :: PutChunk
s@PutChunk' {} Text
a -> PutChunk
s {$sel:backupJobId:PutChunk' :: Text
backupJobId = Text
a} :: PutChunk)

-- | Upload Id for the in-progress upload.
putChunk_uploadId :: Lens.Lens' PutChunk Prelude.Text
putChunk_uploadId :: Lens' PutChunk Text
putChunk_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {Text
uploadId :: Text
$sel:uploadId:PutChunk' :: PutChunk -> Text
uploadId} -> Text
uploadId) (\s :: PutChunk
s@PutChunk' {} Text
a -> PutChunk
s {$sel:uploadId:PutChunk' :: Text
uploadId = Text
a} :: PutChunk)

-- | Describes this chunk\'s position relative to the other chunks
putChunk_chunkIndex :: Lens.Lens' PutChunk Prelude.Integer
putChunk_chunkIndex :: Lens' PutChunk Integer
putChunk_chunkIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {Integer
chunkIndex :: Integer
$sel:chunkIndex:PutChunk' :: PutChunk -> Integer
chunkIndex} -> Integer
chunkIndex) (\s :: PutChunk
s@PutChunk' {} Integer
a -> PutChunk
s {$sel:chunkIndex:PutChunk' :: Integer
chunkIndex = Integer
a} :: PutChunk)

-- | Data length
putChunk_length :: Lens.Lens' PutChunk Prelude.Integer
putChunk_length :: Lens' PutChunk Integer
putChunk_length = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {Integer
length :: Integer
$sel:length:PutChunk' :: PutChunk -> Integer
length} -> Integer
length) (\s :: PutChunk
s@PutChunk' {} Integer
a -> PutChunk
s {$sel:length:PutChunk' :: Integer
length = Integer
a} :: PutChunk)

-- | Data checksum
putChunk_checksum :: Lens.Lens' PutChunk Prelude.Text
putChunk_checksum :: Lens' PutChunk Text
putChunk_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {Text
checksum :: Text
$sel:checksum:PutChunk' :: PutChunk -> Text
checksum} -> Text
checksum) (\s :: PutChunk
s@PutChunk' {} Text
a -> PutChunk
s {$sel:checksum:PutChunk' :: Text
checksum = Text
a} :: PutChunk)

-- | Checksum algorithm
putChunk_checksumAlgorithm :: Lens.Lens' PutChunk DataChecksumAlgorithm
putChunk_checksumAlgorithm :: Lens' PutChunk DataChecksumAlgorithm
putChunk_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {DataChecksumAlgorithm
checksumAlgorithm :: DataChecksumAlgorithm
$sel:checksumAlgorithm:PutChunk' :: PutChunk -> DataChecksumAlgorithm
checksumAlgorithm} -> DataChecksumAlgorithm
checksumAlgorithm) (\s :: PutChunk
s@PutChunk' {} DataChecksumAlgorithm
a -> PutChunk
s {$sel:checksumAlgorithm:PutChunk' :: DataChecksumAlgorithm
checksumAlgorithm = DataChecksumAlgorithm
a} :: PutChunk)

-- | Data to be uploaded
putChunk_data :: Lens.Lens' PutChunk Data.HashedBody
putChunk_data :: Lens' PutChunk HashedBody
putChunk_data = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunk' {HashedBody
data' :: HashedBody
$sel:data':PutChunk' :: PutChunk -> HashedBody
data'} -> HashedBody
data') (\s :: PutChunk
s@PutChunk' {} HashedBody
a -> PutChunk
s {$sel:data':PutChunk' :: HashedBody
data' = HashedBody
a} :: PutChunk)

instance Core.AWSRequest PutChunk where
  type AWSResponse PutChunk = PutChunkResponse
  request :: (Service -> Service) -> PutChunk -> Request PutChunk
request Service -> Service
overrides =
    forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.putBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutChunk
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutChunk)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> DataChecksumAlgorithm -> PutChunkResponse
PutChunkResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ChunkChecksum")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"ChunkChecksumAlgorithm")
      )

instance Data.ToBody PutChunk where
  toBody :: PutChunk -> RequestBody
toBody PutChunk' {Integer
Text
HashedBody
DataChecksumAlgorithm
data' :: HashedBody
checksumAlgorithm :: DataChecksumAlgorithm
checksum :: Text
length :: Integer
chunkIndex :: Integer
uploadId :: Text
backupJobId :: Text
$sel:data':PutChunk' :: PutChunk -> HashedBody
$sel:checksumAlgorithm:PutChunk' :: PutChunk -> DataChecksumAlgorithm
$sel:checksum:PutChunk' :: PutChunk -> Text
$sel:length:PutChunk' :: PutChunk -> Integer
$sel:chunkIndex:PutChunk' :: PutChunk -> Integer
$sel:uploadId:PutChunk' :: PutChunk -> Text
$sel:backupJobId:PutChunk' :: PutChunk -> Text
..} = forall a. ToBody a => a -> RequestBody
Data.toBody HashedBody
data'

instance Data.ToHeaders PutChunk where
  toHeaders :: PutChunk -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath PutChunk where
  toPath :: PutChunk -> ByteString
toPath PutChunk' {Integer
Text
HashedBody
DataChecksumAlgorithm
data' :: HashedBody
checksumAlgorithm :: DataChecksumAlgorithm
checksum :: Text
length :: Integer
chunkIndex :: Integer
uploadId :: Text
backupJobId :: Text
$sel:data':PutChunk' :: PutChunk -> HashedBody
$sel:checksumAlgorithm:PutChunk' :: PutChunk -> DataChecksumAlgorithm
$sel:checksum:PutChunk' :: PutChunk -> Text
$sel:length:PutChunk' :: PutChunk -> Integer
$sel:chunkIndex:PutChunk' :: PutChunk -> Integer
$sel:uploadId:PutChunk' :: PutChunk -> Text
$sel:backupJobId:PutChunk' :: PutChunk -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup-jobs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupJobId,
        ByteString
"/chunk/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
uploadId,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Integer
chunkIndex
      ]

instance Data.ToQuery PutChunk where
  toQuery :: PutChunk -> QueryString
toQuery PutChunk' {Integer
Text
HashedBody
DataChecksumAlgorithm
data' :: HashedBody
checksumAlgorithm :: DataChecksumAlgorithm
checksum :: Text
length :: Integer
chunkIndex :: Integer
uploadId :: Text
backupJobId :: Text
$sel:data':PutChunk' :: PutChunk -> HashedBody
$sel:checksumAlgorithm:PutChunk' :: PutChunk -> DataChecksumAlgorithm
$sel:checksum:PutChunk' :: PutChunk -> Text
$sel:length:PutChunk' :: PutChunk -> Integer
$sel:chunkIndex:PutChunk' :: PutChunk -> Integer
$sel:uploadId:PutChunk' :: PutChunk -> Text
$sel:backupJobId:PutChunk' :: PutChunk -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"length" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Integer
length,
        ByteString
"checksum" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
checksum,
        ByteString
"checksum-algorithm" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: DataChecksumAlgorithm
checksumAlgorithm
      ]

-- | /See:/ 'newPutChunkResponse' smart constructor.
data PutChunkResponse = PutChunkResponse'
  { -- | The response's http status code.
    PutChunkResponse -> Int
httpStatus :: Prelude.Int,
    -- | Chunk checksum
    PutChunkResponse -> Text
chunkChecksum :: Prelude.Text,
    -- | Checksum algorithm
    PutChunkResponse -> DataChecksumAlgorithm
chunkChecksumAlgorithm :: DataChecksumAlgorithm
  }
  deriving (PutChunkResponse -> PutChunkResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutChunkResponse -> PutChunkResponse -> Bool
$c/= :: PutChunkResponse -> PutChunkResponse -> Bool
== :: PutChunkResponse -> PutChunkResponse -> Bool
$c== :: PutChunkResponse -> PutChunkResponse -> Bool
Prelude.Eq, ReadPrec [PutChunkResponse]
ReadPrec PutChunkResponse
Int -> ReadS PutChunkResponse
ReadS [PutChunkResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutChunkResponse]
$creadListPrec :: ReadPrec [PutChunkResponse]
readPrec :: ReadPrec PutChunkResponse
$creadPrec :: ReadPrec PutChunkResponse
readList :: ReadS [PutChunkResponse]
$creadList :: ReadS [PutChunkResponse]
readsPrec :: Int -> ReadS PutChunkResponse
$creadsPrec :: Int -> ReadS PutChunkResponse
Prelude.Read, Int -> PutChunkResponse -> ShowS
[PutChunkResponse] -> ShowS
PutChunkResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutChunkResponse] -> ShowS
$cshowList :: [PutChunkResponse] -> ShowS
show :: PutChunkResponse -> String
$cshow :: PutChunkResponse -> String
showsPrec :: Int -> PutChunkResponse -> ShowS
$cshowsPrec :: Int -> PutChunkResponse -> ShowS
Prelude.Show, forall x. Rep PutChunkResponse x -> PutChunkResponse
forall x. PutChunkResponse -> Rep PutChunkResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutChunkResponse x -> PutChunkResponse
$cfrom :: forall x. PutChunkResponse -> Rep PutChunkResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutChunkResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'putChunkResponse_httpStatus' - The response's http status code.
--
-- 'chunkChecksum', 'putChunkResponse_chunkChecksum' - Chunk checksum
--
-- 'chunkChecksumAlgorithm', 'putChunkResponse_chunkChecksumAlgorithm' - Checksum algorithm
newPutChunkResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'chunkChecksum'
  Prelude.Text ->
  -- | 'chunkChecksumAlgorithm'
  DataChecksumAlgorithm ->
  PutChunkResponse
newPutChunkResponse :: Int -> Text -> DataChecksumAlgorithm -> PutChunkResponse
newPutChunkResponse
  Int
pHttpStatus_
  Text
pChunkChecksum_
  DataChecksumAlgorithm
pChunkChecksumAlgorithm_ =
    PutChunkResponse'
      { $sel:httpStatus:PutChunkResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:chunkChecksum:PutChunkResponse' :: Text
chunkChecksum = Text
pChunkChecksum_,
        $sel:chunkChecksumAlgorithm:PutChunkResponse' :: DataChecksumAlgorithm
chunkChecksumAlgorithm = DataChecksumAlgorithm
pChunkChecksumAlgorithm_
      }

-- | The response's http status code.
putChunkResponse_httpStatus :: Lens.Lens' PutChunkResponse Prelude.Int
putChunkResponse_httpStatus :: Lens' PutChunkResponse Int
putChunkResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunkResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutChunkResponse' :: PutChunkResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutChunkResponse
s@PutChunkResponse' {} Int
a -> PutChunkResponse
s {$sel:httpStatus:PutChunkResponse' :: Int
httpStatus = Int
a} :: PutChunkResponse)

-- | Chunk checksum
putChunkResponse_chunkChecksum :: Lens.Lens' PutChunkResponse Prelude.Text
putChunkResponse_chunkChecksum :: Lens' PutChunkResponse Text
putChunkResponse_chunkChecksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunkResponse' {Text
chunkChecksum :: Text
$sel:chunkChecksum:PutChunkResponse' :: PutChunkResponse -> Text
chunkChecksum} -> Text
chunkChecksum) (\s :: PutChunkResponse
s@PutChunkResponse' {} Text
a -> PutChunkResponse
s {$sel:chunkChecksum:PutChunkResponse' :: Text
chunkChecksum = Text
a} :: PutChunkResponse)

-- | Checksum algorithm
putChunkResponse_chunkChecksumAlgorithm :: Lens.Lens' PutChunkResponse DataChecksumAlgorithm
putChunkResponse_chunkChecksumAlgorithm :: Lens' PutChunkResponse DataChecksumAlgorithm
putChunkResponse_chunkChecksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutChunkResponse' {DataChecksumAlgorithm
chunkChecksumAlgorithm :: DataChecksumAlgorithm
$sel:chunkChecksumAlgorithm:PutChunkResponse' :: PutChunkResponse -> DataChecksumAlgorithm
chunkChecksumAlgorithm} -> DataChecksumAlgorithm
chunkChecksumAlgorithm) (\s :: PutChunkResponse
s@PutChunkResponse' {} DataChecksumAlgorithm
a -> PutChunkResponse
s {$sel:chunkChecksumAlgorithm:PutChunkResponse' :: DataChecksumAlgorithm
chunkChecksumAlgorithm = DataChecksumAlgorithm
a} :: PutChunkResponse)

instance Prelude.NFData PutChunkResponse where
  rnf :: PutChunkResponse -> ()
rnf PutChunkResponse' {Int
Text
DataChecksumAlgorithm
chunkChecksumAlgorithm :: DataChecksumAlgorithm
chunkChecksum :: Text
httpStatus :: Int
$sel:chunkChecksumAlgorithm:PutChunkResponse' :: PutChunkResponse -> DataChecksumAlgorithm
$sel:chunkChecksum:PutChunkResponse' :: PutChunkResponse -> Text
$sel:httpStatus:PutChunkResponse' :: PutChunkResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
chunkChecksum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataChecksumAlgorithm
chunkChecksumAlgorithm