Update-Perform style fetching parameters from AWS SSM

Ssm.fs

module Ssm

module GetParametersWorkflow =

    open Amazon.SimpleSystemsManagement.Model
    open System.Net

    type Failure =
        | ParameterRequestFailed of exn
        | ParameterRequestError of HttpStatusCode * Amazon.Runtime.ResponseMetadata

    type Model =
        {
            Paths : string list
            Unfinished : (string * string) option
            Parameters : Parameter list
            Errors : Failure list
        }

    type Msg =
        | Init of paths:string list
        | ParametersReturned of Result<string * GetParametersByPathResponse, exn>

    type Effect =
        | FetchParameters of path:string * nextToken:string option

    let init =
        {
            Paths = []
            Unfinished = None
            Parameters = []
            Errors = []
        }

    module Decide =
        let isSuccess code =
            code >= HttpStatusCode.OK && code < HttpStatusCode.MultipleChoices

        let hasToken nextToken =
            not (System.String.IsNullOrWhiteSpace nextToken)

        let toFail model err =
            { model with Errors = err :: model.Errors}, []

        let nextStep model =
            match model.Unfinished with
            | Some (path, nextToken) ->
                { model with Unfinished = None }, [ FetchParameters (path, Some nextToken)]
            | None ->
                match model.Paths with
                | [] ->
                    model, []
                | path :: rest ->
                    { model with Paths = rest }, [ FetchParameters (path, None) ]

    let update model msg =
        match msg with
        | Init paths ->
            match paths with
            | [] ->
                model, []
            | _ ->
                { model with Paths = paths }
                |> Decide.nextStep
        | ParametersReturned (Error ex) ->
            ParameterRequestFailed ex
            |> Decide.toFail model
        | ParametersReturned (Ok (path, response)) ->
            match Decide.isSuccess response.HttpStatusCode with
            | false -> 
                ParameterRequestError (response.HttpStatusCode, response.ResponseMetadata)
                |> Decide.toFail model
            | true ->
                let parameters = List.append model.Parameters (List.ofSeq response.Parameters)
                let unfinished = 
                    match Decide.hasToken response.NextToken with
                    | false -> None
                    | true -> Some (path, response.NextToken)
                { model with
                    Parameters = parameters
                    Unfinished = unfinished
                }
                |> Decide.nextStep


    // SIDE EFFECTS after this point
    open Utilities
    open Amazon.SimpleSystemsManagement


    let perform (client : AmazonSimpleSystemsManagementClient) effect =
        match effect with
        | FetchParameters (path, nextToken) ->
            let request =
                GetParametersByPathRequest(
                    Path = path,
                    Recursive = true,
                    WithDecryption = true,
                    NextToken = Option.toObj nextToken
                )
            let runRequestAsync req =
                client.GetParametersByPathAsync(req)
                |> Async.AwaitTask
                |> Async.map (fun response -> path, response)
            request
            |> AsyncResult.liftAsyncEx id runRequestAsync
            |> Async.map (fun r -> [ParametersReturned r])


open GetParametersWorkflow

let getParameters client paths =
    let initEffects = []
    let initMsgs = [Init paths]
    let output model =
        match model.Errors with
        | [] -> Ok model.Parameters
        | errs -> Error errs
    async {
        let! model = Utilities.UpProcess.foldEffects (perform client) update init initEffects initMsgs
        return output model
    }

UpProcess.fs

namespace Utilities

// Update-Perform Process
module UpProcess =
    
    /// This will run effects first, then process messages
    /// when there are no more effects.
    let rec foldEffects perform update model effects msgs =
        match effects, msgs with
        | [], [] ->
            async.Return model
        | [], msg :: nMsgs ->
            let (nModel, nEffects) = update model msg
            foldEffects perform update nModel nEffects nMsgs
        | effect :: nEffects, _ ->
            async {
                let! newMsgs = perform effect
                let nMsgs = List.append msgs newMsgs
                return! foldEffects perform update model nEffects nMsgs
            }


    /// This will process messages first, then run effects
    /// when there are no more messages.
    let rec foldMsgs perform update model effects msgs =
        match effects, msgs with
        | [], [] ->
            async.Return model
        | _, msg :: nMsgs ->
            let (nModel, newEffects) = update model msg
            let nEffects = List.append effects newEffects
            foldEffects perform update nModel nEffects nMsgs
        | effect :: nEffects, [] ->
            async {
                let! nMsgs = perform effect
                return! foldEffects perform update model nEffects nMsgs
            }

The open Utilities statement is to access some helpers to deal with Async and Async Result. For example, Async.map and AsyncResult.liftAsyncEx. The code for those helpers can be found here.